Index: /LMDZ4/trunk/arch/arch-PW6_VARGAS.fcm
===================================================================
--- /LMDZ4/trunk/arch/arch-PW6_VARGAS.fcm	(revision 1402)
+++ /LMDZ4/trunk/arch/arch-PW6_VARGAS.fcm	(revision 1403)
@@ -3,13 +3,13 @@
 %AR                  ar
 %MAKE                gmake
-%FPP_FLAGS           -P
-%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM
-%BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc -qextname=flush
+%FPP_FLAGS           -P -I/usr/local/pub/FFTW/3.2/include
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_FFTW
+%BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc -qmaxmem=-1 -qzerosize
 %PROD_FFLAGS         -O5
 %DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
-%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap 
+%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap -qcheck -qextchk
 %MPI_FFLAGS          -I/usr/lpp/ppe.poe/include/thread64
 %OMP_FFLAGS          -qsmp=omp
-%BASE_LD             -lessl
+%BASE_LD             -lessl -L/usr/local/pub/FFTW/3.2/lib -lfftw3
 %MPI_LD              
 %OMP_LD              -qsmp=omp
Index: /LMDZ4/trunk/create_make_gcm
===================================================================
--- /LMDZ4/trunk/create_make_gcm	(revision 1402)
+++ /LMDZ4/trunk/create_make_gcm	(revision 1403)
@@ -108,5 +108,5 @@
 echo '	cd $(LIBO) ; $(RANLIB) lib*.a ; cd $(GCM) ;\'
 echo '	cd $(LOCAL_DIR); \'
-echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(PROG).F -o $(PROG).o ; \'
+echo '	$(COMPILE90) $(LIBF)/$(DIRMAIN)/$(SOURCE) -o $(PROG).o ; \'
 echo '	$(LINK) $(PROG).o -L$(LIBO) $(L_DYN) $(L_ADJNT) $(L_COSP) $(L_FILTRE) $(L_PHY) $(L_DYN) $(L_BIBIO) $(L_DYN) $(OPLINK) $(OPTION_LINK) -o $(LOCAL_DIR)/$(PROG).e ; $(RM) $(PROG).o '
 echo
Index: /LMDZ4/trunk/gcm.def
===================================================================
--- /LMDZ4/trunk/gcm.def	(revision 1402)
+++ /LMDZ4/trunk/gcm.def	(revision 1403)
@@ -1,6 +1,4 @@
-#
 ## $Id$
-#
-## nombre de pas par jour (multiple de iperiod)
+## nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
 day_step=480
 ## periode pour le pas Matsuno (en pas)
@@ -11,5 +9,5 @@
 lstardis=y
 ## nombre d'iterations de l'operateur de dissipation   gradiv
-nitergdiv=2
+nitergdiv=1
 ## nombre d'iterations de l'operateur de dissipation  nxgradrot
 nitergrot=2
@@ -17,17 +15,30 @@
 niterh=2
 ## temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
-tetagdiv=10800.
+tetagdiv=5400.
 ## temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
-tetagrot=18000.
+tetagrot=5400.
 ## temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
-tetatemp=18000.
+tetatemp=5400.
 ## coefficient pour gamdissip                                            
 coefdis=0.
-## choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
+## choix du shema d'integration temporelle (Matsuno:y ou Matsuno-leapfrog:n) 
 purmats=n
-## physics type (0: none 1: phylmd,... 2: newtonian)
+## avec ou sans physique
+## 0: pas de physique (e.g. en mode Shallow Water)
+## 1: avec physique (e.g. physique phylmd)
+## 2: avec rappel newtonien dans la dynamique                                         
 iflag_phys=1
-## periode de la physique (en pas)                                       
+## avec ou sans fichiers de demarrage (start.nc, startphy.nc) ?
+## (sans fichiers de demarrage, initialisation des champs par iniacademic
+##  dans la dynamique)
+read_start=y
+## periode de la physique (en pas dynamiques, n'a de sens que si iflag_phys=1)                                       
 iphysiq=10
+##  Avec ou sans strato
+ok_strato=n 
+#  Couche eponge dans les couches de pression plus faible que 100 fois la pression de la derniere couche
+iflag_top_bound=2
+#  Coefficient pour la couche eponge (valeur derniere couche)
+tau_top_bound=5.e-5
 ## longitude en degres du centre du zoom                                 
 clon=0.
Index: /LMDZ4/trunk/libf/bibio/initdynav.F
===================================================================
--- /LMDZ4/trunk/libf/bibio/initdynav.F	(revision 1402)
+++ /LMDZ4/trunk/libf/bibio/initdynav.F	(revision 1403)
@@ -2,6 +2,5 @@
 ! $Id$
 !
-      subroutine initdynav(infile,day0,anne0,tstep,t_ops,t_wrt
-     .                     ,fileid)
+      subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
 
 #ifdef CPP_IOIPSL
@@ -9,5 +8,6 @@
 #endif
        USE infotrac, ONLY : nqtot, ttext
-
+      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
+     &        dynhistave_file,dynhistvave_file,dynhistuave_file
       implicit none
 
@@ -30,6 +30,4 @@
 C      t_wrt: frequence d'ecriture sur le fichier
 C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
 C
 C   L. Fairhead, LMD, 03/99
@@ -52,8 +50,6 @@
 C   Arguments
 C
-      character*(*) infile
       integer day0, anne0
       real tstep, t_ops, t_wrt
-      integer fileid
 
 #ifdef CPP_IOIPSL
@@ -61,9 +57,9 @@
 C   Variables locales
 C
-      integer thoriid, zvertiid
       integer tau0
       real zjulian
       integer iq
       real rlong(iip1,jjp1), rlat(iip1,jjp1)
+      integer uhoriid, vhoriid, thoriid, zvertiid
       integer ii,jj
       integer zan, dayref
@@ -88,13 +84,45 @@
       enddo
        
-      call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
+! 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, fileid)
-
+     .             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(fileid, 'sigss', 'Niveaux sigma','Pa',
-     .              llm, nivsigs, zvertiid)
+      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
@@ -102,14 +130,13 @@
 C  Vents U
 C
-      write(6,*)'inithistave',tstep
-      call histdef(fileid, 'u', 'vents u scalaires moyennes',
-     .             'm/s', iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-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(fileid, 'v', 'vents v scalaires moyennes',
-     .             'm/s', iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+      call histdef(histvaveid, 'v', 'vent v moyen',
+     .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
      .             32, 'ave(X)', t_ops, t_wrt)
 
@@ -117,5 +144,5 @@
 C  Temperature
 C
-      call histdef(fileid, 'temp', 'temperature moyennee', 'K',
+      call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
      .             32, 'ave(X)', t_ops, t_wrt)
@@ -123,13 +150,11 @@
 C  Temperature potentielle
 C
-      call histdef(fileid, 'theta', 'temperature potentielle', 'K',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-
-
+      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(fileid, 'phi', 'geopotentiel moyenne', '-',
+      call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
      .             32, 'ave(X)', t_ops, t_wrt)
@@ -137,31 +162,33 @@
 C  Traceurs
 C
-        DO iq=1,nqtot
-          call histdef(fileid, ttext(iq), ttext(iq), '-',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', t_ops, t_wrt)
-        enddo
+!        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(fileid, 'masse', 'masse', 'kg',
+      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  Pression au sol
-C
-      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
-     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
-     .             32, 'ave(X)', t_ops, t_wrt)
-C
-C  Pression au sol
-C
-      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
-     .             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(fileid)
+      call histend(histaveid)
+      call histend(histuaveid)
+      call histend(histvaveid)
 #else
 ! tell the user this routine should be run with ioipsl
Index: /LMDZ4/trunk/libf/bibio/inithist.F
===================================================================
--- /LMDZ4/trunk/libf/bibio/inithist.F	(revision 1402)
+++ /LMDZ4/trunk/libf/bibio/inithist.F	(revision 1403)
@@ -2,6 +2,5 @@
 ! $Id$
 !
-      subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,fileid,
-     .                    filevid)
+      subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
 
 #ifdef CPP_IOIPSL
@@ -9,4 +8,6 @@
 #endif
        USE infotrac, ONLY : nqtot, ttext
+       use com_io_dyn_mod, only : histid,histvid,histuid,               &
+     &                        dynhist_file,dynhistv_file,dynhistu_file
 
       implicit none
@@ -31,7 +32,4 @@
 C      nq: nombre de traceurs
 C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
-C      filevid:ID du fichier netcdf pour la grille v
 C
 C   L. Fairhead, LMD, 03/99
@@ -54,8 +52,6 @@
 C   Arguments
 C
-      character*(*) infile
       integer day0, anne0
       real tstep, t_ops, t_wrt
-      integer fileid, filevid
 
 #ifdef CPP_IOIPSL
@@ -83,4 +79,8 @@
       tau0 = itau_dyn
       
+! -------------------------------------------------------------
+! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
+! -------------------------------------------------------------
+!Grille U      
       do jj = 1, jjp1
         do ii = 1, iip1
@@ -90,12 +90,9 @@
       enddo
        
-      call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
+      call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
      .             1, iip1, 1, jjp1,
-     .             tau0, zjulian, tstep, uhoriid, fileid)
-C
-C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
-C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
-C  un meme fichier)
+     .             tau0, zjulian, tstep, uhoriid, histuid)
 
+! Grille V
       do jj = 1, jjm
         do ii = 1, iip1
@@ -105,10 +102,9 @@
       enddo
 
-      call histbeg('dyn_histv.nc', iip1, rlong(:,1), jjm, rlat(1,:),
+      call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
      .             1, iip1, 1, jjm,
-     .             tau0, zjulian, tstep, vhoriid, filevid)
-C
-C  Appel a histhori pour rajouter les autres grilles horizontales
-C
+     .             tau0, zjulian, tstep, vhoriid, histvid)
+
+!Grille Scalaire
       do jj = 1, jjp1
         do ii = 1, iip1
@@ -118,20 +114,24 @@
       enddo
 
-      call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
-     .              'Grille points scalaires', thoriid)
+      call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
+     .             1, iip1, 1, jjp1,
+     .             tau0, zjulian, tstep, thoriid, histid)
+! -------------------------------------------------------------
+C  Appel a histvert pour la grille verticale
+! -------------------------------------------------------------
+      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
+      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
+      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
+     .              llm, presnivs/100., zvertiid,'down')
 C
-C  Appel a histvert pour la grille verticale
-C
-      call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
-     .              llm, nivsigs, zvertiid)
-C Pour le fichier V
-      call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
-     .              llm, nivsigs, zvertiid)
-C
+! -------------------------------------------------------------
 C  Appels a histdef pour la definition des variables a sauvegarder
+! -------------------------------------------------------------
 C
 C  Vents U
 C
-      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
+      call histdef(histuid, 'u', 'vent u', 'm/s',
      .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
      .             32, 'inst(X)', t_ops, t_wrt)
@@ -139,5 +139,5 @@
 C  Vents V
 C
-      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
+      call histdef(histvid, 'v', 'vent v', 'm/s',
      .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
      .             32, 'inst(X)', t_ops, t_wrt)
@@ -146,5 +146,5 @@
 C  Temperature potentielle
 C
-      call histdef(fileid, 'teta', 'temperature potentielle', '-',
+      call histdef(histid, 'teta', 'temperature potentielle', '-',
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
      .             32, 'inst(X)', t_ops, t_wrt)
@@ -152,5 +152,5 @@
 C  Geopotentiel
 C
-      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
+      call histdef(histid, 'phi', 'geopotentiel', '-',
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
      .             32, 'inst(X)', t_ops, t_wrt)
@@ -158,32 +158,34 @@
 C  Traceurs
 C
-        DO iq=1,nqtot
-          call histdef(fileid, ttext(iq),  ttext(iq), '-',
-     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
-        enddo
-C
+!
+!        DO iq=1,nqtot
+!          call histdef(histid, ttext(iq),  ttext(iq), '-',
+!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+!     .             32, 'inst(X)', t_ops, t_wrt)
+!        enddo
+!C
 C  Masse
 C
-      call histdef(fileid, 'masse', 'masse', 'kg',
-     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
+      call histdef(histid, 'masse', 'masse', 'kg',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
      .             32, 'inst(X)', t_ops, t_wrt)
 C
 C  Pression au sol
 C
-      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
+      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
      .             32, 'inst(X)', t_ops, t_wrt)
 C
-C  Pression au sol
-C
-      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
-     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
-     .             32, 'inst(X)', t_ops, t_wrt)
-C
+C  Geopotentiel au sol
+!C
+!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
+!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
+!     .             32, 'inst(X)', t_ops, t_wrt)
+!C
 C  Fin
 C
-      call histend(fileid)
-      call histend(filevid)
+      call histend(histid)
+      call histend(histuid)
+      call histend(histvid)
 #else
 ! tell the user this routine should be run with ioipsl
Index: /LMDZ4/trunk/libf/bibio/writedynav.F
===================================================================
--- /LMDZ4/trunk/libf/bibio/writedynav.F	(revision 1402)
+++ /LMDZ4/trunk/libf/bibio/writedynav.F	(revision 1403)
@@ -2,6 +2,6 @@
 ! $Id$
 !
-      subroutine writedynav( histid, time, vcov, 
-     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
+      subroutine writedynav(time, vcov, 
+     ,                ucov,teta,ppk,phi,q,masse,ps,phis)
 
 #ifdef CPP_IOIPSL
@@ -9,4 +9,5 @@
 #endif
       USE infotrac, ONLY : nqtot, ttext
+      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
       implicit none
 
@@ -17,5 +18,4 @@
 C
 C   Entree:
-C      histid: ID du fichier histoire
 C      time: temps de l'ecriture
 C      vcov: vents v covariants
@@ -29,6 +29,4 @@
 C      
 C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
 C
 C   L. Fairhead, LMD, 03/99
@@ -53,7 +51,6 @@
 C
 
-      INTEGER histid
       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                  
+      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)     
       REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
       REAL phis(ip1jmp1)                  
@@ -66,6 +63,6 @@
 C   Variables locales
 C
-      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
-      real us(ip1jmp1*llm), vs(ip1jmp1*llm)
+      integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm)
+      INTEGER iq, ii, ll
       real tm(ip1jmp1*llm)
       REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
@@ -75,9 +72,8 @@
 C  Initialisations
 C
-      ndex3d = 0
+      ndexu = 0
+      ndexv = 0
       ndex2d = 0
       ok_sync = .TRUE.
-      us = 999.999
-      vs = 999.999
       tm = 999.999
       vnat = 999.999
@@ -91,20 +87,18 @@
 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
 C
-C  Vents U scalaire
+C  Vents U 
 C
-      call gr_u_scal(llm, unat, us)
-      call histwrite(histid, 'u', itau_w, us, 
-     .               iip1*jjp1*llm, ndex3d)
+      call histwrite(histuaveid, 'u', itau_w, unat, 
+     .               iip1*jjp1*llm, ndexu)
 C
-C  Vents V scalaire
+C  Vents V
 C
-      call gr_v_scal(llm, vnat, vs)
-      call histwrite(histid, 'v', itau_w, vs, 
-     .               iip1*jjp1*llm, ndex3d)
+      call histwrite(histvaveid, 'v', itau_w, vnat, 
+     .               iip1*jjm*llm, ndexv)
 C
 C  Temperature potentielle moyennee
 C
-      call histwrite(histid, 'theta', itau_w, teta, 
-     .                iip1*jjp1*llm, ndex3d)
+      call histwrite(histaveid, 'theta', itau_w, teta, 
+     .                iip1*jjp1*llm, ndexu)
 C
 C  Temperature moyennee
@@ -113,34 +107,39 @@
         tm(ii) = teta(ii) * ppk(ii)/cpp
       enddo
-      call histwrite(histid, 'temp', itau_w, tm, 
-     .                iip1*jjp1*llm, ndex3d)
+      call histwrite(histaveid, 'temp', itau_w, tm, 
+     .                iip1*jjp1*llm, ndexu)
 C
 C  Geopotentiel
 C
-      call histwrite(histid, 'phi', itau_w, phi, 
-     .                iip1*jjp1*llm, ndex3d)
+      call histwrite(histaveid, 'phi', itau_w, phi, 
+     .                iip1*jjp1*llm, ndexu)
 C
 C  Traceurs
 C
-        DO iq=1,nqtot
-          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), 
-     .                   iip1*jjp1*llm, ndex3d)
-        enddo
+!        DO iq=1,nqtot
+!          call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq), 
+!     .                   iip1*jjp1*llm, ndexu)
+!        enddo
 C
 C  Masse
 C
-       call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
+       call histwrite(histaveid, 'masse', itau_w, masse, 
+     $                   iip1*jjp1*llm, ndexu)
 C
 C  Pression au sol
 C
-       call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
+       call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
 C
 C  Geopotentiel au sol
 C
-       call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+!       call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d)
 C
 C  Fin
 C
-      if (ok_sync) call histsync(histid)
+      if (ok_sync) then
+          call histsync(histaveid)
+          call histsync(histvaveid)
+          call histsync(histuaveid)
+      ENDIF
 
 #else
Index: /LMDZ4/trunk/libf/bibio/writehist.F
===================================================================
--- /LMDZ4/trunk/libf/bibio/writehist.F	(revision 1402)
+++ /LMDZ4/trunk/libf/bibio/writehist.F	(revision 1403)
@@ -2,6 +2,5 @@
 ! $Id$
 !
-      subroutine writehist( histid, histvid, time, vcov, 
-     ,                          ucov,teta,phi,q,masse,ps,phis)
+      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
 
 #ifdef CPP_IOIPSL
@@ -9,4 +8,5 @@
 #endif
       USE infotrac, ONLY : nqtot, ttext
+      use com_io_dyn_mod, only : histid,histvid,histuid
       implicit none
 
@@ -17,6 +17,4 @@
 C
 C   Entree:
-C      histid: ID du fichier histoire
-C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
 C      time: temps de l'ecriture
 C      vcov: vents v covariants
@@ -29,7 +27,4 @@
 C      phis : geopotentiel au sol
 C      
-C
-C   Sortie:
-C      fileid: ID du fichier netcdf cree
 C
 C   L. Fairhead, LMD, 03/99
@@ -54,5 +49,4 @@
 C
 
-      INTEGER histid, histvid
       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
       REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
@@ -71,4 +65,6 @@
       logical ok_sync
       integer itau_w
+      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
+
 C
 C  Initialisations
@@ -79,4 +75,6 @@
       ok_sync =.TRUE.
       itau_w = itau_dyn + time
+!  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
@@ -84,11 +82,10 @@
 C  Vents U
 C
-      call histwrite(histid, 'ucov', itau_w, ucov, 
+      call histwrite(histuid, 'u', itau_w, unat, 
      .               iip1*jjp1*llm, ndexu)
-
 C
 C  Vents V
 C
-      call histwrite(histvid, 'vcov', itau_w, vcov, 
+      call histwrite(histvid, 'v', itau_w, vnat, 
      .               iip1*jjm*llm, ndexv)
 
@@ -106,12 +103,12 @@
 C  Traceurs
 C
-        DO iq=1,nqtot
-          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), 
-     .                   iip1*jjp1*llm, ndexu)
-        enddo
-C
+!        DO iq=1,nqtot
+!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq), 
+!     .                   iip1*jjp1*llm, ndexu)
+!        enddo
+!C
 C  Masse
 C
-      call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
+      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
 C
 C  Pression au sol
@@ -121,5 +118,5 @@
 C  Geopotentiel au sol
 C
-      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
 C
 C  Fin
@@ -128,4 +125,5 @@
         call histsync(histid)
         call histsync(histvid)
+        call histsync(histuid)
       endif
 #else
Index: /LMDZ4/trunk/libf/dyn3d/adaptdt.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/adaptdt.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/adaptdt.F	(revision 1403)
@@ -1,8 +1,9 @@
 !
-! $Header$
+! $Id$
 !
       subroutine adaptdt(nadv,dtbon,n,pbaru,
      c                   masse)
 
+      USE control_mod
       IMPLICIT NONE
 
@@ -16,5 +17,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3d/advtrac.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/advtrac.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/advtrac.F	(revision 1403)
@@ -16,4 +16,6 @@
 c
       USE infotrac
+      USE control_mod
+ 
 
       IMPLICIT NONE
@@ -27,5 +29,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
@@ -121,5 +122,5 @@
 
       ! ... Flux de masse diaganostiques traceurs
-      flxw = wg / FLOAT(iapp_tracvl)
+      flxw = wg / REAL(iapp_tracvl)
 
 c  test sur l'eventuelle creation de valeurs negatives de la masse
Index: /LMDZ4/trunk/libf/dyn3d/bilan_dyn.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/bilan_dyn.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/bilan_dyn.F	(revision 1403)
@@ -423,5 +423,5 @@
          Q_cum(:,:,:,iQ)=Q_cum(:,:,:,iQ)/masse_cum(:,:,:)
       enddo
-      zz=1./float(ncum)
+      zz=1./REAL(ncum)
       ps_cum=ps_cum*zz
       masse_cum=masse_cum*zz
Index: /LMDZ4/trunk/libf/dyn3d/caladvtrac.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/caladvtrac.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/caladvtrac.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -9,4 +9,6 @@
 c
       USE infotrac
+      USE control_mod
+ 
       IMPLICIT NONE
 c
@@ -24,5 +26,4 @@
 #include "paramet.h"
 #include "comconst.h"
-#include "control.h"
 
 c   Arguments:
Index: /LMDZ4/trunk/libf/dyn3d/calfis.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/calfis.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/calfis.F	(revision 1403)
@@ -31,4 +31,6 @@
 c   .........
       USE infotrac
+      USE control_mod
+ 
 
       IMPLICIT NONE
@@ -96,5 +98,5 @@
 #include "comvert.h"
 #include "comgeom2.h"
-#include "control.h"
+#include "iniprint.h"
 
 c    Arguments :
@@ -149,4 +151,10 @@
       REAL zdpsrf(ngridmx)
 c
+      REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm)
+      REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot)
+      REAL jH_cur_split,zdt_split
+      LOGICAL debut_split,lafin_split
+      INTEGER isplit
+
       REAL zsin(iim),zcos(iim),z1(iim)
       REAL zsinbis(iim),zcosbis(iim),z1bis(iim)
@@ -181,8 +189,9 @@
         debut = .TRUE.
         IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         PRINT*,'STOP dans calfis'
-         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         PRINT*,'  ngridmx  jjm   iim   '
-         PRINT*,ngridmx,jjm,iim
+         write(lunout,*) 'STOP dans calfis'
+         write(lunout,*)
+     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         write(lunout,*) '  ngridmx  jjm   iim   '
+         write(lunout,*) ngridmx,jjm,iim
          STOP
         ENDIF
@@ -308,7 +317,7 @@
       CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis)
       DO l=1,llm
-	 DO ig=1,ngridmx
-	   zphi(ig,l)=zphi(ig,l)-zphis(ig)
-	 ENDDO
+         DO ig=1,ngridmx
+           zphi(ig,l)=zphi(ig,l)-zphis(ig)
+         ENDDO
       ENDDO
 
@@ -408,5 +417,5 @@
             z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
             z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
-	 ENDDO
+         ENDDO
 
          DO i=1,iim
@@ -415,5 +424,5 @@
             zsin(i)    = SIN(rlonv(i))*z1(i)
             zsinbis(i) = SIN(rlonv(i))*z1bis(i)
-	 ENDDO
+         ENDDO
 
          zufi(ngridmx,l)  = SSUM(iim,zcos,1)/pi
@@ -443,11 +452,25 @@
       if (planet_type=="earth") then
 #ifdef CPP_EARTH
-      CALL physiq (ngridmx,
+
+      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+      zdt_split=dtphys/nsplit_phys
+      zdufic(:,:)=0.
+      zdvfic(:,:)=0.
+      zdtfic(:,:)=0.
+      zdqfic(:,:,:)=0.
+
+      do isplit=1,nsplit_phys
+
+         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
+         debut_split=debut.and.isplit==1
+         lafin_split=lafin.and.isplit==nsplit_phys
+
+         CALL physiq (ngridmx,
      .             llm,
-     .             debut,
-     .             lafin,
+     .             debut_split,
+     .             lafin_split,
      .             jD_cur,
-     .             jH_cur,
-     .             dtphys,
+     .             jH_cur_split,
+     .             zdt_split,
      .             zplev,
      .             zplay,
@@ -469,4 +492,21 @@
      .             pducov,
      .             PVteta)
+
+         zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split
+         zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split
+         ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split
+         zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split
+
+         zdufic(:,:)=zdufic(:,:)+zdufi(:,:)
+         zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:)
+         zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:)
+         zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:)
+
+      enddo
+      zdufi(:,:)=zdufic(:,:)/nsplit_phys
+      zdvfi(:,:)=zdvfic(:,:)/nsplit_phys
+      zdtfi(:,:)=zdtfic(:,:)/nsplit_phys
+      zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys
+
 #endif
       endif !of if (planet_type=="earth")
Index: /LMDZ4/trunk/libf/dyn3d/ce0l.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ce0l.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/ce0l.F90	(revision 1403)
@@ -14,4 +14,5 @@
 !     masque is created in etat0, passed to limit to ensure consistancy.
 !-------------------------------------------------------------------------------
+  USE control_mod
 #ifdef CPP_EARTH
 ! This prog. is designed to work for Earth
@@ -36,5 +37,4 @@
 #include "indicesol.h"
 #include "iniprint.h"
-#include "control.h"
 #include "temps.h"
 #include "logic.h"
Index: DZ4/trunk/libf/dyn3d/com_io_dyn.h
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/com_io_dyn.h	(revision 1402)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      integer histid, histvid, histaveid
-      common/com_io_dyn/histid, histvid, histaveid
Index: /LMDZ4/trunk/libf/dyn3d/com_io_dyn_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/com_io_dyn_mod.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3d/com_io_dyn_mod.F90	(revision 1403)
@@ -0,0 +1,31 @@
+!
+! $Id $
+!
+module com_io_dyn_mod
+
+  implicit none 
+
+! Names of various files for outputs (in the dynamics)
+  ! to store instantaneous values:
+  character(len=18),parameter :: dynhist_file="dyn_hist.nc" ! on scalar grid
+  character(len=18),parameter :: dynhistv_file="dyn_histv.nc" ! on v grid
+  character(len=18),parameter :: dynhistu_file="dyn_histu.nc" ! on u grid
+
+  ! to store averaged values:
+  character(len=18),parameter :: dynhistave_file="dyn_hist_ave.nc"
+  character(len=18),parameter :: dynhistvave_file="dyn_histv_ave.nc"
+  character(len=18),parameter :: dynhistuave_file="dyn_histu_ave.nc"
+  
+! Ids of various files for outputs (in the dynamics)
+
+  ! instantaneous (these are set by inithist.F)
+  integer :: histid
+  integer :: histvid
+  integer :: histuid
+  
+  ! averages (these are set by initdynav.F)
+  integer :: histaveid
+  integer :: histvaveid
+  integer :: histuaveid
+  
+end module com_io_dyn_mod
Index: /LMDZ4/trunk/libf/dyn3d/conf_gcm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/conf_gcm.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/conf_gcm.F	(revision 1403)
@@ -6,4 +6,5 @@
       SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
 c
+      USE control_mod
 #ifdef CPP_IOIPSL
       use IOIPSL
@@ -34,5 +35,4 @@
 #include "dimensions.h"
 #include "paramet.h"
-#include "control.h"
 #include "logic.h"
 #include "serre.h"
@@ -162,4 +162,12 @@
        day_step = 240 
        CALL getin('day_step',day_step)
+
+!Config  Key  = nsplit_phys
+!Config  Desc = nombre de pas par jour
+!Config  Def  = 1 
+!Config  Help = nombre de pas par jour (multiple de iperiod) (
+!Config          ici pour  dt = 1 min ) 
+       nsplit_phys = 1 
+       CALL getin('nsplit_phys',nsplit_phys)
 
 !Config  Key  = iperiod
@@ -573,5 +581,4 @@
       CALL getin('config_inca',config_inca)
 
-
 !Config  Key  = ok_dynzon 
 !Config  Desc = calcul et sortie des transports 
@@ -581,4 +588,21 @@
       ok_dynzon = .FALSE. 
       CALL getin('ok_dynzon',ok_dynzon) 
+
+!Config  Key  = ok_dyn_ins
+!Config  Desc = sorties instantanees dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ins = .FALSE. 
+      CALL getin('ok_dyn_ins',ok_dyn_ins) 
+
+!Config  Key  = ok_dyn_ave
+!Config  Desc = sorties moyennes dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ave = .FALSE. 
+      CALL getin('ok_dyn_ave',ok_dyn_ave) 
+
 
       write(lunout,*)' #########################################'
@@ -620,4 +644,6 @@
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon 
+      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
+      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
 
       RETURN
@@ -746,10 +772,26 @@
 
 !Config  Key  = ok_dynzon 
-!Config  Desc = calcul et sortie des transports 
+!Config  Desc = sortie des transports zonaux dans la dynamique
 !Config  Def  = n 
-!Config  Help = Permet de mettre en route le calcul des transports 
+!Config  Help =  
 !Config          
        ok_dynzon = .FALSE.
        CALL getin('ok_dynzon',ok_dynzon) 
+
+!Config  Key  = ok_dyn_ins
+!Config  Desc = sorties instantanees dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ins = .FALSE. 
+      CALL getin('ok_dyn_ins',ok_dyn_ins) 
+
+!Config  Key  = ok_dyn_ave
+!Config  Desc = sorties moyennes dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ave = .FALSE. 
+      CALL getin('ok_dyn_ave',ok_dyn_ave) 
 
 !Config key = ok_strato
@@ -824,4 +866,6 @@
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon
+      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
+      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
       write(lunout,*)' ok_strato = ', ok_strato
       write(lunout,*)' ok_gradsfile = ', ok_gradsfile
Index: DZ4/trunk/libf/dyn3d/control.h
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/control.h	(revision 1402)
+++ 	(revision )
@@ -1,29 +1,0 @@
-!
-! $Header$
-!
-!
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez à n'utiliser que des ! pour les commentaires
-!                 et à bien positionner les & des lignes de continuation 
-!                 (les placer en colonne 6 et en colonne 73)
-!
-!-----------------------------------------------------------------------
-! INCLUDE 'control.h'
-
-      COMMON/control/nday,day_step,                                     &
-     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
-     &              periodav,iecrimoy,dayref,anneeref,                  &
-     &              raz_date,offline,ip_ebil_dyn,config_inca,           &
-     &              planet_type,output_grads_dyn,ok_dynzon
-
-      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,        &
-     &          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date      &
-     &          ,ip_ebil_dyn
-      REAL periodav
-      LOGICAL offline
-      CHARACTER (len=4) :: config_inca
-      CHARACTER(len=10) :: planet_type ! planet type ('earth','mars',...)
-      LOGICAL :: output_grads_dyn ! output dynamics diagnostics in
-                                  ! binary grads file 'dyn.dat' (y/n)
-      LOGICAL :: ok_dynzon
-!-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3d/control_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/control_mod.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3d/control_mod.F90	(revision 1403)
@@ -0,0 +1,27 @@
+!
+! $Id $
+!
+
+MODULE control_mod
+
+! LF 01/2010
+! Remplacement du fichier et common control
+
+  IMPLICIT NONE
+
+  REAL    :: periodav
+  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
+  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
+  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
+  LOGICAL :: offline
+  CHARACTER (len=4)  :: config_inca
+  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
+  LOGICAL output_grads_dyn ! output dynamics diagnostics in
+                           ! binary grads file 'dyn.dat' (y/n)
+  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
+  LOGICAL ok_dyn_ins ! output instantaneous values of fields
+                     ! in the dynamics in NetCDF files dyn_hist*nc
+  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
+                     ! in NetCDF files dyn_hist*ave.nc
+
+END MODULE
Index: /LMDZ4/trunk/libf/dyn3d/defrun.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/defrun.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/defrun.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -6,4 +6,6 @@
       SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
 c
+      USE control_mod
+ 
       IMPLICIT NONE
 c-----------------------------------------------------------------------
@@ -28,5 +30,4 @@
 #include "dimensions.h"
 #include "paramet.h"
-#include "control.h"
 #include "logic.h"
 #include "serre.h"
@@ -239,6 +240,6 @@
        clesphy0(i) = 0.
       ENDDO
-                          clesphy0(1) = FLOAT( iflag_con )
-                          clesphy0(2) = FLOAT( nbapp_rad )
+                          clesphy0(1) = REAL( iflag_con )
+                          clesphy0(2) = REAL( nbapp_rad )
 
        IF( cycle_diurne  ) clesphy0(3) =  1.
Index: /LMDZ4/trunk/libf/dyn3d/disvert.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/disvert.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/disvert.F	(revision 1403)
@@ -111,5 +111,5 @@
       snorm  = 0.
       DO l = 1, llm
-         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1)
 
          IF (ok_strato) THEN
@@ -135,9 +135,9 @@
 
       DO l=1,llm
-        nivsigs(l) = FLOAT(l)
+        nivsigs(l) = REAL(l)
       ENDDO
 
       DO l=1,llmp1
-        nivsig(l)= FLOAT(l)
+        nivsig(l)= REAL(l)
       ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3d/dynetat0.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/dynetat0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/dynetat0.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id $
 !
       SUBROUTINE dynetat0(fichnom,vcov,ucov,
@@ -34,4 +34,5 @@
 #include "serre.h"
 #include "logic.h"
+#include "iniprint.h"
 
 c   Arguments:
@@ -58,6 +59,6 @@
       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
       IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier start.nc'
-        write(6,*)' ierr = ', ierr
+        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
+        write(lunout,*)' ierr = ', ierr
         CALL ABORT
       ENDIF
@@ -66,5 +67,5 @@
       ierr = NF_INQ_VARID (nid, "controle", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <controle> est absent"
+         write(lunout,*)"dynetat0: Le champ <controle> est absent"
          CALL abort
       ENDIF
@@ -75,5 +76,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echoue pour <controle>"
+         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
          CALL abort
       ENDIF
@@ -121,5 +122,6 @@
 c
 c
-      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
+     &               rad,omeg,g,cpp,kappa
 
       IF(   im.ne.iim           )  THEN
@@ -136,5 +138,5 @@
       ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlonu> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
          CALL abort
       ENDIF
@@ -145,5 +147,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
          CALL abort
       ENDIF
@@ -151,5 +153,5 @@
       ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlatu> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
          CALL abort
       ENDIF
@@ -160,5 +162,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
          CALL abort
       ENDIF
@@ -166,5 +168,5 @@
       ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlonv> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
          CALL abort
       ENDIF
@@ -175,5 +177,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
          CALL abort
       ENDIF
@@ -181,5 +183,5 @@
       ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlatv> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
          CALL abort
       ENDIF
@@ -190,5 +192,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour rlatv"
+         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
          CALL abort
       ENDIF
@@ -196,5 +198,5 @@
       ierr = NF_INQ_VARID (nid, "cu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <cu> est absent"
+         write(lunout,*)"dynetat0: Le champ <cu> est absent"
          CALL abort
       ENDIF
@@ -205,5 +207,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <cu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
          CALL abort
       ENDIF
@@ -211,5 +213,5 @@
       ierr = NF_INQ_VARID (nid, "cv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <cv> est absent"
+         write(lunout,*)"dynetat0: Le champ <cv> est absent"
          CALL abort
       ENDIF
@@ -220,5 +222,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <cv>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
          CALL abort
       ENDIF
@@ -226,5 +228,5 @@
       ierr = NF_INQ_VARID (nid, "aire", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <aire> est absent"
+         write(lunout,*)"dynetat0: Le champ <aire> est absent"
          CALL abort
       ENDIF
@@ -235,5 +237,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <aire>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
          CALL abort
       ENDIF
@@ -241,5 +243,5 @@
       ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <phisinit> est absent"
+         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
          CALL abort
       ENDIF
@@ -250,5 +252,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
          CALL abort
       ENDIF
@@ -256,5 +258,5 @@
       ierr = NF_INQ_VARID (nid, "temps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <temps> est absent"
+         write(lunout,*)"dynetat0: Le champ <temps> est absent"
          CALL abort
       ENDIF
@@ -265,5 +267,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee <temps>"
+         write(lunout,*)"dynetat0: Lecture echouee <temps>"
          CALL abort
       ENDIF
@@ -271,5 +273,5 @@
       ierr = NF_INQ_VARID (nid, "ucov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <ucov> est absent"
+         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
          CALL abort
       ENDIF
@@ -280,5 +282,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
          CALL abort
       ENDIF
@@ -286,5 +288,5 @@
       ierr = NF_INQ_VARID (nid, "vcov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <vcov> est absent"
+         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
          CALL abort
       ENDIF
@@ -295,5 +297,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
          CALL abort
       ENDIF
@@ -301,5 +303,5 @@
       ierr = NF_INQ_VARID (nid, "teta", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <teta> est absent"
+         write(lunout,*)"dynetat0: Le champ <teta> est absent"
          CALL abort
       ENDIF
@@ -310,5 +312,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <teta>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
          CALL abort
       ENDIF
@@ -319,6 +321,7 @@
         ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
         IF (ierr .NE. NF_NOERR) THEN
-           PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
-           PRINT*, "          Il est donc initialise a zero"
+           write(lunout,*)"dynetat0: Le champ <"//tname(iq)//
+     &                    "> est absent"
+           write(lunout,*)"          Il est donc initialise a zero"
            q(:,:,iq)=0.
         ELSE
@@ -329,6 +332,6 @@
 #endif
           IF (ierr .NE. NF_NOERR) THEN
-             PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
-             CALL abort
+            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
+            CALL abort
           ENDIF
         ENDIF
@@ -338,5 +341,5 @@
       ierr = NF_INQ_VARID (nid, "masse", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <masse> est absent"
+         write(lunout,*)"dynetat0: Le champ <masse> est absent"
          CALL abort
       ENDIF
@@ -347,5 +350,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <masse>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
          CALL abort
       ENDIF
@@ -353,5 +356,5 @@
       ierr = NF_INQ_VARID (nid, "ps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <ps> est absent"
+         write(lunout,*)"dynetat0: Le champ <ps> est absent"
          CALL abort
       ENDIF
@@ -362,5 +365,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <ps>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
          CALL abort
       ENDIF
Index: /LMDZ4/trunk/libf/dyn3d/dynredem.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/dynredem.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/dynredem.F	(revision 1403)
@@ -8,4 +8,5 @@
 #endif
       USE infotrac
+ 
       IMPLICIT NONE
 c=======================================================================
@@ -25,4 +26,5 @@
 #include "description.h"
 #include "serre.h"
+#include "iniprint.h"
 
 c   Arguments:
@@ -72,9 +74,9 @@
        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(1)  = REAL(iim)
+       tab_cntrl(2)  = REAL(jjm)
+       tab_cntrl(3)  = REAL(llm)
+       tab_cntrl(4)  = REAL(day_ref)
+       tab_cntrl(5)  = REAL(annee_ref)
        tab_cntrl(6)  = rad
        tab_cntrl(7)  = omeg
@@ -116,6 +118,6 @@
       ENDIF
 
-       tab_cntrl(30) = FLOAT(iday_end)
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(30) = REAL(iday_end)
+       tab_cntrl(31) = REAL(itau_dyn + itaufin)
 c
 c    .........................................................
@@ -125,6 +127,7 @@
       ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
       IF (ierr.NE.NF_NOERR) THEN
-         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
-         WRITE(6,*)' ierr = ', ierr
+         write(lunout,*)"dynredem0: Pb d ouverture du fichier "
+     &                  //trim(fichnom)
+         write(lunout,*)' ierr = ', ierr
          CALL ABORT
       ENDIF
@@ -508,7 +511,8 @@
       ierr = NF_CLOSE(nid) ! fermer le fichier
 
-      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
-      PRINT*,'rad,omeg,g,cpp,kappa',
-     ,        rad,omeg,g,cpp,kappa
+      write(lunout,*)'dynredem0: iim,jjm,llm,iday_end',
+     &               iim,jjm,llm,iday_end
+      write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa',
+     &        rad,omeg,g,cpp,kappa
 
       RETURN
@@ -517,4 +521,6 @@
      .                     vcov,ucov,teta,q,masse,ps)
       USE infotrac
+      USE control_mod
+ 
       IMPLICIT NONE
 c=================================================================
@@ -528,5 +534,6 @@
 #include "comgeom.h"
 #include "temps.h"
-#include "control.h"
+#include "iniprint.h"
+
 
       INTEGER l
@@ -555,5 +562,5 @@
       ierr = NF_OPEN(fichnom, NF_WRITE, nid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Pb. d ouverture "//fichnom
+         write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
          CALL abort
       ENDIF
@@ -564,5 +571,5 @@
       ierr = NF_INQ_VARID(nid, "temps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         print *, NF_STRERROR(ierr)
+         write(lunout,*) NF_STRERROR(ierr)
          abort_message='Variable temps n est pas definie'
          CALL abort_gcm(modname,abort_message,ierr)
@@ -573,5 +580,5 @@
       ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
 #endif
-      PRINT*, "Enregistrement pour ", nb, time
+      write(lunout,*) "dynredem1: Enregistrement pour ", nb, time
 
 c
@@ -589,5 +596,5 @@
       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
 #endif
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(31) = REAL(itau_dyn + itaufin)
 #ifdef NC_DOUBLE
       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
@@ -600,6 +607,7 @@
       ierr = NF_INQ_VARID(nid, "ucov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ucov n est pas definie"
-         CALL abort
+         abort_message="Variable ucov n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -611,6 +619,7 @@
       ierr = NF_INQ_VARID(nid, "vcov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
+         abort_message="Variable vcov n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -622,6 +631,7 @@
       ierr = NF_INQ_VARID(nid, "teta", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable teta n est pas definie"
-         CALL abort
+         abort_message="Variable teta n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -635,6 +645,7 @@
          ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
          IF (ierr_file .NE.NF_NOERR) THEN
-            write(6,*)' Pb d''ouverture du fichier start_trac.nc'
-            write(6,*)' ierr = ', ierr_file 
+            write(lunout,*)'dynredem1: Pb d''ouverture du fichier',
+     &                     ' start_trac.nc'
+            write(lunout,*)' ierr = ', ierr_file 
          ENDIF
       END IF
@@ -646,6 +657,7 @@
             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
             IF (ierr .NE. NF_NOERR) THEN
-               PRINT*, "Variable  tname(iq) n est pas definie"
-               CALL abort
+               abort_message="Variable  tname(iq) n est pas definie"
+               ierr=1
+               CALL abort_gcm(modname,abort_message,ierr)
             ENDIF
 #ifdef NC_DOUBLE
@@ -659,9 +671,12 @@
              ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
              IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, tname(iq),"est absent de start_trac.nc"
+                write(lunout,*) "dynredem1: ",trim(tname(iq)),
+     &                          " est absent de start_trac.nc"
                 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
+                   abort_message="dynredem1: Variable "//
+     &                     trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
 #ifdef NC_DOUBLE
@@ -672,5 +687,6 @@
                 
              ELSE
-                PRINT*, tname(iq), "est present dans start_trac.nc"
+                write(lunout,*) "dynredem1: ",trim(tname(iq)),
+     &              " est present dans start_trac.nc"
 #ifdef NC_DOUBLE
                ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
@@ -679,11 +695,15 @@
 #endif
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Lecture echouee pour", tname(iq)
-                   CALL abort
+                   abort_message="dynredem1: Lecture echouee pour"//
+     &                    trim(tname(iq))
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
                 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
+                   abort_message="dynredem1: Variable "//
+     &                trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
 #ifdef NC_DOUBLE
@@ -699,6 +719,8 @@
              ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
              IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, "Variable  tname(iq) n est pas definie"
-                CALL abort
+                abort_message="dynredem1: Variable "//
+     &                trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
              ENDIF
 #ifdef NC_DOUBLE
@@ -715,6 +737,7 @@
       ierr = NF_INQ_VARID(nid, "masse", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable masse n est pas definie"
-         CALL abort
+         abort_message="dynredem1: Variable masse n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -726,6 +749,7 @@
       ierr = NF_INQ_VARID(nid, "ps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ps n est pas definie"
-         CALL abort
+         abort_message="dynredem1: Variable ps n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
Index: /LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F90	(revision 1403)
@@ -11,4 +11,5 @@
 ! Note: This routine is designed to work for Earth
 !-------------------------------------------------------------------------------
+  USE control_mod
 #ifdef CPP_EARTH
   USE startvar
@@ -72,5 +73,4 @@
 
 #include "comdissnew.h"
-#include "control.h"
 #include "serre.h"
 #include "clesphys.h"
@@ -103,4 +103,5 @@
   REAL    :: tau_thermals, solarlong0,  seuil_inversion
   INTEGER :: read_climoz ! read ozone climatology
+  REAL    :: alp_offset
 !  Allowed values are 0, 1 and 2
 !     0: do not read an ozone climatology
@@ -132,5 +133,6 @@
                    iflag_thermals,nsplit_thermals,tau_thermals,         &
                    iflag_thermals_ed,iflag_thermals_optflux,            &
-                   iflag_coupl,iflag_clos,iflag_wake, read_climoz )
+                   iflag_coupl,iflag_clos,iflag_wake, read_climoz,      &
+                   alp_offset )
 
 ! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
Index: /LMDZ4/trunk/libf/dyn3d/exner_hyb.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/exner_hyb.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/exner_hyb.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id $
 !
       SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
@@ -51,5 +51,33 @@
       REAL SSUM
 c
+
+      if (llm.eq.1) then
+        ! Specific behaviour for Shallow Water (1 vertical layer) case
       
+        ! Sanity checks
+        if (kappa.ne.1) then
+          call abort_gcm("exner_hyb",
+     &    "kappa!=1 , but running in Shallow Water mode!!",42)
+        endif
+        if (cpp.ne.r) then
+        call abort_gcm("exner_hyb",
+     &    "cpp!=r , but running in Shallow Water mode!!",42)
+        endif
+        
+        ! Compute pks(:),pk(:),pkf(:)
+        
+        DO   ij  = 1, ngrid
+          pks(ij) = (cpp/preff) * ps(ij) 
+          pk(ij,1) = .5*pks(ij)
+        ENDDO
+        
+        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+        CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
+        
+        ! our work is done, exit routine
+        return
+      endif ! of if (llm.eq.1)
+
+     
       unpl2k    = 1.+ 2.* kappa
 c
Index: /LMDZ4/trunk/libf/dyn3d/extrapol.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/extrapol.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/extrapol.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 C
@@ -158,5 +158,5 @@
                jlat = jy(k)
                pwork(i,j) = pwork(i,j)
-     $                      + pfild(ilon,jlat) * zmask(k)/FLOAT(inbor)
+     $                      + pfild(ilon,jlat) * zmask(k)/REAL(inbor)
             ENDDO
          ENDIF
Index: /LMDZ4/trunk/libf/dyn3d/fluxstokenc.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/fluxstokenc.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/fluxstokenc.F	(revision 1403)
@@ -4,6 +4,6 @@
       SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
      . time_step,itau )
-#ifdef CPP_EARTH
-! This routine is designed to work for Earth and with ioipsl
+#ifdef CPP_IOIPSL
+! This routine is designed to work with ioipsl
 
        USE IOIPSL
@@ -114,10 +114,10 @@
       DO l=1,llm
          DO ij = 1,ip1jmp1
-            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
-            tetac(ij,l) = tetac(ij,l)/float(istdyn)
-            phic(ij,l) = phic(ij,l)/float(istdyn)
+            pbaruc(ij,l) = pbaruc(ij,l)/REAL(istdyn)
+            tetac(ij,l) = tetac(ij,l)/REAL(istdyn)
+            phic(ij,l) = phic(ij,l)/REAL(istdyn)
          ENDDO
          DO ij = 1,ip1jm
-            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+            pbarvc(ij,l) = pbarvc(ij,l)/REAL(istdyn)
          ENDDO
       ENDDO
@@ -141,5 +141,5 @@
 
          iadvtr=0
-	Print*,'ITAU auqel on stoke les fluxmasses',itau
+	write(lunout,*)'ITAU auquel on stoke les fluxmasses',itau
 	
 	call histwrite(fluxid, 'masse', itau, massem,
@@ -167,7 +167,7 @@
 #else
       write(lunout,*)
-     & 'fluxstokenc: Needs Earth physics (and ioipsl) to function'
+     & 'fluxstokenc: Needs IOIPSL to function'
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_IOIPSL
       RETURN
       END
Index: /LMDZ4/trunk/libf/dyn3d/friction.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/friction.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/friction.F	(revision 1403)
@@ -1,7 +1,10 @@
 !
-! $Header$
+! $Id$
 !
 c=======================================================================
       SUBROUTINE friction(ucov,vcov,pdt)
+
+      USE control_mod
+ 
       IMPLICIT NONE
 
@@ -21,5 +24,4 @@
 #include "paramet.h"
 #include "comgeom2.h"
-#include "control.h"
 #include "comconst.h"
 
Index: /LMDZ4/trunk/libf/dyn3d/fxhyp.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/fxhyp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/fxhyp.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -89,5 +89,5 @@
 
        DO i = 0, nmax2 
-        xtild(i) = - pi + FLOAT(i) * depi /nmax2
+        xtild(i) = - pi + REAL(i) * depi /nmax2
        ENDDO
 
@@ -235,5 +235,5 @@
       DO 1500 i = ii1, ii2
 
-      xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
+      xlon2 = - pi + (REAL(i) + xuv - decalx) * depi / REAL(iim) 
 
       Xfi    = xlon2
@@ -280,5 +280,5 @@
 550   CONTINUE
 
-       xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )
+       xxprim(i) = depi/ ( REAL(iim) * Xprimin )
        xvrai(i)  =  xi + xzoom
 
Index: /LMDZ4/trunk/libf/dyn3d/fxy.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/fxy.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/fxy.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
@@ -32,6 +32,6 @@
 c
        DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( FLOAT( j )        )
-         yprimu(j) = fyprim( FLOAT( j )        )
+          rlatu(j) = fy    ( REAL( j )        )
+         yprimu(j) = fyprim( REAL( j )        )
        ENDDO
 
@@ -39,11 +39,11 @@
        DO j = 1, jjm
 
-         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
-         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
+         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
 
-        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
-        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
+        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
 
        ENDDO
@@ -53,13 +53,13 @@
 c
        DO i = 1, iim + 1
-           rlonv(i)     = fx    (   FLOAT( i )          )
-           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
-        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
-        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+           rlonv(i)     = fx    (   REAL( i )          )
+           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
+        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
+        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
 
-         xprimv  (i)    = fxprim (  FLOAT( i )          )
-         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+         xprimv  (i)    = fxprim (  REAL( i )          )
+         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
        ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3d/fxysinus.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/fxysinus.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/fxysinus.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
@@ -32,6 +32,6 @@
 c
        DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( FLOAT( j )        )
-         yprimu(j) = fyprim( FLOAT( j )        )
+          rlatu(j) = fy    ( REAL( j )        )
+         yprimu(j) = fyprim( REAL( j )        )
        ENDDO
 
@@ -39,11 +39,11 @@
        DO j = 1, jjm
 
-         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
-         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
+         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
 
-        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
-        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
+        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
 
        ENDDO
@@ -53,13 +53,13 @@
 c
        DO i = 1, iim + 1
-           rlonv(i)     = fx    (   FLOAT( i )          )
-           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
-        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
-        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+           rlonv(i)     = fx    (   REAL( i )          )
+           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
+        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
+        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
 
-         xprimv  (i)    = fxprim (  FLOAT( i )          )
-         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+         xprimv  (i)    = fxprim (  REAL( i )          )
+         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
        ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3d/fyhyp.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/fyhyp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/fyhyp.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -75,5 +75,5 @@
        depi     = 2. * pi
        pis2     = pi/2.
-       pisjm    = pi/ FLOAT(jjm)
+       pisjm    = pi/ REAL(jjm)
        epsilon  = 1.e-3
        y0       =  yzoomdeg * pi/180. 
@@ -94,5 +94,5 @@
 
        DO i = 0, nmax2 
-        yt(i) = - pis2  + FLOAT(i)* pi /nmax2
+        yt(i) = - pis2  + REAL(i)* pi /nmax2
        ENDDO
 
@@ -210,5 +210,5 @@
        DO 1500 j =  1,jlat
         yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( FLOAT(j)  + yuv  -1.)  
+        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
         yfi    = ylon2
 c
Index: /LMDZ4/trunk/libf/dyn3d/gcm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/gcm.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/gcm.F	(revision 1403)
@@ -15,4 +15,5 @@
       USE filtreg_mod
       USE infotrac
+      USE control_mod
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -68,13 +69,15 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
+!!!!!!!!!!!#include "control.h"
 #include "ener.h"
 #include "description.h"
 #include "serre.h"
-#include "com_io_dyn.h"
+!#include "com_io_dyn.h"
 #include "iniprint.h"
 #include "tracstoke.h"
+#ifdef INCA
+! Only INCA needs these informations (from the Earth's physics)
 #include "indicesol.h"
-
+#endif
       INTEGER         longcles
       PARAMETER     ( longcles = 20 )
@@ -181,5 +184,5 @@
       if (planet_type.eq."earth") then
 #ifdef CPP_EARTH
-      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(jjm-1)*iim+2)
+      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
       call InitComgeomphy
 #endif
@@ -241,16 +244,24 @@
       if (read_start) then
       ! we still need to run iniacademic to initialize some
-      ! constants & fields, if we run the 'newtonian' case:
-        if (iflag_phys.eq.2) then
+      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
+        if (iflag_phys.ne.1) then
           CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
         endif
-!#ifdef CPP_IOIPSL
+
         if (planet_type.eq."earth") then
 #ifdef CPP_EARTH
 ! Load an Earth-format start file
          CALL dynetat0("start.nc",vcov,ucov,
-     .              teta,q,masse,ps,phis, time_0)
+     &              teta,q,masse,ps,phis, time_0)
+#else
+        ! SW model also has Earth-format start files
+        ! (but can be used without the CPP_EARTH directive)
+          if (iflag_phys.eq.0) then
+            CALL dynetat0("start.nc",vcov,ucov,
+     &              teta,q,masse,ps,phis, time_0)
+          endif
 #endif
         endif ! of if (planet_type.eq."earth")
+        
 c       write(73,*) 'ucov',ucov
 c       write(74,*) 'vcov',vcov
@@ -294,5 +305,5 @@
       ENDIF
 
-      zdtvr    = daysec/FLOAT(day_step)
+      zdtvr    = daysec/REAL(day_step)
         IF(dtvr.NE.zdtvr) THEN
          WRITE(lunout,*)
@@ -303,5 +314,14 @@
 C on remet le calendrier à zero si demande
 c
-      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
+      IF (raz_date == 1) THEN
+        annee_ref = anneeref
+        day_ref = dayref
+        day_ini = dayref
+        itau_dyn = 0
+        itau_phy = 0
+        time_0 = 0.
+        write(lunout,*)
+     .   'GCM: On reinitialise a la date lue dans gcm.def'
+      ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
         write(lunout,*)
      .  'GCM: Attention les dates initiales lues dans le fichier'
@@ -309,22 +329,33 @@
      .  ' restart ne correspondent pas a celles lues dans '
         write(lunout,*)' gcm.def'
-	write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-	write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-        if (raz_date .ne. 1) then
-          write(lunout,*)
-     .    'GCM: On garde les dates du fichier restart'
-        else
-          annee_ref = anneeref
-          day_ref = dayref
-          day_ini = dayref
-          itau_dyn = 0
-          itau_phy = 0
-          time_0 = 0.
-          write(lunout,*)
-     .   'GCM: On reinitialise a la date lue dans gcm.def'
-        endif
-      ELSE
-        raz_date = 0
-      endif
+        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
+        write(lunout,*)' Pas de remise a zero'
+      ENDIF
+
+c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
+c        write(lunout,*)
+c     .  'GCM: Attention les dates initiales lues dans le fichier'
+c        write(lunout,*)
+c     .  ' restart ne correspondent pas a celles lues dans '
+c        write(lunout,*)' gcm.def'
+c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
+c        if (raz_date .ne. 1) then
+c          write(lunout,*)
+c     .    'GCM: On garde les dates du fichier restart'
+c        else
+c          annee_ref = anneeref
+c          day_ref = dayref
+c          day_ini = dayref
+c          itau_dyn = 0
+c          itau_phy = 0
+c          time_0 = 0.
+c          write(lunout,*)
+c     .   'GCM: On reinitialise a la date lue dans gcm.def'
+c        endif
+c      ELSE
+c        raz_date = 0
+c      endif
 
 #ifdef CPP_IOIPSL
@@ -355,19 +386,23 @@
       nbetatmoy = nday / periodav + 1
 
+      if (iflag_phys.eq.1) then
+      ! these initialisations have already been done (via iniacademic)
+      ! if running in SW or Newtonian mode
 c-----------------------------------------------------------------------
 c   Initialisation des constantes dynamiques :
 c   ------------------------------------------
-      dtvr = zdtvr
-      CALL iniconst
+        dtvr = zdtvr
+        CALL iniconst
 
 c-----------------------------------------------------------------------
 c   Initialisation de la geometrie :
 c   --------------------------------
-      CALL inigeom
+        CALL inigeom
 
 c-----------------------------------------------------------------------
 c   Initialisation du filtre :
 c   --------------------------
-      CALL inifilr
+        CALL inifilr
+      endif ! of if (iflag_phys.eq.1)
 c
 c-----------------------------------------------------------------------
@@ -405,5 +440,5 @@
          if (planet_type.eq."earth") then
 #ifdef CPP_EARTH
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
+         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
 #endif
@@ -440,21 +475,22 @@
 
 #ifdef CPP_IOIPSL
-      if ( 1.eq.1) then
       time_step = zdtvr
-      t_ops = iecri * daysec
-      t_wrt = iecri * daysec
-!      CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
-!    .              t_ops, t_wrt, histid, histvid)
-
-!     IF (ok_dynzon) THEN 
-!        t_ops = iperiod * time_step
-!        t_wrt = periodav * daysec
-!        CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
-!    .        t_ops, t_wrt, histaveid)
-!     END IF
+      if (ok_dyn_ins) then
+        ! initialize output file for instantaneous outputs
+        ! t_ops = iecri * daysec ! do operations every t_ops
+        t_ops =((1.0*iecri)/day_step) * daysec  
+        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
+        CALL inithist(day_ref,annee_ref,time_step,
+     &              t_ops,t_wrt)
+      endif
+
+      IF (ok_dyn_ave) THEN 
+        ! initialize output file for averaged outputs
+        t_ops = iperiod * time_step ! do operations every t_ops
+        t_wrt = periodav * daysec   ! write output every t_wrt
+        CALL initdynav(day_ref,annee_ref,time_step,
+     &       t_ops,t_wrt)
+      END IF
       dtav = iperiod*dtvr/daysec
-      endif
-
-
 #endif
 ! #endif of #ifdef CPP_IOIPSL
Index: /LMDZ4/trunk/libf/dyn3d/grid_atob.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/grid_atob.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/grid_atob.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
@@ -717,14 +717,14 @@
 c Calculs intermediares:
 c
-      xtmp(1) = -180.0 + 360.0/FLOAT(imtmp) / 2.0
+      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
       DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/FLOAT(imtmp)
+         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
       ENDDO
       DO i = 1, imtmp
          xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
       ENDDO
-      ytmp(1) = -90.0 + 180.0/FLOAT(jmtmp) / 2.0
+      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
       DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/FLOAT(jmtmp)
+         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
       ENDDO
       DO j = 1, jmtmp
Index: /LMDZ4/trunk/libf/dyn3d/grid_noro.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/grid_noro.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/grid_noro.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -93,5 +93,5 @@
       xpi=acos(-1.)
       rad    = 6 371 229.
-      zdeltay=2.*xpi/float(jusn)*rad
+      zdeltay=2.*xpi/REAL(jusn)*rad
 c
 c utilise-t'on un masque lu?
@@ -215,6 +215,6 @@
 c  SUMMATION OVER GRIDPOINT AREA
 c 
-      zleny=xpi/float(jusn)*rad
-      xincr=xpi/2./float(jusn)
+      zleny=xpi/REAL(jusn)*rad
+      xincr=xpi/2./REAL(jusn)
        DO ii = 1, imar+1
        DO jj = 1, jmar
@@ -468,5 +468,5 @@
       DO IS=-1,1
         DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
+          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
           SUM=SUM+WEIGHTpb(IS,JS)
         ENDDO
Index: /LMDZ4/trunk/libf/dyn3d/grilles_gcm_netcdf.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/grilles_gcm_netcdf.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/grilles_gcm_netcdf.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -218,13 +218,13 @@
       open (20,file='grille.dat',form='unformatted',access='direct'
      s      ,recl=4*ip1jmp1)
-      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
-      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=1) ((REAL(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=2) ((REAL(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
       do j=2,jjm
          dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
-c        dlat2(j)=180.*fyprim(float(j))/pi
+c        dlat2(j)=180.*fyprim(REAL(j))/pi
       enddo
       do i=2,iip1
          dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
-c        dlon2(i)=180.*fxprim(float(i))/pi
+c        dlon2(i)=180.*fxprim(REAL(i))/pi
       enddo
       do j=2,jjm
Index: /LMDZ4/trunk/libf/dyn3d/guide_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/guide_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/guide_mod.F90	(revision 1403)
@@ -62,4 +62,6 @@
   SUBROUTINE guide_init
 
+    USE control_mod
+
     IMPLICIT NONE
   
@@ -67,5 +69,4 @@
     INCLUDE "paramet.h"
     INCLUDE "netcdf.inc"
-    INCLUDE "control.h"
 
     INTEGER                :: error,ncidpl,rid,rcod
@@ -269,4 +270,6 @@
 !=======================================================================
   SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
+
+    USE control_mod
  
     IMPLICIT NONE
@@ -274,5 +277,4 @@
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
-    INCLUDE "control.h"
     INCLUDE "comconst.h"
     INCLUDE "comvert.h"
@@ -354,7 +356,7 @@
       dday_step=real(day_step)
       IF (iguide_read.LT.0) THEN
-          tau=ditau/dday_step/FLOAT(iguide_read)
+          tau=ditau/dday_step/REAL(iguide_read)
       ELSE
-          tau=FLOAT(iguide_read)*ditau/dday_step
+          tau=REAL(iguide_read)*ditau/dday_step
       ENDIF
       reste=tau-AINT(tau)
@@ -541,5 +543,5 @@
             ENDDO
         ENDDO 
-        fieldm(:,l)=fieldm(:,l)/FLOAT(imax(typ)-imin(typ)+1)
+        fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
     ! Compute forcing
         DO j=1,hsize
Index: /LMDZ4/trunk/libf/dyn3d/infotrac.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/infotrac.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/infotrac.F90	(revision 1403)
@@ -31,4 +31,7 @@
 
   SUBROUTINE infotrac_init
+
+    USE control_mod
+ 
     IMPLICIT NONE
 !=======================================================================
@@ -49,5 +52,4 @@
 
     INCLUDE "dimensions.h"
-    INCLUDE "control.h"
     INCLUDE "iniprint.h"
 
@@ -217,5 +219,5 @@
           new_iq=new_iq+10 ! 9 tracers added
        ELSE
-          WRITE(lunout,*) 'This choice of advection schema is not available'
+          WRITE(lunout,*) 'This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
        END IF
@@ -258,5 +260,5 @@
           iadv(new_iq)=11
        ELSE
-          WRITE(lunout,*)'This choice of advection schema is not available'
+          WRITE(lunout,*)'This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
        END IF
Index: /LMDZ4/trunk/libf/dyn3d/iniacademic.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/iniacademic.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/iniacademic.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -8,4 +8,6 @@
       USE filtreg_mod
       USE infotrac, ONLY : nqtot
+      USE control_mod
+ 
 
 c%W%    %G%
@@ -44,6 +46,6 @@
 #include "ener.h"
 #include "temps.h"
-#include "control.h"
 #include "iniprint.h"
+#include "logic.h"
 
 c   Arguments:
@@ -84,5 +86,5 @@
         time_0=0.
         day_ref=0
-	annee_ref=0
+        annee_ref=0
 
         im         = iim
@@ -93,5 +95,5 @@
         g      = 9.8
         daysec = 86400.
-        dtvr    = daysec/FLOAT(day_step)
+        dtvr    = daysec/REAL(day_step)
         zdtvr=dtvr
         kappa  = 0.2857143
@@ -105,13 +107,31 @@
         ang0       = 0.
 
+        if (llm.eq.1) then
+          ! specific initializations for the shallow water case
+          kappa=1
+        endif
+        
         CALL iniconst
         CALL inigeom
         CALL inifilr
 
-        ps=0.
-        phis=0.
+        if (llm.eq.1) then
+          ! initialize fields for the shallow water case, if required
+          if (.not.read_start) then
+            phis(:)=0.
+            q(:,:,1)=1.e-10
+            q(:,:,2)=1.e-15
+            q(:,:,3:nqtot)=0.
+            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+          endif
+        endif
+
+        if (iflag_phys.eq.2) then
+          ! initializations for the academic case
+          ps(:)=1.e5
+          phis(:)=0.
 c---------------------------------------------------------------------
 
-        taurappel=10.*daysec
+          taurappel=10.*daysec
 
 c---------------------------------------------------------------------
@@ -119,63 +139,61 @@
 c   --------------------------------------
 
-        DO l=1,llm
-         zsig=ap(l)/preff+bp(l)
-         if (zsig.gt.0.3) then
-           lsup=l
-           tetarappell=1./8.*(-log(zsig)-.5)
-           DO j=1,jjp1
+          DO l=1,llm
+            zsig=ap(l)/preff+bp(l)
+            if (zsig.gt.0.3) then
+             lsup=l
+             tetarappell=1./8.*(-log(zsig)-.5)
+             DO j=1,jjp1
              ddsin=sin(rlatu(j))-sin(pi/20.)
              tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
-           ENDDO
-          else
+             ENDDO
+            else
 c   Choix isotherme au-dessus de 300 mbar
-           do j=1,jjp1
-             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
-           enddo
-          endif ! of if (zsig.gt.0.3)
-        ENDDO ! of DO l=1,llm
-
-        do l=1,llm
-           do j=1,jjp1
+             do j=1,jjp1
+               tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
+             enddo
+            endif ! of if (zsig.gt.0.3)
+          ENDDO ! of DO l=1,llm
+
+          do l=1,llm
+            do j=1,jjp1
               do i=1,iip1
                  ij=(j-1)*iip1+i
                  tetarappel(ij,l)=tetajl(j,l)
               enddo
-           enddo
-        enddo
+            enddo
+          enddo
 
 c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
 
-        ps=1.e5
-        phis=0.
-        CALL pression ( ip1jmp1, ap, bp, ps, p       )
-        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        CALL massdair(p,masse)
+          CALL pression ( ip1jmp1, ap, bp, ps, p       )
+          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+          CALL massdair(p,masse)
 
 c  intialisation du vent et de la temperature
-        teta(:,:)=tetarappel(:,:)
-        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
-        call ugeostr(phi,ucov)
-        vcov=0.
-        q(:,:,1   )=1.e-10
-        q(:,:,2   )=1.e-15
-        q(:,:,3:nqtot)=0.
+          teta(:,:)=tetarappel(:,:)
+          CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
+          call ugeostr(phi,ucov)
+          vcov=0.
+          q(:,:,1   )=1.e-10
+          q(:,:,2   )=1.e-15
+          q(:,:,3:nqtot)=0.
 
 
 c   perturbation aleatoire sur la temperature
-        idum  = -1
-        zz = ran1(idum)
-        idum  = 0
-        do l=1,llm
-           do ij=iip2,ip1jm
+          idum  = -1
+          zz = ran1(idum)
+          idum  = 0
+          do l=1,llm
+            do ij=iip2,ip1jm
               teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
-           enddo
-        enddo
-
-        do l=1,llm
-           do ij=1,ip1jmp1,iip1
+            enddo
+          enddo
+
+          do l=1,llm
+            do ij=1,ip1jmp1,iip1
               teta(ij+iim,l)=teta(ij,l)
-           enddo
-        enddo
+            enddo
+          enddo
 
 
@@ -187,9 +205,10 @@
 
 c   initialisation d'un traceur sur une colonne
-        j=jjp1*3/4
-        i=iip1/2
-        ij=(j-1)*iip1+i
-        q(ij,:,3)=1.
-      
+          j=jjp1*3/4
+          i=iip1/2
+          ij=(j-1)*iip1+i
+          q(ij,:,3)=1.
+        endif ! of if (iflag_phys.eq.2)
+        
       else
         write(lunout,*)"iniacademic: planet types other than earth",
Index: /LMDZ4/trunk/libf/dyn3d/iniconst.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/iniconst.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/iniconst.F	(revision 1403)
@@ -1,6 +1,8 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE iniconst
+
+      USE control_mod
 
       IMPLICIT NONE
@@ -16,6 +18,6 @@
 #include "comconst.h"
 #include "temps.h"
-#include "control.h"
 #include "comvert.h"
+#include "iniprint.h"
 
 
@@ -47,5 +49,5 @@
       r       = cpp * kappa
 
-      PRINT*,' R  CP  Kappa ',  r , cpp,  kappa
+      write(lunout,*)'iniconst: R  CP  Kappa ',  r , cpp,  kappa
 c
 c-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3d/inidissip.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/inidissip.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/inidissip.F	(revision 1403)
@@ -11,4 +11,6 @@
 c   -------------
 
+      USE control_mod
+
       IMPLICIT NONE
 #include "dimensions.h"
@@ -17,5 +19,4 @@
 #include "comconst.h"
 #include "comvert.h"
-#include "control.h"
 #include "logic.h"
 
@@ -165,5 +166,5 @@
 
 c     IF(.NOT.lstardis) THEN
-         fact    = rad*24./float(jjm)
+         fact    = rad*24./REAL(jjm)
          fact    = fact*fact
          PRINT*,'coef u ', fact/cdivu, 1./cdivu
Index: /LMDZ4/trunk/libf/dyn3d/inigeom.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/inigeom.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/inigeom.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -168,15 +168,15 @@
 c
       IF( nitergdiv.NE.2 ) THEN
-        gamdi_gdiv = coefdis/ ( float(nitergdiv) -2. )
+        gamdi_gdiv = coefdis/ ( REAL(nitergdiv) -2. )
       ELSE
         gamdi_gdiv = 0.
       ENDIF
       IF( nitergrot.NE.2 ) THEN
-        gamdi_grot = coefdis/ ( float(nitergrot) -2. )
+        gamdi_grot = coefdis/ ( REAL(nitergrot) -2. )
       ELSE
         gamdi_grot = 0.
       ENDIF
       IF( niterh.NE.2 ) THEN
-        gamdi_h = coefdis/ ( float(niterh) -2. )
+        gamdi_h = coefdis/ ( REAL(niterh) -2. )
       ELSE
         gamdi_h = 0.
@@ -381,6 +381,6 @@
        yprp               = yprimu2(j-1)
        rlatp              = rlatu2 (j-1)
-ccc       yprp             = fyprim( FLOAT(j) - 0.25 )
-ccc       rlatp            = fy    ( FLOAT(j) - 0.25 )
+ccc       yprp             = fyprim( REAL(j) - 0.25 )
+ccc       rlatp            = fy    ( REAL(j) - 0.25 )
 c
       coslatp             = COS( rlatp )
@@ -416,8 +416,8 @@
         rlatm    = rlatu1 (  j  )
         yprm     = yprimu1(  j  )
-cc         rlatp    = fy    ( FLOAT(j) - 0.25 )
-cc         yprp     = fyprim( FLOAT(j) - 0.25 )
-cc         rlatm    = fy    ( FLOAT(j) + 0.25 )
-cc         yprm     = fyprim( FLOAT(j) + 0.25 )
+cc         rlatp    = fy    ( REAL(j) - 0.25 )
+cc         yprp     = fyprim( REAL(j) - 0.25 )
+cc         rlatm    = fy    ( REAL(j) + 0.25 )
+cc         yprm     = fyprim( REAL(j) + 0.25 )
 
          coslatm  = COS( rlatm )
Index: /LMDZ4/trunk/libf/dyn3d/integrd.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/integrd.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/integrd.F	(revision 1403)
@@ -5,4 +5,6 @@
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
+
+      USE control_mod
 
       IMPLICIT NONE
@@ -32,5 +34,4 @@
 #include "temps.h"
 #include "serre.h"
-#include "control.h"
 
 c   Arguments:
Index: /LMDZ4/trunk/libf/dyn3d/interp_horiz.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/interp_horiz.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/interp_horiz.F	(revision 1403)
@@ -1,4 +1,4 @@
 c
-c $Header$
+c $Id$
 c
       subroutine interp_horiz (varo,varn,imo,jmo,imn,jmn,lm,
@@ -101,6 +101,6 @@
            end do 
            do ii =1, imn+1
-             varn(ii,1,l) = totn/float(imn+1)
-             varn(ii,jmn+1,l) = tots/float(imn+1)
+             varn(ii,1,l) = totn/REAL(imn+1)
+             varn(ii,jmn+1,l) = tots/REAL(imn+1)
            end do 
        end do
Index: /LMDZ4/trunk/libf/dyn3d/interpre.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/interpre.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/interpre.F	(revision 1403)
@@ -1,8 +1,10 @@
 !
-! $Header$
+! $Id$
 !
        subroutine interpre(q,qppm,w,fluxwppm,masse,
      s            apppm,bpppm,massebx,masseby,pbaru,pbarv,
      s            unatppm,vnatppm,psppm)
+
+      USE control_mod
 
        implicit none
@@ -17,5 +19,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3d/juldate.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/juldate.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/juldate.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 	subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec)
Index: /LMDZ4/trunk/libf/dyn3d/leapfrog.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/leapfrog.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/leapfrog.F	(revision 1403)
@@ -15,4 +15,5 @@
       USE guide_mod, ONLY : guide_main
       USE write_field
+      USE control_mod
       IMPLICIT NONE
 
@@ -56,9 +57,8 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
 #include "serre.h"
-#include "com_io_dyn.h"
+!#include "com_io_dyn.h"
 #include "iniprint.h"
 #include "academic.h"
@@ -197,10 +197,10 @@
 
       itau = 0
-c$$$      iday = day_ini+itau/day_step
-c$$$      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-c$$$         IF(time.GT.1.) THEN
-c$$$          time = time-1.
-c$$$          iday = iday+1
-c$$$         ENDIF
+c      iday = day_ini+itau/day_step
+c      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
+c         IF(time.GT.1.) THEN
+c          time = time-1.
+c          iday = iday+1
+c         ENDIF
 
 
@@ -276,4 +276,5 @@
 
       IF( purmats ) THEN
+      ! Purely Matsuno time stepping
          IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
          IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
@@ -281,8 +282,15 @@
      s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
       ELSE
+      ! Leapfrog/Matsuno time stepping 
          IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
          IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
          IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
       END IF
+
+! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
+!          supress dissipation step
+      if (llm.eq.1) then
+        apdiss=.false.
+      endif
 
 c-----------------------------------------------------------------------
@@ -522,10 +530,10 @@
             IF(forward. OR. leapf) THEN
               itau= itau + 1
-c$$$              iday= day_ini+itau/day_step
-c$$$              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-c$$$                IF(time.GT.1.) THEN
-c$$$                  time = time-1.
-c$$$                  iday = iday+1
-c$$$                ENDIF
+c              iday= day_ini+itau/day_step
+c              time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
+c                IF(time.GT.1.) THEN
+c                  time = time-1.
+c                  iday = iday+1
+c                ENDIF
             ENDIF
 
@@ -559,12 +567,16 @@
                IF (ok_dynzon) THEN
 #ifdef CPP_IOIPSL
-!                  CALL writedynav(histaveid, itau,vcov ,
-!     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
-                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
-     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
+                 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav,
+     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
 #endif
                END IF
-
-            ENDIF
+               IF (ok_dyn_ave) THEN
+#ifdef CPP_IOIPSL
+                 CALL writedynav(itau,vcov,
+     &                 ucov,teta,pk,phi,q,masse,ps,phis)
+#endif
+               ENDIF
+
+            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
 
 c-----------------------------------------------------------------------
@@ -572,7 +584,7 @@
 c   ------------------------------
 
-            IF( MOD(itau,iecri         ).EQ.0) THEN
-c           IF( MOD(itau,iecri*day_step).EQ.0) THEN
-
+            IF( MOD(itau,iecri).EQ.0) THEN
+             ! 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)
@@ -583,12 +595,19 @@
               enddo
 #ifdef CPP_IOIPSL
-c             CALL writehist(histid,histvid,itau,vcov, 
-c     &                      ucov,teta,phi,q,masse,ps,phis)
+              if (ok_dyn_ins) then
+!               write(lunout,*) "leapfrog: call writehist, itau=",itau
+	       CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
+!               call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
+!               call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/)))
+!              call WriteField('teta',reshape(teta,(/iip1,jmp1,llm/)))
+!               call WriteField('ps',reshape(ps,(/iip1,jmp1/)))
+!               call WriteField('masse',reshape(masse,(/iip1,jmp1,llm/)))
+              endif ! of if (ok_dyn_ins)
 #endif
 ! For some Grads outputs of fields
-             if (output_grads_dyn) then
+              if (output_grads_dyn) then
 #include "write_grads_dyn.h"
-             endif
-
+              endif
+             endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
             ENDIF ! of IF(MOD(itau,iecri).EQ.0)
 
@@ -645,11 +664,11 @@
 
              itau =  itau + 1
-c$$$             iday = day_ini+itau/day_step
-c$$$             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-c$$$
-c$$$                  IF(time.GT.1.) THEN
-c$$$                   time = time-1.
-c$$$                   iday = iday+1
-c$$$                  ENDIF
+c             iday = day_ini+itau/day_step
+c             time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
+c
+c                  IF(time.GT.1.) THEN
+c                   time = time-1.
+c                   iday = iday+1
+c                  ENDIF
 
                forward =  .FALSE.
@@ -660,5 +679,5 @@
                GO TO 2
 
-            ELSE ! of IF(forward)
+            ELSE ! of IF(forward) i.e. backward step
 
               IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
@@ -671,10 +690,14 @@
                IF (ok_dynzon) THEN 
 #ifdef CPP_IOIPSL
-!                  CALL writedynav(histaveid, itau,vcov ,
-!     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
-                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
-     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
-#endif
-               END IF
+                 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav,
+     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
+#endif
+               ENDIF
+               IF (ok_dyn_ave) THEN
+#ifdef CPP_IOIPSL
+                 CALL writedynav(itau,vcov,
+     &                 ucov,teta,pk,phi,q,masse,ps,phis)
+#endif
+               ENDIF
 
               ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
@@ -690,6 +713,9 @@
                 enddo
 #ifdef CPP_IOIPSL
-c               CALL writehist( histid, histvid, itau,vcov , 
-c    &                           ucov,teta,phi,q,masse,ps,phis)
+              if (ok_dyn_ins) then
+!                write(lunout,*) "leapfrog: call writehist (b)",
+!     &                        itau,iecri
+		CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
+              endif ! of if (ok_dyn_ins)
 #endif
 ! For some Grads outputs
Index: /LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90	(revision 1403)
@@ -20,4 +20,5 @@
 !  *    12/2009: D. Cugnet   (f77->f90, calendars, files from coupled runs)
 !-------------------------------------------------------------------------------
+  USE control_mod
 #ifdef CPP_EARTH
   USE dimphy
@@ -27,5 +28,5 @@
                    NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT,     &
                    NF90_NOERR,   NF90_NOWRITE, NF90_DOUBLE,  NF90_GLOBAL,      &
-		   NF90_CLOBBER, NF90_ENDDEF,  NF90_UNLIMITED
+		   NF90_CLOBBER, NF90_ENDDEF,  NF90_UNLIMITED, NF90_FLOAT
   USE inter_barxy_m, only: inter_barxy
 #endif
@@ -45,5 +46,4 @@
 !-------------------------------------------------------------------------------
 ! Local variables:
-#include "control.h"
 #include "logic.h"
 #include "comvert.h"
@@ -293,9 +293,9 @@
   USE dimphy, ONLY : klon
   USE phys_state_var_mod, ONLY : pctsrf
+  USE control_mod
   IMPLICIT NONE
 #include "dimensions.h"
 #include "paramet.h"
 #include "comgeom2.h"
-#include "control.h"
 #include "indicesol.h"
 #include "iniprint.h"
Index: DZ4/trunk/libf/dyn3d/ord_coord.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ord_coord.F	(revision 1402)
+++ 	(revision )
@@ -1,95 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE ord_coord ( nmax, xi, xo, decrois )
-
-c   .... Auteur :  P. Le Van  .... 
-c
-c   ... Reordonne eventuellement les coordonnees de la grille donnees ...
-c
-       IMPLICIT NONE
-
-c    .....  Arguments  en entree  .....
-
-       INTEGER nmax
-       REAL xi(nmax)
-
-c    .....  Arguments  en sortie  .....
-c
-       REAL xo(nmax+1) 
-       LOGICAL decrois
-
-c    .... Variables  locales  ....
-
-       REAL xscr(nmax)
-       INTEGER i,ii
-       REAL pi, degres, chmin, chmax, mult
-c
-
-       pi     = 2.*ASIN(1.)
-       degres = 180./pi
-       decrois = .FALSE.
-
-       DO i = 1, nmax 
-        xo(i) = xi(i)
-       ENDDO
-     
-       mult = 1.
-       IF( xo(1).GT.xo(nmax) ) mult = -1.
-
-       CALL minmax(nmax,xo(1),chmin,chmax)
-
-       IF(chmax.LT.6.5 )  THEN
-          DO i = 1,nmax
-           xo(i) = xo(i) * degres 
-          ENDDO
-       ENDIF
-
-       IF( ABS( xo( 1  ) + mult* 90. ). LT .0.001. OR .
-     ,     ABS( xo(nmax) - mult* 90. ). LT .0.001      )  THEN
-        PRINT *,' Reverifier les valeurs de  xidat  pour les donnees .'
-        PRINT *,' Elles doivent correspondre aux interfaces et non aux',
-     , 'ordonnees des donnees,egales a -90. et 90.deg aux 2 extremites '
-         CALL ABORT
-       ENDIF
-
-       IF( xo(1).GT.xo(nmax) )   THEN
-          DO i = 1, nmax 
-            xscr(i) = xo(i)
-          ENDDO
-          DO i = 1, nmax 
-            xo(i+1) = xscr(i)
-          ENDDO
-            xo (   1    ) =   90.
-       ELSE
-            xo ( nmax +1) =   90.
-       ENDIF
-
-       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
-
-       DO i = 3, nmax 
-
-        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
-         PRINT 1
-         PRINT 2,(xo(ii),ii=1,nmax)
-         CALL ABORT 
-        ENDIF
-        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
-         PRINT 1
-         PRINT 2,(xo(ii),ii=1,nmax)
-         CALL ABORT
-        ENDIF
-
-       ENDDO
-        
-       IF( decrois )  THEN
-c         CALL sort(nmax+1,xo(1))
-        CALL sort(nmax+1,xo)
-       ENDIF
-
-1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
-     ,  'grille du modele ')
-2      FORMAT(1x,8f8.2)
-
-       RETURN
-       END
Index: DZ4/trunk/libf/dyn3d/ord_coordm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ord_coordm.F	(revision 1402)
+++ 	(revision )
@@ -1,110 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE ord_coordm ( nmax, xi, xo, jjm, jmods, decrois )
-
-c   ....  Auteur :  P. Le Van  .... 
-
-c   ... Reordonne eventuellement les coordonnees de la grille modele ...
-c
-       IMPLICIT NONE
-
-c    .....  Arguments  en entree  .....
-
-       INTEGER nmax,jjm
-       REAL xi(nmax)
-
-c    .....  Arguments  en sortie  .....
-c
-       REAL xo(nmax+1) 
-       LOGICAL decrois
-       INTEGER jmods
-
-c    .... Variables  locales  ....
-
-       REAL xscr(nmax)
-       INTEGER i
-       REAL pi, degres, chmin, chmax,mult
-c
-       DO i = 1, nmax 
-        xo(i) = xi(i)
-       ENDDO
-
-       mult = 1.
-       IF( xo(1).GT.xo(nmax) )  mult = - 1.
-       IF( nmax.EQ.jjm    ) jmods = nmax +1
-       IF( nmax.EQ.jjm +1 ) jmods = nmax -1 
-     
-       pi     = 2.*ASIN(1.)
-       degres = 180./pi
-       decrois = .FALSE.
-
-       CALL minmax(nmax,xo(1),chmin,chmax)
-
-       IF(chmax.LT.6.5 )  THEN
-          DO i = 1,nmax
-           xo(i) = xo(i) * degres 
-          ENDDO
-       ENDIF
-
-       IF( nmax.EQ.jjm )   THEN
-         IF( xo(1).GT.xo(nmax) )   THEN
-           DO i = 1, nmax 
-            xscr(i) = xo(i)
-           ENDDO
-           DO i = 1, nmax 
-            xo(i+1) = xscr(i)
-           ENDDO
-            xo (   1    ) =   90.
-         ELSE
-            xo ( nmax+1 ) =   90.
-         ENDIF
-       ELSE
-          IF( nmax.NE.jjm +1 )   THEN
-             PRINT *,'  Dans la routine ord_coordm , l argument nmax '
-             PRINT *,'  n est pas egal a jjm ni a jjm +1 . Corriger !'
-             CALL ABORT
-          ELSE
-            IF( ABS( xo(1)+ mult * 90.).GT.0.01 )  THEN
-              PRINT *,' Avec nmax =',nmax,'on devrait avoir des',
-     ,    ' ordonnees = 90. deg pour j=1 ou jjm+1 ! '
-             CALL ABORT
-            ELSE
-               IF( xo(1).LT.xo(nmax) )  THEN
-                 DO i = 1, nmax
-                  xscr(i) = xo(i)
-                 ENDDO
-                 DO i = 1, nmax -1
-                  xo(i) = xscr(i+1)
-                 ENDDO
-               ENDIF
-            ENDIF
-          ENDIF
-       ENDIF
-
-       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
-
-       DO i = 3, nmax 
-
-        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
-         PRINT 1
-         CALL ABORT 
-        ENDIF
-        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
-         PRINT 1
-         CALL ABORT
-        ENDIF
-
-       ENDDO
-        
-       IF( decrois )  THEN
-         CALL sort(jmods,xo(1))
-       ENDIF
-
-
-1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
-     ,  'grille du modele ')
-2      FORMAT(1x,8f8.2)
-
-       RETURN
-       END
Index: /LMDZ4/trunk/libf/dyn3d/ppm3d.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ppm3d.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/ppm3d.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 
@@ -345,6 +345,6 @@
 C
       PI = 4. * ATAN(1.)
-      DL = 2.*PI / float(IMR)
-      DP =    PI / float(JMR)
+      DL = 2.*PI / REAL(IMR)
+      DP =    PI / REAL(JMR)
 C
       if(IGD.eq.0) then
@@ -388,5 +388,5 @@
       ZTC  = acos(CR1) * (180./PI)
 C
-      JS0 = float(JMR)*(90.-ZTC)/180. + 2
+      JS0 = REAL(JMR)*(90.-ZTC)/180. + 2
       JS0 = max(JS0, J1+1)
       IML = min(6*JS0/(J1-1)+2, 4*IMR/5)
@@ -628,5 +628,5 @@
 C Contribution from the N-S advection
       do i=1,imr*(j2-j1+1)
-      JT = float(J1) - VA(i,j1)
+      JT = REAL(J1) - VA(i,j1)
       wk1(i,j1,2) = VA(i,j1) * (q(i,jt,k,IC) - q(i,jt+1,k,IC))
       enddo
@@ -949,5 +949,5 @@
       IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
       DO 1406 i=1,IMR
-      iu = float(i) - uc(i,j)
+      iu = REAL(i) - uc(i,j)
 1406  fx1(i) = qtmp(iu)
       ELSE
@@ -957,5 +957,5 @@
       if(IORD.eq.2 .or. j.le.j1vl .or. j.ge.j2vl) then
       DO 1408 i=1,IMR
-      iu = float(i) - uc(i,j)
+      iu = REAL(i) - uc(i,j)
 1408  fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j))
       else
@@ -1111,5 +1111,5 @@
       if(JORD.eq.1) then
       DO 1000 i=1,len
-      JT = float(J1) - VC(i,J1)
+      JT = REAL(J1) - VC(i,J1)
 1000  fx(i,j1) = p(i,JT)
       else
@@ -1123,5 +1123,5 @@
       else
       DO 1200 i=1,len
-      JT = float(J1) - VC(i,J1)
+      JT = REAL(J1) - VC(i,J1)
 1200  fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
       endif
@@ -1358,5 +1358,5 @@
 	do j=j1-1,j2+1
       do i=1,imr
-      JP = float(j)-VA(i,j)
+      JP = REAL(j)-VA(i,j)
       ady(i,j) = VA(i,j)*(wk(i,jp)-wk(i,jp+1))
       enddo
@@ -1582,5 +1582,5 @@
       JMR = JNP-1
       do 55 j=2,JNP
-        ph5  =  -0.5*PI + (FLOAT(J-1)-0.5)*DP
+        ph5  =  -0.5*PI + (REAL(J-1)-0.5)*DP
 55      cose(j) = cos(ph5)
 C
@@ -1834,5 +1834,5 @@
 C
 c      if(first) then
-      DP = 4.*ATAN(1.)/float(JNP-1)
+      DP = 4.*ATAN(1.)/REAL(JNP-1)
       CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
 c      first = .false.
@@ -1889,5 +1889,5 @@
 C Check Poles.
       if(q(1,1).lt.0.) then
-      dq = q(1,1)*cap1/float(IMR)*acosp(j1)
+      dq = q(1,1)*cap1/REAL(IMR)*acosp(j1)
       do i=1,imr
       q(i,1) = 0.
@@ -1898,5 +1898,5 @@
 C
       if(q(1,JNP).lt.0.) then
-      dq = q(1,JNP)*cap1/float(IMR)*acosp(j2)
+      dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2)
       do i=1,imr
       q(i,JNP) = 0.
Index: /LMDZ4/trunk/libf/dyn3d/ran1.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ran1.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/ran1.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       FUNCTION RAN1(IDUM)
@@ -20,5 +20,5 @@
           IX1=MOD(IA1*IX1+IC1,M1)
           IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
 11      CONTINUE
         IDUM=1
@@ -30,5 +30,5 @@
       IF(J.GT.97.OR.J.LT.1)PAUSE
       RAN1=R(J)
-      R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
       RETURN
       END
Index: /LMDZ4/trunk/libf/dyn3d/sortvarc.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/sortvarc.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/sortvarc.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE sortvarc
@@ -59,5 +59,5 @@
 
        dtvrs1j   = dtvr/daysec
-       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       rjour     = REAL( INT( itau * dtvrs1j ))
        heure     = ( itau*dtvrs1j-rjour ) * 24.
        imjmp1    = iim * jjp1
@@ -129,7 +129,7 @@
       ang   = SSUM(     llm,  angl, 1 )
 
-c      rday = FLOAT(INT ( day_ini + time ))
+c      rday = REAL(INT ( day_ini + time ))
 c
-       rday = FLOAT(INT(time-jD_ref-jH_ref))
+       rday = REAL(INT(time-jD_ref-jH_ref))
       IF(ptot0.eq.0.)  THEN
          PRINT 3500, itau, rday, heure,time
Index: /LMDZ4/trunk/libf/dyn3d/sortvarc0.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/sortvarc0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/sortvarc0.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE sortvarc0
@@ -60,5 +60,5 @@
 
        dtvrs1j   = dtvr/daysec
-       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       rjour     = REAL( INT( itau * dtvrs1j ))
        heure     = ( itau*dtvrs1j-rjour ) * 24.
        imjmp1    = iim * jjp1
@@ -130,5 +130,5 @@
       ang0   = SSUM(     llm,  angl, 1 )
 
-      rday = FLOAT(INT (time ))
+      rday = REAL(INT (time ))
 c
       PRINT 3500, itau, rday, heure, time
Index: /LMDZ4/trunk/libf/dyn3d/sw_case_williamson91_6.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/sw_case_williamson91_6.F	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3d/sw_case_williamson91_6.F	(revision 1403)
@@ -0,0 +1,140 @@
+!
+! $Id $
+!
+      SUBROUTINE sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+
+c=======================================================================
+c
+c   Author:    Thomas Dubos      original: 26/01/2010
+c   -------
+c
+c   Subject:
+c   ------
+c   Realise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "iniprint.h"
+
+c   Arguments:
+c   ----------
+
+c   variables dynamiques
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL masse(ip1jmp1,llm)                ! masse d'air
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+
+c   Local:
+c   ------
+
+      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+      REAL pks(ip1jmp1)                      ! exner au  sol
+      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
+
+      REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps
+      INTEGER i,j,ij
+
+      REAL, PARAMETER    :: rho=1 ! masse volumique de l'air (arbitraire)
+      REAL, PARAMETER    :: K    = 7.848e-6  ! K = \omega
+      REAL, PARAMETER    :: gh0  = 9.80616 * 8e3 
+      INTEGER, PARAMETER :: R0=4, R1=R0+1, R2=R0+2         ! mode 4
+c NB : rad = 6371220 dans W91 (6371229 dans LMDZ)
+c      omeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ)
+ 
+      IF(0==0) THEN
+c Williamson et al. (1991) : onde de Rossby-Haurwitz
+         teta = preff/rho/cpp
+c geopotentiel (pression de surface)
+         do j=1,jjp1
+            costh2 = cos(rlatu(j))**2
+            Ath = (R0+1)*(costh2**2) + (2*R0*R0-R0-2)*costh2 - 2*R0*R0
+            Ath = .25*(K**2)*(costh2**(R0-1))*Ath
+            Ath = .5*K*(2*omeg+K)*costh2 + Ath 
+            Bth = (R1*R1+1)-R1*R1*costh2
+            Bth = 2*(omeg+K)*K/(R1*R2) * (costh2**(R0/2))*Bth
+            Cth = R1*costh2 - R2
+            Cth = .25*K*K*(costh2**R0)*Cth
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonv(i)
+               dps = Ath + Bth*cos(R0*lon) + Cth*cos(2*R0*lon)
+               ps(ij) = rho*(gh0 + (rad**2)*dps)
+            enddo
+         enddo
+         write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps)
+c vitesse zonale ucov
+         do j=1,jjp1
+            costh  = cos(rlatu(j))
+            costh2 = costh**2
+            Ath = rad*K*costh
+            Bth = R0*(1-costh2)-costh2
+            Bth = rad*K*Bth*(costh**(R0-1))
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonu(i)
+               ucov(ij,1) = (Ath + Bth*cos(R0*lon))
+            enddo
+         enddo
+         write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1))
+         ucov(:,1)=ucov(:,1)*cu
+c vitesse meridienne vcov
+         do j=1,jjm
+            sinth  = sin(rlatv(j))
+            costh  = cos(rlatv(j))
+            Ath = -rad*K*R0*sinth*(costh**(R0-1))
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonv(i)
+               vcov(ij,1) = Ath*sin(R0*lon)
+            enddo
+         enddo
+         write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1))
+         vcov(:,1)=vcov(:,1)*cv
+         
+c         ucov=0
+c         vcov=0
+      ELSE
+c test non-tournant, onde se propageant en latitude
+         do j=1,jjp1
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               ps(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2) )
+            enddo
+         enddo
+         
+c     rho = preff/(cpp*teta)
+         teta = .01*preff/cpp   ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j
+         ucov=0.
+         vcov=0.
+      END IF      
+      
+      CALL pression ( ip1jmp1, ap, bp, ps, p       )
+      CALL massdair(p,masse)
+
+      END
+c-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3d/tourabs.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/tourabs.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/tourabs.F	(revision 1403)
@@ -57,7 +57,7 @@
         ELSE
          rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
-     $                 (2.*pi*RAD*cos(rlatv(j)))*float(iim)
+     $                 (2.*pi*RAD*cos(rlatv(j)))*REAL(iim)
      $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
-     $                 (pi*RAD)*(float(jjm)-1.)
+     $                 (pi*RAD)*(REAL(jjm)-1.)
 c
         ENDIF
Index: /LMDZ4/trunk/libf/dyn3d/traceurpole.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/traceurpole.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/traceurpole.F	(revision 1403)
@@ -1,6 +1,8 @@
 !
-! $Header$
+! $Id$
 !
           subroutine traceurpole(q,masse)
+
+      USE control_mod
 
           implicit none
@@ -15,5 +17,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3d/ugeostr.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/ugeostr.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/ugeostr.F	(revision 1403)
@@ -40,5 +40,5 @@
             DO i=1,iim
                u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-               um(j,l)=um(j,l)+u(i,j,l)/float(iim)
+               um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
             ENDDO
          ENDDO
Index: /LMDZ4/trunk/libf/dyn3d/write_paramLMDZ_dyn.h
===================================================================
--- /LMDZ4/trunk/libf/dyn3d/write_paramLMDZ_dyn.h	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3d/write_paramLMDZ_dyn.h	(revision 1403)
@@ -7,41 +7,41 @@
       itau_w=itau_dyn+itau
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(prt_level) 
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(prt_level) 
       CALL histwrite(nid_ctesGCM, "prt_level", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(dayref)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(dayref)
       CALL histwrite(nid_ctesGCM, "dayref", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(anneeref)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(anneeref)
       CALL histwrite(nid_ctesGCM, "anneeref", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(raz_date)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(raz_date)
       CALL histwrite(nid_ctesGCM, "raz_date", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(nday)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(nday)
       CALL histwrite(nid_ctesGCM, "nday", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(day_step)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(day_step)
       CALL histwrite(nid_ctesGCM, "day_step", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iperiod)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iperiod)
       CALL histwrite(nid_ctesGCM, "iperiod", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iapp_tracvl)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iapp_tracvl)
       CALL histwrite(nid_ctesGCM, "iapp_tracvl", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iconser)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iconser)
       CALL histwrite(nid_ctesGCM, "iconser", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iecri)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iecri)
       CALL histwrite(nid_ctesGCM, "iecri", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
@@ -51,5 +51,5 @@
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(idissip)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(idissip)
       CALL histwrite(nid_ctesGCM, "idissip", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
@@ -63,13 +63,13 @@
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(nitergdiv)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(nitergdiv)
       CALL histwrite(nid_ctesGCM, "nitergdiv", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(nitergrot)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(nitergrot)
       CALL histwrite(nid_ctesGCM, "nitergrot", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(niterh) 
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(niterh) 
       CALL histwrite(nid_ctesGCM, "niterh", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
@@ -118,9 +118,9 @@
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iflag_phys)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iflag_phys)
       CALL histwrite(nid_ctesGCM, "iflag_phys", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
 c
-      zx_tmp_2d(1:iip1,1:jjp1)=FLOAT(iphysiq)
+      zx_tmp_2d(1:iip1,1:jjp1)=REAL(iphysiq)
       CALL histwrite(nid_ctesGCM, "iphysiq", itau_w,
      .               zx_tmp_2d,iip1*jjp1,ndex2d)
Index: /LMDZ4/trunk/libf/dyn3dpar/adaptdt.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/adaptdt.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/adaptdt.F	(revision 1403)
@@ -1,7 +1,9 @@
 !
-! $Header$
+! $Id$
 !
       subroutine adaptdt(nadv,dtbon,n,pbaru,
      c                   masse)
+
+      USE control_mod
 
       IMPLICIT NONE
@@ -16,5 +18,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -23,4 +23,5 @@
       USE times
       USE infotrac
+      USE control_mod
       IMPLICIT NONE
 c
@@ -33,5 +34,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
@@ -215,5 +215,5 @@
          ijb=ij_begin
          ije=ij_end
-         flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/FLOAT(iapp_tracvl)
+         flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/REAL(iapp_tracvl)
 
 c  test sur l'eventuelle creation de valeurs negatives de la masse
Index: /LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F	(revision 1403)
@@ -511,5 +511,5 @@
      .	                      /masse_cum(:,jjb:jje,:)
       enddo
-      zz=1./float(ncum)
+      zz=1./REAL(ncum)
 
       jjb=jj_begin
Index: /LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -9,4 +9,5 @@
       USE parallel
       USE infotrac
+      USE control_mod
 c
       IMPLICIT NONE
@@ -25,5 +26,4 @@
 #include "paramet.h"
 #include "comconst.h"
-#include "control.h"
 
 c   Arguments:
Index: /LMDZ4/trunk/libf/dyn3dpar/calfis_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/calfis_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/calfis_p.F	(revision 1403)
@@ -34,11 +34,13 @@
       USE dimphy
       USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root 
+      USE mod_interface_dyn_phys
+      USE IOPHY
+#endif
       USE parallel, ONLY : omp_chunk, using_mpi
-      USE mod_interface_dyn_phys
       USE Write_Field
       Use Write_field_p
       USE Times
-      USE IOPHY
       USE infotrac
+      USE control_mod
 
       IMPLICIT NONE
@@ -107,5 +109,5 @@
 #include "comvert.h"
 #include "comgeom2.h"
-#include "control.h"
+#include "iniprint.h"
 #ifdef CPP_MPI
       include 'mpif.h'
@@ -114,6 +116,6 @@
 c    -----------
       LOGICAL  lafin
-      REAL heure
-
+!      REAL heure
+      REAL, intent(in):: jD_cur, jH_cur
       REAL pvcov(iip1,jjm,llm)
       REAL pucov(iip1,jjp1,llm)
@@ -128,4 +130,5 @@
       REAL pdteta(iip1,jjp1,llm)
       REAL pdq(iip1,jjp1,llm,nqtot)
+      REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
 c
       REAL pps(iip1,jjp1)
@@ -143,5 +146,5 @@
       REAL clesphy0( longcles )
 
-
+#ifdef CPP_EARTH
 c    Local variables :
 c    -----------------
@@ -180,8 +183,31 @@
       REAL,SAVE,ALLOCATABLE ::  flxwfi_omp(:,:)     ! Flux de masse verticale sur la grille physiq
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Introduction du splitting (FH)
+! Question pour Yann :
+! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent
+! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
+! soit allocatable (plutot par exemple que de passer une dimension
+! dépendant du process en argument des routines) et que, du coup,
+! le SAVE évite d'avoir à refaire l'allocation à chaque appel.
+! Tu confirmes ?
+! J'ai suivi le même principe pour les zdufic_omp
+! Mais c'est surement bien que tu controles.
+! 
+
+      REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:)
+      REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:)
+      REAL jH_cur_split,zdt_split
+      LOGICAL debut_split,lafin_split
+      INTEGER isplit
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
 c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
 c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
-c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp)       
+c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp,
+c$OMP+                 zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)       
 
       LOGICAL,SAVE :: first_omp=.true.
@@ -199,5 +225,4 @@
       REAL PVteta(klon,ntetaSTD)
       
-      REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
       
       REAL SSUM
@@ -207,5 +232,4 @@
       SAVE firstcal,debut
 c$OMP THREADPRIVATE(firstcal,debut)
-      REAL, intent(in):: jD_cur, jH_cur
       
       REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
@@ -235,8 +259,9 @@
         debut = .TRUE.
         IF (ngridmx.NE.2+(jjm-1)*iim) THEN
-         PRINT*,'STOP dans calfis'
-         PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
-         PRINT*,'  ngridmx  jjm   iim   '
-         PRINT*,ngridmx,jjm,iim
+         write(lunout,*) 'STOP dans calfis'
+         write(lunout,*) 
+     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
+         write(lunout,*) '  ngridmx  jjm   iim   '
+         write(lunout,*) ngridmx,jjm,iim
          STOP
         ENDIF
@@ -498,4 +523,8 @@
         allocate(zdtfi_omp(klon,llm))
         allocate(zdqfi_omp(klon,llm,nqtot))
+        allocate(zdufic_omp(klon,llm))
+        allocate(zdvfic_omp(klon,llm))
+        allocate(zdtfic_omp(klon,llm))
+        allocate(zdqfic_omp(klon,llm,nqtot))
         allocate(zdpsrf_omp(klon))
         allocate(flxwfi_omp(klon,llm))
@@ -600,11 +629,28 @@
       if (planet_type=="earth") then
 #ifdef CPP_EARTH
+
+!$OMP MASTER
+      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
+!$OMP END MASTER
+      zdt_split=dtphys/nsplit_phys
+      zdufic_omp(:,:)=0.
+      zdvfic_omp(:,:)=0.
+      zdtfic_omp(:,:)=0.
+      zdqfic_omp(:,:,:)=0.
+
+      do isplit=1,nsplit_phys
+
+         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
+         debut_split=debut.and.isplit==1
+         lafin_split=lafin.and.isplit==nsplit_phys
+
+
       CALL physiq (klon,
      .             llm,
-     .             debut,
-     .             lafin,
+     .             debut_split,
+     .             lafin_split,
      .             jD_cur,
-     .             jH_cur,
-     .             dtphys,
+     .             jH_cur_split,
+     .             zdt_split,
      .             zplev_omp,
      .             zplay_omp,
@@ -628,4 +674,22 @@
      .             pducov,
      .             PVteta)
+
+         zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
+         zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
+         ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
+         zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
+
+         zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
+         zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
+         zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
+         zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
+
+      enddo
+
+      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")
@@ -1047,5 +1111,6 @@
 
 #else
-      write(*,*) "calfis_p: for now can only work with parallel physics"
+      write(lunout,*)
+     & "calfis_p: for now can only work with parallel physics"
       stop
 #endif
Index: /LMDZ4/trunk/libf/dyn3dpar/ce0l.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ce0l.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/ce0l.F90	(revision 1403)
@@ -15,4 +15,5 @@
 !     masque is created in etat0, passed to limit to ensure consistancy.
 !-------------------------------------------------------------------------------
+  USE control_mod
 #ifdef CPP_EARTH
 ! This prog. is designed to work for Earth
@@ -39,5 +40,4 @@
 #include "indicesol.h"
 #include "iniprint.h"
-#include "control.h"
 #include "temps.h"
 #include "logic.h"
Index: DZ4/trunk/libf/dyn3dpar/com_io_dyn.h
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/com_io_dyn.h	(revision 1402)
+++ 	(revision )
@@ -1,5 +1,0 @@
-!
-! $Header$
-!
-      integer histid, histvid, histaveid
-      common/com_io_dyn/histid, histvid, histaveid
Index: /LMDZ4/trunk/libf/dyn3dpar/com_io_dyn_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/com_io_dyn_mod.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3dpar/com_io_dyn_mod.F90	(revision 1403)
@@ -0,0 +1,31 @@
+!
+! $Id $
+!
+module com_io_dyn_mod
+
+  implicit none 
+
+! Names of various files for outputs (in the dynamics)
+  ! to store instantaneous values:
+  character(len=18),parameter :: dynhist_file="dyn_hist.nc" ! on scalar grid
+  character(len=18),parameter :: dynhistv_file="dyn_histv.nc" ! on v grid
+  character(len=18),parameter :: dynhistu_file="dyn_histu.nc" ! on u grid
+
+  ! to store averaged values:
+  character(len=18),parameter :: dynhistave_file="dyn_hist_ave.nc"
+  character(len=18),parameter :: dynhistvave_file="dyn_histv_ave.nc"
+  character(len=18),parameter :: dynhistuave_file="dyn_histu_ave.nc"
+  
+! Ids of various files for outputs (in the dynamics)
+
+  ! instantaneous (these are set by inithist.F)
+  integer :: histid
+  integer :: histvid
+  integer :: histuid
+  
+  ! averages (these are set by initdynav.F)
+  integer :: histaveid
+  integer :: histvaveid
+  integer :: histuaveid
+  
+end module com_io_dyn_mod
Index: /LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F	(revision 1403)
@@ -16,4 +16,5 @@
       use mod_hallo, ONLY : use_mpi_alloc
       use parallel, ONLY : omp_chunk
+      USE control_mod
       IMPLICIT NONE
 c-----------------------------------------------------------------------
@@ -38,5 +39,4 @@
 #include "dimensions.h"
 #include "paramet.h"
-#include "control.h"
 #include "logic.h"
 #include "serre.h"
@@ -173,4 +173,12 @@
        CALL getin('day_step',day_step)
 
+!Config  Key  = nsplit_phys
+!Config  Desc = nombre d'iteration de la physique
+!Config  Def  = 240 
+!Config  Help = nombre d'itration de la physique
+!
+       nsplit_phys = 1 
+       CALL getin('nsplit_phys',nsplit_phys)
+
 !Config  Key  = iperiod
 !Config  Desc = periode pour le pas Matsuno
@@ -589,4 +597,19 @@
       CALL getin('ok_dynzon',ok_dynzon) 
 
+!Config  Key  = ok_dyn_ins
+!Config  Desc = sorties instantanees dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ins = .FALSE. 
+      CALL getin('ok_dyn_ins',ok_dyn_ins) 
+
+!Config  Key  = ok_dyn_ave
+!Config  Desc = sorties moyennes dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ave = .FALSE. 
+      CALL getin('ok_dyn_ave',ok_dyn_ave) 
 
       write(lunout,*)' #########################################'
@@ -599,4 +622,5 @@
       write(lunout,*)' day_step = ', day_step
       write(lunout,*)' iperiod = ', iperiod
+      write(lunout,*)' nsplit_phys = ', nsplit_phys
       write(lunout,*)' iconser = ', iconser
       write(lunout,*)' iecri = ', iecri
@@ -628,4 +652,6 @@
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon 
+      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
+      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
 
       RETURN
@@ -760,4 +786,20 @@
       ok_dynzon = .FALSE. 
       CALL getin('ok_dynzon',ok_dynzon) 
+
+!Config  Key  = ok_dyn_ins
+!Config  Desc = sorties instantanees dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ins = .FALSE. 
+      CALL getin('ok_dyn_ins',ok_dyn_ins) 
+
+!Config  Key  = ok_dyn_ave
+!Config  Desc = sorties moyennes dans la dynamique
+!Config  Def  = n 
+!Config  Help = 
+!Config          
+      ok_dyn_ave = .FALSE. 
+      CALL getin('ok_dyn_ave',ok_dyn_ave) 
 
 !Config  Key  = use_filtre_fft
@@ -870,4 +912,6 @@
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon 
+      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 
+      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 
       write(lunout,*)' use_filtre_fft = ', use_filtre_fft
       write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
Index: DZ4/trunk/libf/dyn3dpar/control.h
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/control.h	(revision 1402)
+++ 	(revision )
@@ -1,29 +1,0 @@
-!
-! $Header$
-!
-!
-!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
-!                 veillez à n'utiliser que des ! pour les commentaires
-!                 et à bien positionner les & des lignes de continuation 
-!                 (les placer en colonne 6 et en colonne 73)
-!
-!-----------------------------------------------------------------------
-! INCLUDE 'control.h'
-
-      COMMON/control/nday,day_step,                                     &
-     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
-     &              periodav,iecrimoy,dayref,anneeref,                  &
-     &              raz_date,offline,ip_ebil_dyn,config_inca,           &
-     &              planet_type,output_grads_dyn,ok_dynzon
-
-      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,        &
-     &          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date      &
-     &          ,ip_ebil_dyn
-      REAL periodav
-      logical offline
-      CHARACTER (len=4) :: config_inca
-      CHARACTER(len=10) :: planet_type ! planet type ('earth','mars',...)
-      LOGICAL :: output_grads_dyn ! output dynamics diagnostics in
-                                  ! binary grads file 'dyn.dat' (y/n)
-      LOGICAL :: ok_dynzon 
-!-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3dpar/control_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/control_mod.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3dpar/control_mod.F90	(revision 1403)
@@ -0,0 +1,27 @@
+!
+! $Id $
+!
+
+MODULE control_mod
+
+! LF 01/2010
+! Remplacement du fichier et common control
+
+  IMPLICIT NONE
+
+  REAL    :: periodav
+  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
+  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
+  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
+  LOGICAL :: offline
+  CHARACTER (len=4)  :: config_inca
+  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
+  LOGICAL output_grads_dyn ! output dynamics diagnostics in
+                           ! binary grads file 'dyn.dat' (y/n)
+  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
+  LOGICAL ok_dyn_ins ! output instantaneous values of fields
+                     ! in the dynamics in NetCDF files dyn_hist*nc
+  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
+                     ! in NetCDF files dyn_hist*ave.nc
+
+END MODULE
Index: /LMDZ4/trunk/libf/dyn3dpar/covnat.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/covnat.F	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3dpar/covnat.F	(revision 1403)
@@ -0,0 +1,49 @@
+!
+! $Header$
+!
+      SUBROUTINE covnat (klevel,ucov, vcov, unat, vnat )
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Auteur:  F Hourdin Phu LeVan
+c   -------
+c
+c   Objet:
+c   ------
+c
+c  *********************************************************************
+c    calcul des compos. naturelles a partir des comp.covariantes
+c  ********************************************************************
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+      INTEGER klevel
+      REAL ucov( ip1jmp1,klevel ),  vcov( ip1jm,klevel )
+      REAL unat( ip1jmp1,klevel ), vnat( ip1jm,klevel )
+      INTEGER   l,ij
+
+
+      DO l = 1,klevel
+         DO ij = 1, iip1
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = iip2, ip1jm
+            unat( ij,l ) = ucov( ij,l ) / cu(ij)
+         ENDDO
+         DO ij = ip1jm+1, ip1jmp1  
+            unat (ij,l) =0.
+         END DO
+
+         DO ij = 1,ip1jm
+            vnat( ij,l ) = vcov( ij,l ) / cv(ij)
+         ENDDO
+
+      ENDDO
+      RETURN
+      END
Index: /LMDZ4/trunk/libf/dyn3dpar/defrun.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/defrun.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/defrun.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -6,4 +6,5 @@
       SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
 c
+      USE control_mod
       IMPLICIT NONE
 c-----------------------------------------------------------------------
@@ -28,5 +29,4 @@
 #include "dimensions.h"
 #include "paramet.h"
-#include "control.h"
 #include "logic.h"
 #include "serre.h"
@@ -241,6 +241,6 @@
        clesphy0(i) = 0.
       ENDDO
-                          clesphy0(1) = FLOAT( iflag_con )
-                          clesphy0(2) = FLOAT( nbapp_rad )
+                          clesphy0(1) = REAL( iflag_con )
+                          clesphy0(2) = REAL( nbapp_rad )
 
        IF( cycle_diurne  ) clesphy0(3) =  1.
Index: /LMDZ4/trunk/libf/dyn3dpar/disvert.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/disvert.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/disvert.F	(revision 1403)
@@ -111,5 +111,5 @@
       snorm  = 0.
       DO l = 1, llm
-         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1)
 
          IF (ok_strato) THEN
@@ -135,9 +135,9 @@
 
       DO l=1,llm
-        nivsigs(l) = FLOAT(l)
+        nivsigs(l) = REAL(l)
       ENDDO
 
       DO l=1,llmp1
-        nivsig(l)= FLOAT(l)
+        nivsig(l)= REAL(l)
       ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3dpar/dynetat0.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/dynetat0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/dynetat0.F	(revision 1403)
@@ -1,7 +1,8 @@
 !
-! $Header$
+! $Id $
 !
       SUBROUTINE dynetat0(fichnom,vcov,ucov,
      .                    teta,q,masse,ps,phis,time)
+
       USE infotrac
       IMPLICIT NONE
@@ -33,4 +34,5 @@
 #include "serre.h"
 #include "logic.h"
+#include "iniprint.h"
 
 c   Arguments:
@@ -52,10 +54,11 @@
 
 c-----------------------------------------------------------------------
+
 c  Ouverture NetCDF du fichier etat initial
 
       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
       IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier start.nc'
-        write(6,*)' ierr = ', ierr
+        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
+        write(lunout,*)' ierr = ', ierr
         CALL ABORT
       ENDIF
@@ -64,5 +67,5 @@
       ierr = NF_INQ_VARID (nid, "controle", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <controle> est absent"
+         write(lunout,*)"dynetat0: Le champ <controle> est absent"
          CALL abort
       ENDIF
@@ -73,5 +76,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echoue pour <controle>"
+         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
          CALL abort
       ENDIF
@@ -119,5 +122,6 @@
 c
 c
-      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
+     &               rad,omeg,g,cpp,kappa
 
       IF(   im.ne.iim           )  THEN
@@ -134,5 +138,5 @@
       ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlonu> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
          CALL abort
       ENDIF
@@ -143,5 +147,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
          CALL abort
       ENDIF
@@ -149,5 +153,5 @@
       ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlatu> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
          CALL abort
       ENDIF
@@ -158,5 +162,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
          CALL abort
       ENDIF
@@ -164,5 +168,5 @@
       ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlonv> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
          CALL abort
       ENDIF
@@ -173,5 +177,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
          CALL abort
       ENDIF
@@ -179,5 +183,5 @@
       ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <rlatv> est absent"
+         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
          CALL abort
       ENDIF
@@ -188,5 +192,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour rlatv"
+         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
          CALL abort
       ENDIF
@@ -194,5 +198,5 @@
       ierr = NF_INQ_VARID (nid, "cu", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <cu> est absent"
+         write(lunout,*)"dynetat0: Le champ <cu> est absent"
          CALL abort
       ENDIF
@@ -203,5 +207,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <cu>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
          CALL abort
       ENDIF
@@ -209,5 +213,5 @@
       ierr = NF_INQ_VARID (nid, "cv", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <cv> est absent"
+         write(lunout,*)"dynetat0: Le champ <cv> est absent"
          CALL abort
       ENDIF
@@ -218,5 +222,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <cv>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
          CALL abort
       ENDIF
@@ -224,5 +228,5 @@
       ierr = NF_INQ_VARID (nid, "aire", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <aire> est absent"
+         write(lunout,*)"dynetat0: Le champ <aire> est absent"
          CALL abort
       ENDIF
@@ -233,5 +237,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <aire>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
          CALL abort
       ENDIF
@@ -239,5 +243,5 @@
       ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <phisinit> est absent"
+         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
          CALL abort
       ENDIF
@@ -248,5 +252,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
          CALL abort
       ENDIF
@@ -254,5 +258,5 @@
       ierr = NF_INQ_VARID (nid, "temps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <temps> est absent"
+         write(lunout,*)"dynetat0: Le champ <temps> est absent"
          CALL abort
       ENDIF
@@ -263,5 +267,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee <temps>"
+         write(lunout,*)"dynetat0: Lecture echouee <temps>"
          CALL abort
       ENDIF
@@ -269,5 +273,5 @@
       ierr = NF_INQ_VARID (nid, "ucov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <ucov> est absent"
+         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
          CALL abort
       ENDIF
@@ -278,5 +282,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
          CALL abort
       ENDIF
@@ -284,5 +288,5 @@
       ierr = NF_INQ_VARID (nid, "vcov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <vcov> est absent"
+         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
          CALL abort
       ENDIF
@@ -293,5 +297,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
          CALL abort
       ENDIF
@@ -299,5 +303,5 @@
       ierr = NF_INQ_VARID (nid, "teta", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <teta> est absent"
+         write(lunout,*)"dynetat0: Le champ <teta> est absent"
          CALL abort
       ENDIF
@@ -308,14 +312,16 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <teta>"
-         CALL abort
-      ENDIF
-
-
+         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
+         CALL abort
+      ENDIF
+
+
+      IF(nqtot.GE.1) THEN
       DO iq=1,nqtot
         ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
         IF (ierr .NE. NF_NOERR) THEN
-           PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
-           PRINT*, "          Il est donc initialise a zero"
+           write(lunout,*)"dynetat0: Le champ <"//tname(iq)//
+     &                    "> est absent"
+           write(lunout,*)"          Il est donc initialise a zero"
            q(:,:,iq)=0.
         ELSE
@@ -326,13 +332,14 @@
 #endif
           IF (ierr .NE. NF_NOERR) THEN
-             PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
-             CALL abort
+            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
+            CALL abort
           ENDIF
         ENDIF
       ENDDO
+      ENDIF
 
       ierr = NF_INQ_VARID (nid, "masse", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <masse> est absent"
+         write(lunout,*)"dynetat0: Le champ <masse> est absent"
          CALL abort
       ENDIF
@@ -343,5 +350,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <masse>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
          CALL abort
       ENDIF
@@ -349,5 +356,5 @@
       ierr = NF_INQ_VARID (nid, "ps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Le champ <ps> est absent"
+         write(lunout,*)"dynetat0: Le champ <ps> est absent"
          CALL abort
       ENDIF
@@ -358,5 +365,5 @@
 #endif
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "dynetat0: Lecture echouee pour <ps>"
+         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
          CALL abort
       ENDIF
Index: /LMDZ4/trunk/libf/dyn3dpar/dynredem.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/dynredem.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/dynredem.F	(revision 1403)
@@ -8,4 +8,5 @@
 #endif
       USE infotrac
+ 
       IMPLICIT NONE
 c=======================================================================
@@ -25,4 +26,5 @@
 #include "description.h"
 #include "serre.h"
+#include "iniprint.h"
 
 c   Arguments:
@@ -72,9 +74,9 @@
        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(1)  = REAL(iim)
+       tab_cntrl(2)  = REAL(jjm)
+       tab_cntrl(3)  = REAL(llm)
+       tab_cntrl(4)  = REAL(day_ref)
+       tab_cntrl(5)  = REAL(annee_ref)
        tab_cntrl(6)  = rad
        tab_cntrl(7)  = omeg
@@ -116,6 +118,6 @@
       ENDIF
 
-       tab_cntrl(30) = FLOAT(iday_end)
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(30) = REAL(iday_end)
+       tab_cntrl(31) = REAL(itau_dyn + itaufin)
 c
 c    .........................................................
@@ -125,6 +127,7 @@
       ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
       IF (ierr.NE.NF_NOERR) THEN
-         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
-         WRITE(6,*)' ierr = ', ierr
+         write(lunout,*)"dynredem0: Pb d ouverture du fichier "
+     &                  //trim(fichnom)
+         write(lunout,*)' ierr = ', ierr
          CALL ABORT
       ENDIF
@@ -508,7 +511,8 @@
       ierr = NF_CLOSE(nid) ! fermer le fichier
 
-      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
-      PRINT*,'rad,omeg,g,cpp,kappa',
-     ,        rad,omeg,g,cpp,kappa
+      write(lunout,*)'dynredem0: iim,jjm,llm,iday_end',
+     &               iim,jjm,llm,iday_end
+      write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa',
+     &        rad,omeg,g,cpp,kappa
 
       RETURN
@@ -517,4 +521,6 @@
      .                     vcov,ucov,teta,q,masse,ps)
       USE infotrac
+      USE control_mod
+ 
       IMPLICIT NONE
 c=================================================================
@@ -528,5 +534,6 @@
 #include "comgeom.h"
 #include "temps.h"
-#include "control.h"
+#include "iniprint.h"
+
 
       INTEGER l
@@ -555,5 +562,5 @@
       ierr = NF_OPEN(fichnom, NF_WRITE, nid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Pb. d ouverture "//fichnom
+         write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
          CALL abort
       ENDIF
@@ -564,5 +571,5 @@
       ierr = NF_INQ_VARID(nid, "temps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         print *, NF_STRERROR(ierr)
+         write(lunout,*) NF_STRERROR(ierr)
          abort_message='Variable temps n est pas definie'
          CALL abort_gcm(modname,abort_message,ierr)
@@ -573,5 +580,5 @@
       ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
 #endif
-      PRINT*, "Enregistrement pour ", nb, time
+      write(lunout,*) "dynredem1: Enregistrement pour ", nb, time
 
 c
@@ -589,5 +596,5 @@
       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
 #endif
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(31) = REAL(itau_dyn + itaufin)
 #ifdef NC_DOUBLE
       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
@@ -600,6 +607,7 @@
       ierr = NF_INQ_VARID(nid, "ucov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ucov n est pas definie"
-         CALL abort
+         abort_message="Variable ucov n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -611,6 +619,7 @@
       ierr = NF_INQ_VARID(nid, "vcov", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable vcov n est pas definie"
-         CALL abort
+         abort_message="Variable vcov n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -622,6 +631,7 @@
       ierr = NF_INQ_VARID(nid, "teta", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable teta n est pas definie"
-         CALL abort
+         abort_message="Variable teta n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -635,6 +645,7 @@
          ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
          IF (ierr_file .NE.NF_NOERR) THEN
-            write(6,*)' Pb d''ouverture du fichier start_trac.nc'
-            write(6,*)' ierr = ', ierr_file 
+            write(lunout,*)'dynredem1: Pb d''ouverture du fichier',
+     &                     ' start_trac.nc'
+            write(lunout,*)' ierr = ', ierr_file 
          ENDIF
       END IF
@@ -646,6 +657,7 @@
             ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
             IF (ierr .NE. NF_NOERR) THEN
-               PRINT*, "Variable  tname(iq) n est pas definie"
-               CALL abort
+               abort_message="Variable  tname(iq) n est pas definie"
+               ierr=1
+               CALL abort_gcm(modname,abort_message,ierr)
             ENDIF
 #ifdef NC_DOUBLE
@@ -659,9 +671,12 @@
              ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
              IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, tname(iq),"est absent de start_trac.nc"
+                write(lunout,*) "dynredem1: ",trim(tname(iq)),
+     &                          " est absent de start_trac.nc"
                 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
+                   abort_message="dynredem1: Variable "//
+     &                     trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
 #ifdef NC_DOUBLE
@@ -672,5 +687,6 @@
                 
              ELSE
-                PRINT*, tname(iq), "est present dans start_trac.nc"
+                write(lunout,*) "dynredem1: ",trim(tname(iq)),
+     &              " est present dans start_trac.nc"
 #ifdef NC_DOUBLE
                ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp)
@@ -679,11 +695,15 @@
 #endif
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Lecture echouee pour", tname(iq)
-                   CALL abort
+                   abort_message="dynredem1: Lecture echouee pour"//
+     &                    trim(tname(iq))
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
                 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
                 IF (ierr .NE. NF_NOERR) THEN
-                   PRINT*, "Variable ", tname(iq)," n est pas definie"
-                   CALL abort
+                   abort_message="dynredem1: Variable "//
+     &                trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
                 ENDIF
 #ifdef NC_DOUBLE
@@ -699,6 +719,8 @@
              ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
              IF (ierr .NE. NF_NOERR) THEN
-                PRINT*, "Variable  tname(iq) n est pas definie"
-                CALL abort
+                abort_message="dynredem1: Variable "//
+     &                trim(tname(iq))//" n est pas definie"
+                   ierr=1
+                   CALL abort_gcm(modname,abort_message,ierr)
              ENDIF
 #ifdef NC_DOUBLE
@@ -715,6 +737,7 @@
       ierr = NF_INQ_VARID(nid, "masse", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable masse n est pas definie"
-         CALL abort
+         abort_message="dynredem1: Variable masse n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
@@ -726,6 +749,7 @@
       ierr = NF_INQ_VARID(nid, "ps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         PRINT*, "Variable ps n est pas definie"
-         CALL abort
+         abort_message="dynredem1: Variable ps n est pas definie"
+         ierr=1
+         CALL abort_gcm(modname,abort_message,ierr)
       ENDIF
 #ifdef NC_DOUBLE
Index: /LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F	(revision 1403)
@@ -74,9 +74,9 @@
        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(1)  =  REAL(iim)
+       tab_cntrl(2)  =  REAL(jjm)
+       tab_cntrl(3)  =  REAL(llm)
+       tab_cntrl(4)  =  REAL(day_ref)
+       tab_cntrl(5)  =  REAL(annee_ref)
        tab_cntrl(6)  = rad
        tab_cntrl(7)  = omeg
@@ -118,6 +118,6 @@
       ENDIF
 
-       tab_cntrl(30) = FLOAT(iday_end)
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(30) =  REAL(iday_end)
+       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
 c
 c    .........................................................
@@ -521,4 +521,5 @@
       USE parallel
       USE infotrac
+      USE control_mod
       IMPLICIT NONE
 c=================================================================
@@ -532,5 +533,4 @@
 #include "comgeom.h"
 #include "temps.h"
-#include "control.h"
 
       INTEGER l
@@ -608,5 +608,5 @@
       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
 #endif
-       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
 #ifdef NC_DOUBLE
       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
Index: /LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90	(revision 1403)
@@ -24,4 +24,5 @@
   USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
 #endif
+  USE control_mod
   IMPLICIT NONE
 !-------------------------------------------------------------------------------
@@ -72,5 +73,4 @@
 
 #include "comdissnew.h"
-#include "control.h"
 #include "serre.h"
 #include "clesphys.h"
@@ -103,4 +103,5 @@
   REAL    :: tau_thermals, solarlong0,  seuil_inversion
   INTEGER :: read_climoz ! read ozone climatology
+  REAL    :: alp_offset
 !  Allowed values are 0, 1 and 2
 !     0: do not read an ozone climatology
@@ -132,5 +133,6 @@
                    iflag_thermals,nsplit_thermals,tau_thermals,         &
                    iflag_thermals_ed,iflag_thermals_optflux,            &
-                   iflag_coupl,iflag_clos,iflag_wake, read_climoz )
+                   iflag_coupl,iflag_clos,iflag_wake, read_climoz,      &
+                   alp_offset)
 
 ! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
Index: /LMDZ4/trunk/libf/dyn3dpar/exner_hyb.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/exner_hyb.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/exner_hyb.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id $
 !
       SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
@@ -51,5 +51,33 @@
       REAL SSUM
 c
+
+      if (llm.eq.1) then
+        ! Specific behaviour for Shallow Water (1 vertical layer) case
       
+        ! Sanity checks
+        if (kappa.ne.1) then
+          call abort_gcm("exner_hyb",
+     &    "kappa!=1 , but running in Shallow Water mode!!",42)
+        endif
+        if (cpp.ne.r) then
+        call abort_gcm("exner_hyb",
+     &    "cpp!=r , but running in Shallow Water mode!!",42)
+        endif
+        
+        ! Compute pks(:),pk(:),pkf(:)
+        
+        DO   ij  = 1, ngrid
+          pks(ij) = (cpp/preff) * ps(ij) 
+          pk(ij,1) = .5*pks(ij)
+        ENDDO
+        
+        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+        CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
+        
+        ! our work is done, exit routine
+        return
+      endif ! of if (llm.eq.1)
+
+     
       unpl2k    = 1.+ 2.* kappa
 c
Index: /LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id $
+!
       SUBROUTINE  exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
 c
@@ -51,5 +54,67 @@
       INTEGER ije,ijb,jje,jjb
 c
-c$OMP BARRIER           
+c$OMP BARRIER
+
+      if (llm.eq.1) then
+        ! Specific behaviour for Shallow Water (1 vertical layer) case
+      
+        ! Sanity checks
+        if (kappa.ne.1) then
+          call abort_gcm("exner_hyb",
+     &    "kappa!=1 , but running in Shallow Water mode!!",42)
+        endif
+        if (cpp.ne.r) then
+        call abort_gcm("exner_hyb",
+     &    "cpp!=r , but running in Shallow Water mode!!",42)
+        endif
+        
+        ! Compute pks(:),pk(:),pkf(:)
+        ijb=ij_begin
+        ije=ij_end
+!$OMP DO SCHEDULE(STATIC)
+        DO ij=ijb, ije
+          pks(ij)=(cpp/preff)*ps(ij)
+          pk(ij,1) = .5*pks(ij)
+          pkf(ij,1)=pk(ij,1)
+        ENDDO
+!$OMP ENDDO
+
+!$OMP MASTER
+      if (pole_nord) then
+        DO  ij   = 1, iim
+          ppn(ij) = aire(   ij   ) * pks(  ij     )
+        ENDDO
+        xpn      = SSUM(iim,ppn,1) /apoln
+  
+        DO ij   = 1, iip1
+          pks(   ij     )  =  xpn
+          pk(ij,1) = .5*pks(ij)
+          pkf(ij,1)=pk(ij,1)
+        ENDDO
+      endif
+      
+      if (pole_sud) then
+        DO  ij   = 1, iim
+          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+        ENDDO
+        xps      = SSUM(iim,pps,1) /apols 
+  
+        DO ij   = 1, iip1
+          pks( ij+ip1jm )  =  xps
+          pk(ij+ip1jm,1)=.5*pks(ij+ip1jm)
+          pkf(ij+ip1jm,1)=pk(ij+ip1jm,1)
+        ENDDO
+      endif
+!$OMP END MASTER
+
+        jjb=jj_begin
+        jje=jj_end
+        CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
+
+        ! our work is done, exit routine
+        return
+      endif ! of if (llm.eq.1)
+
+
       unpl2k    = 1.+ 2.* kappa
 c
Index: /LMDZ4/trunk/libf/dyn3dpar/extrapol.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/extrapol.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/extrapol.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 C
@@ -158,5 +158,5 @@
                jlat = jy(k)
                pwork(i,j) = pwork(i,j)
-     $                      + pfild(ilon,jlat) * zmask(k)/FLOAT(inbor)
+     $                      + pfild(ilon,jlat) * zmask(k)/ REAL(inbor)
             ENDDO
          ENDIF
Index: /LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F	(revision 1403)
@@ -4,6 +4,6 @@
       SUBROUTINE fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis,
      . time_step,itau )
-#ifdef CPP_EARTH
-! This routine is designed to work for Earth and with ioipsl
+#ifdef CPP_IOIPSL
+! This routine is designed to work with ioipsl
 
        USE IOIPSL
@@ -153,7 +153,7 @@
       DO l=1,llm
          DO ij = ijb,ije
-            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
-            tetac(ij,l) = tetac(ij,l)/float(istdyn)
-            phic(ij,l) = phic(ij,l)/float(istdyn)
+            pbaruc(ij,l) = pbaruc(ij,l)/REAL(istdyn)
+            tetac(ij,l) = tetac(ij,l)/REAL(istdyn)
+            phic(ij,l) = phic(ij,l)/REAL(istdyn)
          ENDDO
       ENDDO
@@ -165,5 +165,5 @@
       DO l=1,llm
           DO ij = ijb,ije
-            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+            pbarvc(ij,l) = pbarvc(ij,l)/REAL(istdyn)
          ENDDO
       ENDDO
@@ -202,5 +202,5 @@
       
          iadvtr=0
-	Print*,'ITAU auqel on stoke les fluxmasses',itau
+	write(lunout,*)'ITAU auquel on stoke les fluxmasses',itau
 	
         ijb=ij_begin
@@ -244,7 +244,7 @@
 #else
       write(lunout,*)
-     & 'fluxstokenc: Needs Earth physics (and ioipsl) to function'
+     & 'fluxstokenc: Needs IOIPSL to function'
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_IOIPSL
       RETURN
       END
Index: /LMDZ4/trunk/libf/dyn3dpar/friction_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/friction_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/friction_p.F	(revision 1403)
@@ -1,8 +1,9 @@
 !
-! $Header$
+! $Id$
 !
 c=======================================================================
       SUBROUTINE friction_p(ucov,vcov,pdt)
       USE parallel
+      USE control_mod
       IMPLICIT NONE
 
@@ -22,5 +23,4 @@
 #include "paramet.h"
 #include "comgeom2.h"
-#include "control.h"
 #include "comconst.h"
 
Index: /LMDZ4/trunk/libf/dyn3dpar/fxhyp.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/fxhyp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/fxhyp.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -89,5 +89,5 @@
 
        DO i = 0, nmax2 
-        xtild(i) = - pi + FLOAT(i) * depi /nmax2
+        xtild(i) = - pi + REAL(i) * depi /nmax2
        ENDDO
 
@@ -235,5 +235,5 @@
       DO 1500 i = ii1, ii2
 
-      xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
+      xlon2 = - pi + (REAL(i) + xuv - decalx) * depi / REAL(iim) 
 
       Xfi    = xlon2
@@ -280,5 +280,5 @@
 550   CONTINUE
 
-       xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )
+       xxprim(i) = depi/ ( REAL(iim) * Xprimin )
        xvrai(i)  =  xi + xzoom
 
Index: /LMDZ4/trunk/libf/dyn3dpar/fxy.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/fxy.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/fxy.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
@@ -32,6 +32,6 @@
 c
        DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( FLOAT( j )        )
-         yprimu(j) = fyprim( FLOAT( j )        )
+          rlatu(j) = fy    ( REAL( j )        )
+         yprimu(j) = fyprim( REAL( j )        )
        ENDDO
 
@@ -39,11 +39,11 @@
        DO j = 1, jjm
 
-         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
-         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
+         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
 
-        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
-        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
+        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
 
        ENDDO
@@ -53,13 +53,13 @@
 c
        DO i = 1, iim + 1
-           rlonv(i)     = fx    (   FLOAT( i )          )
-           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
-        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
-        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+           rlonv(i)     = fx    (   REAL( i )          )
+           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
+        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
+        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
 
-         xprimv  (i)    = fxprim (  FLOAT( i )          )
-         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+         xprimv  (i)    = fxprim (  REAL( i )          )
+         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
        ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3dpar/fxysinus.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/fxysinus.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/fxysinus.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1,
@@ -32,6 +32,6 @@
 c
        DO j = 1, jjm + 1 
-          rlatu(j) = fy    ( FLOAT( j )        )
-         yprimu(j) = fyprim( FLOAT( j )        )
+          rlatu(j) = fy    ( REAL( j )        )
+         yprimu(j) = fyprim( REAL( j )        )
        ENDDO
 
@@ -39,11 +39,11 @@
        DO j = 1, jjm
 
-         rlatv(j)  = fy    ( FLOAT( j ) + 0.5  )
-         rlatu1(j) = fy    ( FLOAT( j ) + 0.25 ) 
-         rlatu2(j) = fy    ( FLOAT( j ) + 0.75 ) 
+         rlatv(j)  = fy    ( REAL( j ) + 0.5  )
+         rlatu1(j) = fy    ( REAL( j ) + 0.25 ) 
+         rlatu2(j) = fy    ( REAL( j ) + 0.75 ) 
 
-        yprimv(j)  = fyprim( FLOAT( j ) + 0.5  ) 
-        yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )
-        yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )
+        yprimv(j)  = fyprim( REAL( j ) + 0.5  ) 
+        yprimu1(j) = fyprim( REAL( j ) + 0.25 )
+        yprimu2(j) = fyprim( REAL( j ) + 0.75 )
 
        ENDDO
@@ -53,13 +53,13 @@
 c
        DO i = 1, iim + 1
-           rlonv(i)     = fx    (   FLOAT( i )          )
-           rlonu(i)     = fx    (   FLOAT( i ) + 0.5    )
-        rlonm025(i)     = fx    (   FLOAT( i ) - 0.25  )
-        rlonp025(i)     = fx    (   FLOAT( i ) + 0.25  )
+           rlonv(i)     = fx    (   REAL( i )          )
+           rlonu(i)     = fx    (   REAL( i ) + 0.5    )
+        rlonm025(i)     = fx    (   REAL( i ) - 0.25  )
+        rlonp025(i)     = fx    (   REAL( i ) + 0.25  )
 
-         xprimv  (i)    = fxprim (  FLOAT( i )          )
-         xprimu  (i)    = fxprim (  FLOAT( i ) + 0.5    )
-        xprimm025(i)    = fxprim (  FLOAT( i ) - 0.25   )
-        xprimp025(i)    = fxprim (  FLOAT( i ) + 0.25   )
+         xprimv  (i)    = fxprim (  REAL( i )          )
+         xprimu  (i)    = fxprim (  REAL( i ) + 0.5    )
+        xprimm025(i)    = fxprim (  REAL( i ) - 0.25   )
+        xprimp025(i)    = fxprim (  REAL( i ) + 0.25   )
        ENDDO
 
Index: /LMDZ4/trunk/libf/dyn3dpar/fyhyp.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/fyhyp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/fyhyp.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -75,5 +75,5 @@
        depi     = 2. * pi
        pis2     = pi/2.
-       pisjm    = pi/ FLOAT(jjm)
+       pisjm    = pi/ REAL(jjm)
        epsilon  = 1.e-3
        y0       =  yzoomdeg * pi/180. 
@@ -94,5 +94,5 @@
 
        DO i = 0, nmax2 
-        yt(i) = - pis2  + FLOAT(i)* pi /nmax2
+        yt(i) = - pis2  + REAL(i)* pi /nmax2
        ENDDO
 
@@ -210,5 +210,5 @@
        DO 1500 j =  1,jlat
         yo1   = 0.
-        ylon2 =  - pis2 + pisjm * ( FLOAT(j)  + yuv  -1.)  
+        ylon2 =  - pis2 + pisjm * ( REAL(j)  + yuv  -1.)  
         yfi    = ylon2
 c
Index: /LMDZ4/trunk/libf/dyn3dpar/gcm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/gcm.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/gcm.F	(revision 1403)
@@ -18,4 +18,5 @@
       USE getparam
       USE filtreg_mod
+      USE control_mod
 
 ! Ehouarn: for now these only apply to Earth:
@@ -66,12 +67,15 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
 #include "serre.h"
-#include "com_io_dyn.h"
+!#include "com_io_dyn.h"
 #include "iniprint.h"
 #include "tracstoke.h"
+
+#ifdef INCA
+! Only INCA needs these informations (from the Earth's physics)
 #include "indicesol.h"
+#endif
 
       INTEGER         longcles
@@ -267,14 +271,21 @@
       if (read_start) then
       ! we still need to run iniacademic to initialize some
-      ! constants & fields, if we run the 'newtonian' case:
-        if (iflag_phys.eq.2) then
+      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
+        if (iflag_phys.ne.1) then
           CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
         endif
-!#ifdef CPP_IOIPSL
+
         if (planet_type.eq."earth") then
 #ifdef CPP_EARTH
 ! Load an Earth-format start file
          CALL dynetat0("start.nc",vcov,ucov,
-     .              teta,q,masse,ps,phis, time_0)
+     &              teta,q,masse,ps,phis, time_0)
+#else
+        ! SW model also has Earth-format start files
+        ! (but can be used without the CPP_EARTH directive)
+          if (iflag_phys.eq.0) then
+            CALL dynetat0("start.nc",vcov,ucov,
+     &              teta,q,masse,ps,phis, time_0)
+          endif
 #endif
         endif ! of if (planet_type.eq."earth")
@@ -311,5 +322,5 @@
       ENDIF
 
-      zdtvr    = daysec/FLOAT(day_step)
+      zdtvr    = daysec/REAL(day_step)
         IF(dtvr.NE.zdtvr) THEN
          WRITE(lunout,*)
@@ -320,5 +331,14 @@
 C on remet le calendrier à zero si demande
 c
-      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
+      IF (raz_date == 1) THEN
+        annee_ref = anneeref
+        day_ref = dayref
+        day_ini = dayref
+        itau_dyn = 0
+        itau_phy = 0
+        time_0 = 0.
+        write(lunout,*)
+     .   'GCM: On reinitialise a la date lue dans gcm.def'
+      ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
         write(lunout,*)
      .  'GCM: Attention les dates initiales lues dans le fichier'
@@ -326,22 +346,32 @@
      .  ' restart ne correspondent pas a celles lues dans '
         write(lunout,*)' gcm.def'
-	write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
-	write(lunout,*)' day_ref=',day_ref," dayref=",dayref
-        if (raz_date .ne. 1) then
-          write(lunout,*)
-     .    'GCM: On garde les dates du fichier restart'
-        else
-          annee_ref = anneeref
-          day_ref = dayref
-          day_ini = dayref
-          itau_dyn = 0
-          itau_phy = 0
-          time_0 = 0.
-          write(lunout,*)
-     .   'GCM: On reinitialise a la date lue dans gcm.def'
-        endif
-      ELSE
-        raz_date = 0
-      endif
+        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
+        write(lunout,*)' Pas de remise a zero'
+      ENDIF
+c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
+c        write(lunout,*)
+c     .  'GCM: Attention les dates initiales lues dans le fichier'
+c        write(lunout,*)
+c     .  ' restart ne correspondent pas a celles lues dans '
+c        write(lunout,*)' gcm.def'
+c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
+c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
+c        if (raz_date .ne. 1) then
+c          write(lunout,*)
+c     .    'GCM: On garde les dates du fichier restart'
+c        else
+c          annee_ref = anneeref
+c          day_ref = dayref
+c          day_ini = dayref
+c          itau_dyn = 0
+c          itau_phy = 0
+c          time_0 = 0.
+c          write(lunout,*)
+c     .   'GCM: On reinitialise a la date lue dans gcm.def'
+c        endif
+c      ELSE
+c        raz_date = 0
+c      endif
 
 #ifdef CPP_IOIPSL
@@ -372,19 +402,23 @@
       nbetatmoy = nday / periodav + 1
 
+      if (iflag_phys.eq.1) then
+      ! these initialisations have already been done (via iniacademic)
+      ! if running in SW or Newtonian mode
 c-----------------------------------------------------------------------
 c   Initialisation des constantes dynamiques :
 c   ------------------------------------------
-      dtvr = zdtvr
-      CALL iniconst
+        dtvr = zdtvr
+        CALL iniconst
 
 c-----------------------------------------------------------------------
 c   Initialisation de la geometrie :
 c   --------------------------------
-      CALL inigeom
+        CALL inigeom
 
 c-----------------------------------------------------------------------
 c   Initialisation du filtre :
 c   --------------------------
-      CALL inifilr
+        CALL inifilr
+      endif ! of if (iflag_phys.eq.1)
 c
 c-----------------------------------------------------------------------
@@ -422,5 +456,5 @@
          if (planet_type.eq."earth") then
 #ifdef CPP_EARTH
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
+         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
      ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
 #endif
@@ -467,21 +501,27 @@
 
 #ifdef CPP_IOIPSL
-      if ( 1.eq.1) then
       time_step = zdtvr
-      t_ops = iecri * daysec
-      t_wrt = iecri * daysec
-!      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
-!     .              t_ops, t_wrt, histid, histvid)
-
-      IF (ok_dynzon) THEN 
-         t_ops = iperiod * time_step
-         t_wrt = periodav * daysec
+      IF (mpi_rank==0) then
+        if (ok_dyn_ins) then
+          ! initialize output file for instantaneous outputs
+          ! t_ops = iecri * daysec ! do operations every t_ops
+          t_ops =((1.0*iecri)/day_step) * daysec  
+          t_wrt = daysec ! iecri * daysec ! write output every t_wrt
+          t_wrt = daysec ! iecri * daysec ! write output every t_wrt
+          CALL inithist(day_ref,annee_ref,time_step,
+     &                  t_ops,t_wrt)
+        endif
+
+        IF (ok_dyn_ave) THEN 
+          ! initialize output file for averaged outputs
+          t_ops = iperiod * time_step ! do operations every t_ops
+          t_wrt = periodav * daysec   ! write output every t_wrt
+          CALL initdynav(day_ref,annee_ref,time_step,
+     &                   t_ops,t_wrt)
 !         CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
 !     .        t_ops, t_wrt, histaveid)
-      END IF
+        END IF
+      ENDIF
       dtav = iperiod*dtvr/daysec
-      endif
-
-
 #endif
 ! #endif of #ifdef CPP_IOIPSL
Index: /LMDZ4/trunk/libf/dyn3dpar/grid_atob.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/grid_atob.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/grid_atob.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree,
@@ -717,14 +717,14 @@
 c Calculs intermediares:
 c
-      xtmp(1) = -180.0 + 360.0/FLOAT(imtmp) / 2.0
+      xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0
       DO i = 2, imtmp
-         xtmp(i) = xtmp(i-1) + 360.0/FLOAT(imtmp)
+         xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp)
       ENDDO
       DO i = 1, imtmp
          xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0)
       ENDDO
-      ytmp(1) = -90.0 + 180.0/FLOAT(jmtmp) / 2.0
+      ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0
       DO j = 2, jmtmp
-         ytmp(j) = ytmp(j-1) + 180.0/FLOAT(jmtmp)
+         ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp)
       ENDDO
       DO j = 1, jmtmp
Index: /LMDZ4/trunk/libf/dyn3dpar/grid_noro.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/grid_noro.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/grid_noro.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -93,5 +93,5 @@
       xpi=acos(-1.)
       rad    = 6 371 229.
-      zdeltay=2.*xpi/float(jusn)*rad
+      zdeltay=2.*xpi/REAL(jusn)*rad
 c
 c utilise-t'on un masque lu?
@@ -215,6 +215,6 @@
 c  SUMMATION OVER GRIDPOINT AREA
 c 
-      zleny=xpi/float(jusn)*rad
-      xincr=xpi/2./float(jusn)
+      zleny=xpi/REAL(jusn)*rad
+      xincr=xpi/2./REAL(jusn)
        DO ii = 1, imar+1
        DO jj = 1, jmar
@@ -468,5 +468,5 @@
       DO IS=-1,1
         DO JS=-1,1
-          WEIGHTpb(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
+          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
           SUM=SUM+WEIGHTpb(IS,JS)
         ENDDO
Index: /LMDZ4/trunk/libf/dyn3dpar/grilles_gcm_netcdf.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/grilles_gcm_netcdf.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/grilles_gcm_netcdf.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -218,13 +218,13 @@
       open (20,file='grille.dat',form='unformatted',access='direct'
      s      ,recl=4*ip1jmp1)
-      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
-      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=1) (( REAL(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=2) (( REAL(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
       do j=2,jjm
          dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
-c        dlat2(j)=180.*fyprim(float(j))/pi
+c        dlat2(j)=180.*fyprim( REAL(j))/pi
       enddo
       do i=2,iip1
          dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
-c        dlon2(i)=180.*fxprim(float(i))/pi
+c        dlon2(i)=180.*fxprim( REAL(i))/pi
       enddo
       do j=2,jjm
Index: /LMDZ4/trunk/libf/dyn3dpar/guide_p_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/guide_p_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/guide_p_mod.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/guide.F,v 1.3.4.1 2006/11/06 15:51:16 fairhead Exp $
+! $Id$
 !
 MODULE guide_p_mod
@@ -66,4 +66,5 @@
   SUBROUTINE guide_init
 
+    USE control_mod
     IMPLICIT NONE
   
@@ -71,5 +72,4 @@
     INCLUDE "paramet.h"
     INCLUDE "netcdf.inc"
-    INCLUDE "control.h"
 
     INTEGER                :: error,ncidpl,rid,rcod
@@ -274,4 +274,5 @@
   SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
     use parallel
+    USE control_mod
     
     IMPLICIT NONE
@@ -279,5 +280,4 @@
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
-    INCLUDE "control.h"
     INCLUDE "comconst.h"
     INCLUDE "comvert.h"
@@ -380,7 +380,7 @@
       dday_step=real(day_step)
       IF (iguide_read.LT.0) THEN
-          tau=ditau/dday_step/FLOAT(iguide_read)
+          tau=ditau/dday_step/ REAL(iguide_read)
       ELSE
-          tau=FLOAT(iguide_read)*ditau/dday_step
+          tau= REAL(iguide_read)*ditau/dday_step
       ENDIF
       reste=tau-AINT(tau)
@@ -580,5 +580,5 @@
               ENDDO
           ENDDO 
-          fieldm(:,l)=fieldm(:,l)/FLOAT(imax(typ)-imin(typ)+1)
+          fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
     ! Compute forcing
           DO j=jjb_v,jje_v
@@ -598,5 +598,5 @@
               ENDDO
           ENDDO 
-          fieldm(:,l)=fieldm(:,l)/FLOAT(imax(typ)-imin(typ)+1)
+          fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
     ! Compute forcing
           DO j=jjb_u,jje_u
Index: /LMDZ4/trunk/libf/dyn3dpar/infotrac.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/infotrac.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/infotrac.F90	(revision 1403)
@@ -31,4 +31,5 @@
 
   SUBROUTINE infotrac_init
+    USE control_mod
     IMPLICIT NONE
 !=======================================================================
@@ -49,5 +50,4 @@
 
     INCLUDE "dimensions.h"
-    INCLUDE "control.h"
     INCLUDE "iniprint.h"
 
Index: /LMDZ4/trunk/libf/dyn3dpar/iniacademic.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/iniacademic.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/iniacademic.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -8,4 +8,6 @@
       USE filtreg_mod
       USE infotrac, ONLY : nqtot
+      USE control_mod
+ 
 
 c%W%    %G%
@@ -44,6 +46,6 @@
 #include "ener.h"
 #include "temps.h"
-#include "control.h"
 #include "iniprint.h"
+#include "logic.h"
 
 c   Arguments:
@@ -55,5 +57,5 @@
       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
       REAL teta(ip1jmp1,llm)                 ! temperature potentielle
-      REAL q(ip1jmp1,llm,nqtot)              ! champs advectes
+      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
       REAL ps(ip1jmp1)                       ! pression  au sol
       REAL masse(ip1jmp1,llm)                ! masse d'air
@@ -84,5 +86,5 @@
         time_0=0.
         day_ref=0
-	annee_ref=0
+        annee_ref=0
 
         im         = iim
@@ -93,5 +95,5 @@
         g      = 9.8
         daysec = 86400.
-        dtvr    = daysec/FLOAT(day_step)
+        dtvr    = daysec/REAL(day_step)
         zdtvr=dtvr
         kappa  = 0.2857143
@@ -105,13 +107,31 @@
         ang0       = 0.
 
+        if (llm.eq.1) then
+          ! specific initializations for the shallow water case
+          kappa=1
+        endif
+        
         CALL iniconst
         CALL inigeom
         CALL inifilr
 
-        ps=0.
-        phis=0.
+        if (llm.eq.1) then
+          ! initialize fields for the shallow water case, if required
+          if (.not.read_start) then
+            phis(:)=0.
+            q(:,:,1)=1.e-10
+            q(:,:,2)=1.e-15
+            q(:,:,3:nqtot)=0.
+            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+          endif
+        endif
+
+        if (iflag_phys.eq.2) then
+          ! initializations for the academic case
+          ps(:)=1.e5
+          phis(:)=0.
 c---------------------------------------------------------------------
 
-        taurappel=10.*daysec
+          taurappel=10.*daysec
 
 c---------------------------------------------------------------------
@@ -119,63 +139,61 @@
 c   --------------------------------------
 
-        DO l=1,llm
-         zsig=ap(l)/preff+bp(l)
-         if (zsig.gt.0.3) then
-           lsup=l
-           tetarappell=1./8.*(-log(zsig)-.5)
-           DO j=1,jjp1
+          DO l=1,llm
+            zsig=ap(l)/preff+bp(l)
+            if (zsig.gt.0.3) then
+             lsup=l
+             tetarappell=1./8.*(-log(zsig)-.5)
+             DO j=1,jjp1
              ddsin=sin(rlatu(j))-sin(pi/20.)
              tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
-           ENDDO
-          else
+             ENDDO
+            else
 c   Choix isotherme au-dessus de 300 mbar
-           do j=1,jjp1
-             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
-           enddo
-          endif ! of if (zsig.gt.0.3)
-        ENDDO ! of DO l=1,llm
-
-        do l=1,llm
-           do j=1,jjp1
+             do j=1,jjp1
+               tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
+             enddo
+            endif ! of if (zsig.gt.0.3)
+          ENDDO ! of DO l=1,llm
+
+          do l=1,llm
+            do j=1,jjp1
               do i=1,iip1
                  ij=(j-1)*iip1+i
                  tetarappel(ij,l)=tetajl(j,l)
               enddo
-           enddo
-        enddo
+            enddo
+          enddo
 
 c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
 
-        ps=1.e5
-        phis=0.
-        CALL pression ( ip1jmp1, ap, bp, ps, p       )
-        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-        CALL massdair(p,masse)
+          CALL pression ( ip1jmp1, ap, bp, ps, p       )
+          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+          CALL massdair(p,masse)
 
 c  intialisation du vent et de la temperature
-        teta(:,:)=tetarappel(:,:)
-        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
-        call ugeostr(phi,ucov)
-        vcov=0.
-        q(:,:,1   )=1.e-10
-        q(:,:,2   )=1.e-15
-        q(:,:,3:nqtot)=0.
+          teta(:,:)=tetarappel(:,:)
+          CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
+          call ugeostr(phi,ucov)
+          vcov=0.
+          q(:,:,1   )=1.e-10
+          q(:,:,2   )=1.e-15
+          q(:,:,3:nqtot)=0.
 
 
 c   perturbation aleatoire sur la temperature
-        idum  = -1
-        zz = ran1(idum)
-        idum  = 0
-        do l=1,llm
-           do ij=iip2,ip1jm
+          idum  = -1
+          zz = ran1(idum)
+          idum  = 0
+          do l=1,llm
+            do ij=iip2,ip1jm
               teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
-           enddo
-        enddo
-
-        do l=1,llm
-           do ij=1,ip1jmp1,iip1
+            enddo
+          enddo
+
+          do l=1,llm
+            do ij=1,ip1jmp1,iip1
               teta(ij+iim,l)=teta(ij,l)
-           enddo
-        enddo
+            enddo
+          enddo
 
 
@@ -187,9 +205,10 @@
 
 c   initialisation d'un traceur sur une colonne
-        j=jjp1*3/4
-        i=iip1/2
-        ij=(j-1)*iip1+i
-        q(ij,:,3)=1.
-      
+          j=jjp1*3/4
+          i=iip1/2
+          ij=(j-1)*iip1+i
+          q(ij,:,3)=1.
+        endif ! of if (iflag_phys.eq.2)
+        
       else
         write(lunout,*)"iniacademic: planet types other than earth",
Index: /LMDZ4/trunk/libf/dyn3dpar/iniconst.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/iniconst.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/iniconst.F	(revision 1403)
@@ -1,6 +1,8 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE iniconst
+
+      USE control_mod
 
       IMPLICIT NONE
@@ -16,6 +18,6 @@
 #include "comconst.h"
 #include "temps.h"
-#include "control.h"
 #include "comvert.h"
+#include "iniprint.h"
 
 
@@ -47,5 +49,5 @@
       r       = cpp * kappa
 
-      PRINT*,' R  CP  Kappa ',  r , cpp,  kappa
+      write(lunout,*)'iniconst: R  CP  Kappa ',  r , cpp,  kappa
 c
 c-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3dpar/inidissip.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/inidissip.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/inidissip.F	(revision 1403)
@@ -11,4 +11,6 @@
 c   -------------
 
+      USE control_mod
+
       IMPLICIT NONE
 #include "dimensions.h"
@@ -17,5 +19,4 @@
 #include "comconst.h"
 #include "comvert.h"
-#include "control.h"
 #include "logic.h"
 
@@ -165,5 +166,5 @@
 
 c     IF(.NOT.lstardis) THEN
-         fact    = rad*24./float(jjm)
+         fact    = rad*24./REAL(jjm)
          fact    = fact*fact
          PRINT*,'coef u ', fact/cdivu, 1./cdivu
Index: /LMDZ4/trunk/libf/dyn3dpar/inigeom.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/inigeom.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/inigeom.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -168,15 +168,15 @@
 c
       IF( nitergdiv.NE.2 ) THEN
-        gamdi_gdiv = coefdis/ ( float(nitergdiv) -2. )
+        gamdi_gdiv = coefdis/ ( REAL(nitergdiv) -2. )
       ELSE
         gamdi_gdiv = 0.
       ENDIF
       IF( nitergrot.NE.2 ) THEN
-        gamdi_grot = coefdis/ ( float(nitergrot) -2. )
+        gamdi_grot = coefdis/ ( REAL(nitergrot) -2. )
       ELSE
         gamdi_grot = 0.
       ENDIF
       IF( niterh.NE.2 ) THEN
-        gamdi_h = coefdis/ ( float(niterh) -2. )
+        gamdi_h = coefdis/ ( REAL(niterh) -2. )
       ELSE
         gamdi_h = 0.
@@ -381,6 +381,6 @@
        yprp               = yprimu2(j-1)
        rlatp              = rlatu2 (j-1)
-ccc       yprp             = fyprim( FLOAT(j) - 0.25 )
-ccc       rlatp            = fy    ( FLOAT(j) - 0.25 )
+ccc       yprp             = fyprim( REAL(j) - 0.25 )
+ccc       rlatp            = fy    ( REAL(j) - 0.25 )
 c
       coslatp             = COS( rlatp )
@@ -416,8 +416,8 @@
         rlatm    = rlatu1 (  j  )
         yprm     = yprimu1(  j  )
-cc         rlatp    = fy    ( FLOAT(j) - 0.25 )
-cc         yprp     = fyprim( FLOAT(j) - 0.25 )
-cc         rlatm    = fy    ( FLOAT(j) + 0.25 )
-cc         yprm     = fyprim( FLOAT(j) + 0.25 )
+cc         rlatp    = fy    ( REAL(j) - 0.25 )
+cc         yprp     = fyprim( REAL(j) - 0.25 )
+cc         rlatm    = fy    ( REAL(j) + 0.25 )
+cc         yprm     = fyprim( REAL(j) + 0.25 )
 
          coslatm  = COS( rlatm )
Index: /LMDZ4/trunk/libf/dyn3dpar/integrd_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/integrd_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/integrd_p.F	(revision 1403)
@@ -6,4 +6,5 @@
      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
       USE parallel
+      USE control_mod
       IMPLICIT NONE
 
@@ -32,5 +33,4 @@
 #include "temps.h"
 #include "serre.h"
-#include "control.h"
 
 c   Arguments:
Index: /LMDZ4/trunk/libf/dyn3dpar/interpre.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/interpre.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/interpre.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
        subroutine interpre(q,qppm,w,fluxwppm,masse,
@@ -6,5 +6,6 @@
      s            unatppm,vnatppm,psppm)
 
-       implicit none
+      USE control_mod
+      implicit none
 
 #include "dimensions.h"
@@ -17,5 +18,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F	(revision 1403)
@@ -20,4 +20,5 @@
        USE guide_p_mod, ONLY : guide_main
        USE getparam
+       USE control_mod
 
       IMPLICIT NONE
@@ -62,9 +63,8 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
 #include "serre.h"
-#include "com_io_dyn.h"
+!#include "com_io_dyn.h"
 #include "iniprint.h"
 #include "academic.h"
@@ -212,5 +212,5 @@
       itau = 0
 !      iday = day_ini+itau/day_step
-!      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+!      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
 !         IF(time.GT.1.) THEN
 !          time = time-1.
@@ -352,4 +352,5 @@
 c      idissip=1
       IF( purmats ) THEN
+      ! Purely Matsuno time stepping
          IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
          IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
@@ -357,4 +358,5 @@
      s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
       ELSE
+      ! Leapfrog/Matsuno time stepping 
          IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
          IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
@@ -362,8 +364,14 @@
       END IF
 
+! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
+!          supress dissipation step
+      if (llm.eq.1) then
+        apdiss=.false.
+      endif
+
 cym    ---> Pour le moment      
 cym      apphys = .FALSE.
       statcl = .FALSE.
-      conser = .FALSE.
+      conser = .FALSE. ! ie: no output of control variables to stdout in //
       
       if (firstCaldyn) then
@@ -677,6 +685,8 @@
          call suspend_timer(timer_caldyn)
 
+        if (prt_level >= 10) then
          write(lunout,*)
      &   'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
+        endif
 c$OMP END MASTER
 
@@ -964,6 +974,10 @@
        ijb=ij_begin
        ije=ij_end
-       teta(ijb:ije,:)=teta(ijb:ije,:)
-     s  -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+       do l=1,llm
+       teta(ijb:ije,l)=teta(ijb:ije,l)
+     &  -iphysiq*dtvr*(teta(ijb:ije,l)-tetarappel(ijb:ije,l))/taurappel
+       enddo
+!$OMP END DO
 
        call Register_Hallo(ucov,ip1jmp1,llm,0,1,1,0,Request_Physic)
@@ -972,6 +986,9 @@
 c$OMP BARRIER
        call WaitRequest(Request_Physic)     
-
+c$OMP BARRIER
+!$OMP MASTER
        call friction_p(ucov,vcov,iphysiq*dtvr)
+!$OMP END MASTER
+!$OMP BARRIER
       ENDIF ! of IF(iflag_phys.EQ.2)
 
@@ -1089,5 +1106,5 @@
             enddo
 c$OMP END DO NOWAIT            
-       endif
+       endif ! of if (dissip_conservative)
 
        ijb=ij_begin
@@ -1198,5 +1215,5 @@
 c$OMP END MASTER
 c$OMP BARRIER
-      END IF
+      END IF ! of IF(apdiss)
 
 cc$OMP END PARALLEL
@@ -1280,5 +1297,5 @@
               itau= itau + 1
 !              iday= day_ini+itau/day_step
-!              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+!              time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
 !                IF(time.GT.1.) THEN
 !                  time = time-1.
@@ -1337,5 +1354,27 @@
               ENDIF !ok_dynzon
 #endif
-            ENDIF
+               IF (ok_dyn_ave) THEN
+!$OMP MASTER
+#ifdef CPP_IOIPSL
+! Ehouarn: Gather fields and make master send to output
+                call Gather_Field(vcov,ip1jm,llm,0)
+                call Gather_Field(ucov,ip1jmp1,llm,0)
+                call Gather_Field(teta,ip1jmp1,llm,0)
+                call Gather_Field(pk,ip1jmp1,llm,0)
+		call Gather_Field(phi,ip1jmp1,llm,0)
+                do iq=1,nqtot
+                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
+                enddo
+		call Gather_Field(masse,ip1jmp1,llm,0)
+                call Gather_Field(ps,ip1jmp1,1,0)
+		call Gather_Field(phis,ip1jmp1,1,0)
+                if (mpi_rank==0) then
+                 CALL writedynav(itau,vcov,
+     &                 ucov,teta,pk,phi,q,masse,ps,phis)
+		endif
+#endif
+!$OMP END MASTER
+               ENDIF ! of IF (ok_dyn_ave)
+            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
 
 c-----------------------------------------------------------------------
@@ -1343,7 +1382,7 @@
 c   ------------------------------
 
-c      IF( MOD(itau,iecri         ).EQ.0) THEN
-
-            IF( MOD(itau,iecri*day_step).EQ.0) THEN
+            IF( MOD(itau,iecri).EQ.0) THEN
+             ! Ehouarn: output only during LF or Backward Matsuno
+	     if (leapf.or.(.not.leapf.and.(.not.forward))) then
 c$OMP BARRIER
 c$OMP MASTER
@@ -1379,8 +1418,27 @@
         
 #ifdef CPP_IOIPSL
- 
+              if (ok_dyn_ins) then
+! Ehouarn: Gather fields and make master write to output
+                call Gather_Field(vcov,ip1jm,llm,0)
+                call Gather_Field(ucov,ip1jmp1,llm,0)
+                call Gather_Field(teta,ip1jmp1,llm,0)
+		call Gather_Field(phi,ip1jmp1,llm,0)
+                do iq=1,nqtot
+                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
+                enddo
+		call Gather_Field(masse,ip1jmp1,llm,0)
+                call Gather_Field(ps,ip1jmp1,1,0)
+		call Gather_Field(phis,ip1jmp1,1,0)
+                if (mpi_rank==0) then
+	         CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
+		endif
 !              CALL writehist_p(histid,histvid, itau,vcov, 
 !     &                         ucov,teta,phi,q,masse,ps,phis)
-
+! or use writefield_p
+!      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
+!      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
+!      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
+!      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
+              endif ! of if (ok_dyn_ins)
 #endif
 ! For some Grads outputs of fields
@@ -1399,4 +1457,5 @@
               endif ! of if (output_grads_dyn)
 c$OMP END MASTER
+             endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
             ENDIF ! of IF(MOD(itau,iecri).EQ.0)
 
@@ -1458,5 +1517,5 @@
              itau =  itau + 1
 !             iday = day_ini+itau/day_step
-!             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
+!             time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
 !
 !                  IF(time.GT.1.) THEN
@@ -1477,5 +1536,5 @@
                GO TO 2
 
-            ELSE ! of IF(forward)
+            ELSE ! of IF(forward) i.e. backward step
 
               IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
@@ -1488,10 +1547,8 @@
                IF (ok_dynzon) THEN
 c$OMP BARRIER
-
                call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
                call SendRequest(TestRequest)
 c$OMP BARRIER
                call WaitRequest(TestRequest)
-
 c$OMP BARRIER
 c$OMP MASTER
@@ -1503,9 +1560,32 @@
                END IF !ok_dynzon
 #endif
+               IF (ok_dyn_ave) THEN
+!$OMP MASTER
+#ifdef CPP_IOIPSL
+! Ehouarn: Gather fields and make master send to output
+                call Gather_Field(vcov,ip1jm,llm,0)
+                call Gather_Field(ucov,ip1jmp1,llm,0)
+                call Gather_Field(teta,ip1jmp1,llm,0)
+                call Gather_Field(pk,ip1jmp1,llm,0)
+		call Gather_Field(phi,ip1jmp1,llm,0)
+                do iq=1,nqtot
+                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
+                enddo
+		call Gather_Field(masse,ip1jmp1,llm,0)
+                call Gather_Field(ps,ip1jmp1,1,0)
+		call Gather_Field(phis,ip1jmp1,1,0)
+                if (mpi_rank==0) then
+                 CALL writedynav(itau,vcov,
+     &                 ucov,teta,pk,phi,q,masse,ps,phis)
+		endif
+#endif
+!$OMP END MASTER
+               ENDIF ! of IF (ok_dyn_ave)
+
               ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
 
 
-c               IF(MOD(itau,iecri         ).EQ.0) THEN
-              IF(MOD(itau,iecri*day_step).EQ.0) THEN
+               IF(MOD(itau,iecri         ).EQ.0) THEN
+c              IF(MOD(itau,iecri*day_step).EQ.0) THEN
 c$OMP BARRIER
 c$OMP MASTER
@@ -1540,7 +1620,22 @@
 
 #ifdef CPP_IOIPSL
-
+              if (ok_dyn_ins) then
+! Ehouarn: Gather fields and make master send to output
+                call Gather_Field(vcov,ip1jm,llm,0)
+                call Gather_Field(ucov,ip1jmp1,llm,0)
+                call Gather_Field(teta,ip1jmp1,llm,0)
+		call Gather_Field(phi,ip1jmp1,llm,0)
+                do iq=1,nqtot
+                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
+                enddo
+		call Gather_Field(masse,ip1jmp1,llm,0)
+                call Gather_Field(ps,ip1jmp1,1,0)
+		call Gather_Field(phis,ip1jmp1,1,0)
+                if (mpi_rank==0) then
+                 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
+		endif
 !                CALL writehist_p(histid, histvid, itau,vcov , 
 !     &                           ucov,teta,phi,q,masse,ps,phis)
+              endif ! of if (ok_dyn_ins)
 #endif
 ! For some Grads output (but does it work?)
@@ -1560,5 +1655,5 @@
 
 c$OMP END MASTER
-              ENDIF ! of IF(MOD(itau,iecri*day_step).EQ.0)
+              ENDIF ! of IF(MOD(itau,iecri).EQ.0)
 
               IF(itau.EQ.itaufin) THEN
Index: /LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90	(revision 1403)
@@ -30,4 +30,5 @@
   USE inter_barxy_m, only: inter_barxy
 #endif
+  USE control_mod
   IMPLICIT NONE
 !-------------------------------------------------------------------------------
@@ -45,5 +46,4 @@
 !-------------------------------------------------------------------------------
 ! Local variables:
-#include "control.h"
 #include "logic.h"
 #include "comvert.h"
@@ -293,9 +293,9 @@
   USE dimphy, ONLY : klon
   USE phys_state_var_mod, ONLY : pctsrf
+  USE control_mod
   IMPLICIT NONE
 #include "dimensions.h"
 #include "paramet.h"
 #include "comgeom2.h"
-#include "control.h"
 #include "indicesol.h"
 #include "iniprint.h"
Index: DZ4/trunk/libf/dyn3dpar/ord_coord.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ord_coord.F	(revision 1402)
+++ 	(revision )
@@ -1,95 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE ord_coord ( nmax, xi, xo, decrois )
-
-c   .... Auteur :  P. Le Van  .... 
-c
-c   ... Reordonne eventuellement les coordonnees de la grille donnees ...
-c
-       IMPLICIT NONE
-
-c    .....  Arguments  en entree  .....
-
-       INTEGER nmax
-       REAL xi(nmax)
-
-c    .....  Arguments  en sortie  .....
-c
-       REAL xo(nmax+1) 
-       LOGICAL decrois
-
-c    .... Variables  locales  ....
-
-       REAL xscr(nmax)
-       INTEGER i,ii
-       REAL pi, degres, chmin, chmax, mult
-c
-
-       pi     = 2.*ASIN(1.)
-       degres = 180./pi
-       decrois = .FALSE.
-
-       DO i = 1, nmax 
-        xo(i) = xi(i)
-       ENDDO
-     
-       mult = 1.
-       IF( xo(1).GT.xo(nmax) ) mult = -1.
-
-       CALL minmax(nmax,xo(1),chmin,chmax)
-
-       IF(chmax.LT.6.5 )  THEN
-          DO i = 1,nmax
-           xo(i) = xo(i) * degres 
-          ENDDO
-       ENDIF
-
-       IF( ABS( xo( 1  ) + mult* 90. ). LT .0.001. OR .
-     ,     ABS( xo(nmax) - mult* 90. ). LT .0.001      )  THEN
-        PRINT *,' Reverifier les valeurs de  xidat  pour les donnees .'
-        PRINT *,' Elles doivent correspondre aux interfaces et non aux',
-     , 'ordonnees des donnees,egales a -90. et 90.deg aux 2 extremites '
-         CALL ABORT
-       ENDIF
-
-       IF( xo(1).GT.xo(nmax) )   THEN
-          DO i = 1, nmax 
-            xscr(i) = xo(i)
-          ENDDO
-          DO i = 1, nmax 
-            xo(i+1) = xscr(i)
-          ENDDO
-            xo (   1    ) =   90.
-       ELSE
-            xo ( nmax +1) =   90.
-       ENDIF
-
-       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
-
-       DO i = 3, nmax 
-
-        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
-         PRINT 1
-         PRINT 2,(xo(ii),ii=1,nmax)
-         CALL ABORT 
-        ENDIF
-        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
-         PRINT 1
-         PRINT 2,(xo(ii),ii=1,nmax)
-         CALL ABORT
-        ENDIF
-
-       ENDDO
-        
-       IF( decrois )  THEN
-c         CALL sort(nmax+1,xo(1))
-        CALL sort(nmax+1,xo)
-       ENDIF
-
-1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
-     ,  'grille du modele ')
-2      FORMAT(1x,8f8.2)
-
-       RETURN
-       END
Index: DZ4/trunk/libf/dyn3dpar/ord_coordm.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ord_coordm.F	(revision 1402)
+++ 	(revision )
@@ -1,110 +1,0 @@
-!
-! $Header$
-!
-       SUBROUTINE ord_coordm ( nmax, xi, xo, jjm, jmods, decrois )
-
-c   ....  Auteur :  P. Le Van  .... 
-
-c   ... Reordonne eventuellement les coordonnees de la grille modele ...
-c
-       IMPLICIT NONE
-
-c    .....  Arguments  en entree  .....
-
-       INTEGER nmax,jjm
-       REAL xi(nmax)
-
-c    .....  Arguments  en sortie  .....
-c
-       REAL xo(nmax+1) 
-       LOGICAL decrois
-       INTEGER jmods
-
-c    .... Variables  locales  ....
-
-       REAL xscr(nmax)
-       INTEGER i
-       REAL pi, degres, chmin, chmax,mult
-c
-       DO i = 1, nmax 
-        xo(i) = xi(i)
-       ENDDO
-
-       mult = 1.
-       IF( xo(1).GT.xo(nmax) )  mult = - 1.
-       IF( nmax.EQ.jjm    ) jmods = nmax +1
-       IF( nmax.EQ.jjm +1 ) jmods = nmax -1 
-     
-       pi     = 2.*ASIN(1.)
-       degres = 180./pi
-       decrois = .FALSE.
-
-       CALL minmax(nmax,xo(1),chmin,chmax)
-
-       IF(chmax.LT.6.5 )  THEN
-          DO i = 1,nmax
-           xo(i) = xo(i) * degres 
-          ENDDO
-       ENDIF
-
-       IF( nmax.EQ.jjm )   THEN
-         IF( xo(1).GT.xo(nmax) )   THEN
-           DO i = 1, nmax 
-            xscr(i) = xo(i)
-           ENDDO
-           DO i = 1, nmax 
-            xo(i+1) = xscr(i)
-           ENDDO
-            xo (   1    ) =   90.
-         ELSE
-            xo ( nmax+1 ) =   90.
-         ENDIF
-       ELSE
-          IF( nmax.NE.jjm +1 )   THEN
-             PRINT *,'  Dans la routine ord_coordm , l argument nmax '
-             PRINT *,'  n est pas egal a jjm ni a jjm +1 . Corriger !'
-             CALL ABORT
-          ELSE
-            IF( ABS( xo(1)+ mult * 90.).GT.0.01 )  THEN
-              PRINT *,' Avec nmax =',nmax,'on devrait avoir des',
-     ,    ' ordonnees = 90. deg pour j=1 ou jjm+1 ! '
-             CALL ABORT
-            ELSE
-               IF( xo(1).LT.xo(nmax) )  THEN
-                 DO i = 1, nmax
-                  xscr(i) = xo(i)
-                 ENDDO
-                 DO i = 1, nmax -1
-                  xo(i) = xscr(i+1)
-                 ENDDO
-               ENDIF
-            ENDIF
-          ENDIF
-       ENDIF
-
-       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
-
-       DO i = 3, nmax 
-
-        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
-         PRINT 1
-         CALL ABORT 
-        ENDIF
-        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
-         PRINT 1
-         CALL ABORT
-        ENDIF
-
-       ENDDO
-        
-       IF( decrois )  THEN
-         CALL sort(jmods,xo(1))
-       ENDIF
-
-
-1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
-     ,  'grille du modele ')
-2      FORMAT(1x,8f8.2)
-
-       RETURN
-       END
Index: /LMDZ4/trunk/libf/dyn3dpar/ppm3d.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ppm3d.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/ppm3d.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 
@@ -345,6 +345,6 @@
 C
       PI = 4. * ATAN(1.)
-      DL = 2.*PI / float(IMR)
-      DP =    PI / float(JMR)
+      DL = 2.*PI / REAL(IMR)
+      DP =    PI / REAL(JMR)
 C
       if(IGD.eq.0) then
@@ -388,5 +388,5 @@
       ZTC  = acos(CR1) * (180./PI)
 C
-      JS0 = float(JMR)*(90.-ZTC)/180. + 2
+      JS0 = REAL(JMR)*(90.-ZTC)/180. + 2
       JS0 = max(JS0, J1+1)
       IML = min(6*JS0/(J1-1)+2, 4*IMR/5)
@@ -628,5 +628,5 @@
 C Contribution from the N-S advection
       do i=1,imr*(j2-j1+1)
-      JT = float(J1) - VA(i,j1)
+      JT = REAL(J1) - VA(i,j1)
       wk1(i,j1,2) = VA(i,j1) * (q(i,jt,k,IC) - q(i,jt+1,k,IC))
       enddo
@@ -949,5 +949,5 @@
       IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
       DO 1406 i=1,IMR
-      iu = float(i) - uc(i,j)
+      iu = REAL(i) - uc(i,j)
 1406  fx1(i) = qtmp(iu)
       ELSE
@@ -957,5 +957,5 @@
       if(IORD.eq.2 .or. j.le.j1vl .or. j.ge.j2vl) then
       DO 1408 i=1,IMR
-      iu = float(i) - uc(i,j)
+      iu = REAL(i) - uc(i,j)
 1408  fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j))
       else
@@ -1111,5 +1111,5 @@
       if(JORD.eq.1) then
       DO 1000 i=1,len
-      JT = float(J1) - VC(i,J1)
+      JT = REAL(J1) - VC(i,J1)
 1000  fx(i,j1) = p(i,JT)
       else
@@ -1123,5 +1123,5 @@
       else
       DO 1200 i=1,len
-      JT = float(J1) - VC(i,J1)
+      JT = REAL(J1) - VC(i,J1)
 1200  fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
       endif
@@ -1358,5 +1358,5 @@
 	do j=j1-1,j2+1
       do i=1,imr
-      JP = float(j)-VA(i,j)
+      JP = REAL(j)-VA(i,j)
       ady(i,j) = VA(i,j)*(wk(i,jp)-wk(i,jp+1))
       enddo
@@ -1582,5 +1582,5 @@
       JMR = JNP-1
       do 55 j=2,JNP
-        ph5  =  -0.5*PI + (FLOAT(J-1)-0.5)*DP
+        ph5  =  -0.5*PI + (REAL(J-1)-0.5)*DP
 55      cose(j) = cos(ph5)
 C
@@ -1834,5 +1834,5 @@
 C
 c      if(first) then
-      DP = 4.*ATAN(1.)/float(JNP-1)
+      DP = 4.*ATAN(1.)/REAL(JNP-1)
       CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
 c      first = .false.
@@ -1889,5 +1889,5 @@
 C Check Poles.
       if(q(1,1).lt.0.) then
-      dq = q(1,1)*cap1/float(IMR)*acosp(j1)
+      dq = q(1,1)*cap1/REAL(IMR)*acosp(j1)
       do i=1,imr
       q(i,1) = 0.
@@ -1898,5 +1898,5 @@
 C
       if(q(1,JNP).lt.0.) then
-      dq = q(1,JNP)*cap1/float(IMR)*acosp(j2)
+      dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2)
       do i=1,imr
       q(i,JNP) = 0.
Index: /LMDZ4/trunk/libf/dyn3dpar/ran1.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ran1.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/ran1.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       FUNCTION RAN1(IDUM)
@@ -20,5 +20,5 @@
           IX1=MOD(IA1*IX1+IC1,M1)
           IX2=MOD(IA2*IX2+IC2,M2)
-          R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+          R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
 11      CONTINUE
         IDUM=1
@@ -30,5 +30,5 @@
       IF(J.GT.97.OR.J.LT.1)PAUSE
       RAN1=R(J)
-      R(J)=(FLOAT(IX1)+FLOAT(IX2)*RM2)*RM1
+      R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1
       RETURN
       END
Index: /LMDZ4/trunk/libf/dyn3dpar/sortvarc.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/sortvarc.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/sortvarc.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE sortvarc
@@ -59,5 +59,5 @@
 
        dtvrs1j   = dtvr/daysec
-       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       rjour     = REAL( INT( itau * dtvrs1j ))
        heure     = ( itau*dtvrs1j-rjour ) * 24.
        imjmp1    = iim * jjp1
@@ -129,7 +129,7 @@
       ang   = SSUM(     llm,  angl, 1 )
 
-c      rday = FLOAT(INT ( day_ini + time ))
+c      rday = REAL(INT ( day_ini + time ))
 c
-       rday = FLOAT(INT(time-jD_ref-jH_ref))
+       rday = REAL(INT(time-jD_ref-jH_ref))
       IF(ptot0.eq.0.)  THEN
          PRINT 3500, itau, rday, heure,time
Index: /LMDZ4/trunk/libf/dyn3dpar/sortvarc0.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/sortvarc0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/sortvarc0.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE sortvarc0
@@ -60,5 +60,5 @@
 
        dtvrs1j   = dtvr/daysec
-       rjour     = FLOAT( INT( itau * dtvrs1j ))
+       rjour     = REAL( INT( itau * dtvrs1j ))
        heure     = ( itau*dtvrs1j-rjour ) * 24.
        imjmp1    = iim * jjp1
@@ -130,5 +130,5 @@
       ang0   = SSUM(     llm,  angl, 1 )
 
-      rday = FLOAT(INT (time ))
+      rday = REAL(INT (time ))
 c
       PRINT 3500, itau, rday, heure, time
Index: /LMDZ4/trunk/libf/dyn3dpar/sw_case_williamson91_6.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/sw_case_williamson91_6.F	(revision 1403)
+++ /LMDZ4/trunk/libf/dyn3dpar/sw_case_williamson91_6.F	(revision 1403)
@@ -0,0 +1,140 @@
+!
+! $Id $
+!
+      SUBROUTINE sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+
+c=======================================================================
+c
+c   Author:    Thomas Dubos      original: 26/01/2010
+c   -------
+c
+c   Subject:
+c   ------
+c   Realise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz
+c
+c   Method:
+c   --------
+c
+c   Interface:
+c   ----------
+c
+c      Input:
+c      ------
+c
+c      Output:
+c      -------
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "iniprint.h"
+
+c   Arguments:
+c   ----------
+
+c   variables dynamiques
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL masse(ip1jmp1,llm)                ! masse d'air
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+
+c   Local:
+c   ------
+
+      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
+      REAL pks(ip1jmp1)                      ! exner au  sol
+      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
+      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
+      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
+
+      REAL :: sinth,costh,costh2, Ath,Bth,Cth, lon,dps
+      INTEGER i,j,ij
+
+      REAL, PARAMETER    :: rho=1 ! masse volumique de l'air (arbitraire)
+      REAL, PARAMETER    :: K    = 7.848e-6  ! K = \omega
+      REAL, PARAMETER    :: gh0  = 9.80616 * 8e3 
+      INTEGER, PARAMETER :: R0=4, R1=R0+1, R2=R0+2         ! mode 4
+c NB : rad = 6371220 dans W91 (6371229 dans LMDZ)
+c      omeg = 7.292e-5 dans W91 (7.2722e-5 dans LMDZ)
+ 
+      IF(0==0) THEN
+c Williamson et al. (1991) : onde de Rossby-Haurwitz
+         teta = preff/rho/cpp
+c geopotentiel (pression de surface)
+         do j=1,jjp1
+            costh2 = cos(rlatu(j))**2
+            Ath = (R0+1)*(costh2**2) + (2*R0*R0-R0-2)*costh2 - 2*R0*R0
+            Ath = .25*(K**2)*(costh2**(R0-1))*Ath
+            Ath = .5*K*(2*omeg+K)*costh2 + Ath 
+            Bth = (R1*R1+1)-R1*R1*costh2
+            Bth = 2*(omeg+K)*K/(R1*R2) * (costh2**(R0/2))*Bth
+            Cth = R1*costh2 - R2
+            Cth = .25*K*K*(costh2**R0)*Cth
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonv(i)
+               dps = Ath + Bth*cos(R0*lon) + Cth*cos(2*R0*lon)
+               ps(ij) = rho*(gh0 + (rad**2)*dps)
+            enddo
+         enddo
+         write(lunout,*) 'W91 ps', MAXVAL(ps), MINVAL(ps)
+c vitesse zonale ucov
+         do j=1,jjp1
+            costh  = cos(rlatu(j))
+            costh2 = costh**2
+            Ath = rad*K*costh
+            Bth = R0*(1-costh2)-costh2
+            Bth = rad*K*Bth*(costh**(R0-1))
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonu(i)
+               ucov(ij,1) = (Ath + Bth*cos(R0*lon))
+            enddo
+         enddo
+         write(lunout,*) 'W91 u', MAXVAL(ucov(:,1)), MINVAL(ucov(:,1))
+         ucov(:,1)=ucov(:,1)*cu
+c vitesse meridienne vcov
+         do j=1,jjm
+            sinth  = sin(rlatv(j))
+            costh  = cos(rlatv(j))
+            Ath = -rad*K*R0*sinth*(costh**(R0-1))
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               lon = rlonv(i)
+               vcov(ij,1) = Ath*sin(R0*lon)
+            enddo
+         enddo
+         write(lunout,*) 'W91 v', MAXVAL(vcov(:,1)), MINVAL(vcov(:,1))
+         vcov(:,1)=vcov(:,1)*cv
+         
+c         ucov=0
+c         vcov=0
+      ELSE
+c test non-tournant, onde se propageant en latitude
+         do j=1,jjp1
+            do i=1,iip1
+               ij=(j-1)*iip1+i
+               ps(ij) = 1e5*(1 + .1*exp(-100*(1+sin(rlatu(j)))**2) )
+            enddo
+         enddo
+         
+c     rho = preff/(cpp*teta)
+         teta = .01*preff/cpp   ! rho = 100 ; phi = ps/rho = 1e3 ; c=30 m/s = 2600 km/j = 23 degres / j
+         ucov=0.
+         vcov=0.
+      END IF      
+      
+      CALL pression ( ip1jmp1, ap, bp, ps, p       )
+      CALL massdair(p,masse)
+
+      END
+c-----------------------------------------------------------------------
Index: /LMDZ4/trunk/libf/dyn3dpar/tourabs.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/tourabs.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/tourabs.F	(revision 1403)
@@ -57,7 +57,7 @@
         ELSE
          rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/
-     $                 (2.*pi*RAD*cos(rlatv(j)))*float(iim)
+     $                 (2.*pi*RAD*cos(rlatv(j)))*REAL(iim)
      $                +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/
-     $                 (pi*RAD)*(float(jjm)-1.)
+     $                 (pi*RAD)*(REAL(jjm)-1.)
 c
         ENDIF
Index: /LMDZ4/trunk/libf/dyn3dpar/traceurpole.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/traceurpole.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/traceurpole.F	(revision 1403)
@@ -1,6 +1,8 @@
 !
-! $Header$
+! $Id$
 !
           subroutine traceurpole(q,masse)
+
+      USE control_mod
 
           implicit none
@@ -15,5 +17,4 @@
 #include "logic.h"
 #include "temps.h"
-#include "control.h"
 #include "ener.h"
 #include "description.h"
Index: /LMDZ4/trunk/libf/dyn3dpar/ugeostr.F
===================================================================
--- /LMDZ4/trunk/libf/dyn3dpar/ugeostr.F	(revision 1402)
+++ /LMDZ4/trunk/libf/dyn3dpar/ugeostr.F	(revision 1403)
@@ -40,5 +40,5 @@
             DO i=1,iim
                u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-               um(j,l)=um(j,l)+u(i,j,l)/float(iim)
+               um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
             ENDDO
          ENDDO
Index: /LMDZ4/trunk/libf/filtrez/mod_fft_fftw.F90
===================================================================
--- /LMDZ4/trunk/libf/filtrez/mod_fft_fftw.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/filtrez/mod_fft_fftw.F90	(revision 1403)
@@ -1,39 +1,84 @@
+!
+! $Id$
+!
+
 MODULE mod_fft_fftw
 
 #ifdef FFT_FFTW
 
-  REAL,SAVE,ALLOCATABLE    :: Table_forward(:)
-  REAL,SAVE,ALLOCATABLE    :: Table_backward(:)
-  REAL,SAVE                :: scale_factor
-  INTEGER,SAVE             :: vsize
-  INTEGER,PARAMETER        :: inc=1
+  REAL, SAVE                   :: scale_factor
+  INTEGER, SAVE                :: vsize
+  INTEGER, PARAMETER           :: inc=1
   
-  INTEGER,SAVE             :: plan_forward
-  INTEGER,SAVE             :: plan_backward
+  INTEGER*8, ALLOCATABLE, DIMENSION(:), SAVE :: plan_forward
+  INTEGER*8, ALLOCATABLE, DIMENSION(:), SAVE :: plan_backward
   
 CONTAINS
   
-  SUBROUTINE Init_fft(iim)
+  SUBROUTINE Init_fft(iim,nvectmax)
   IMPLICIT NONE
-#include <rfftw.h>
+#include <fftw3.f>
     INTEGER :: iim
-    REAL    :: rtmp=1.
-    COMPLEX*16 :: ctmp
-    INTEGER :: itmp=1
-    INTEGER :: isign=0
-    INTEGER :: ierr
+    INTEGER :: nvectmax
+
+    INTEGER :: itmp
+
+    INTEGER               :: rank
+    INTEGER               :: howmany
+    INTEGER               :: istride, idist
+    INTEGER               :: ostride, odist
+    INTEGER, DIMENSION(1) :: n_array, inembed, onembed
+
+    REAL,    DIMENSION(iim+1,nvectmax) :: dbidon
+    COMPLEX, DIMENSION(iim/2+1,nvectmax) :: cbidon
+
+    vsize = iim
+    scale_factor = 1./SQRT(1.*vsize)
+
+    dbidon = 0
+    cbidon = 0
+
+    ALLOCATE(plan_forward(nvectmax))
+    ALLOCATE(plan_backward(nvectmax))
     
-    vsize=iim
-    scale_factor=1./SQRT(1.*vsize)
-    ALLOCATE(Table_forward(2*vsize+64))
-    ALLOCATE(Table_backward(2*vsize+64))
+    WRITE(*,*)"!---------------------!"
+    WRITE(*,*)"!                     !"
+    WRITE(*,*)"! INITIALISATION FFTW !"
+    WRITE(*,*)"!                     !"
+    WRITE(*,*)"!---------------------!"
     
-!    CALL DZFFTM(isign,vsize,itmp,scale_factor,rtmp,vsize+inc,ctmp,vsize/2+1,table_forward,rtmp,ierr)
-    
-!    CALL ZDFFTM(isign,vsize,itmp,scale_factor,ctmp,vsize/2+1,rtmp,vsize+inc,table_backward,rtmp,ierr)
+! On initialise tous les plans 
+    DO itmp = 1, nvectmax
+       rank       = 1
+       n_array(1) = iim
+       howmany    = itmp
+       inembed(1) = iim + 1 ; onembed(1) = iim/2 + 1
+       istride    = 1       ; ostride    = 1
+       idist      = iim + 1 ; odist      = iim/2 + 1
 
-    CALL rfftw_f77_create_plan(plan_forward,iim,FFTW_REAL_TO_COMPLEX,FFTW_ESTIMATE)
-    CALL rfftw_f77_create_plan(plan_backward,iim,FFTW_COMPLEX_TO_REAL,FFTW_ESTIMATE)
-    
+       CALL dfftw_plan_many_dft_r2c(plan_forward(itmp), rank, n_array, howmany, &
+            & dbidon, inembed, istride, idist, &
+            & cbidon, onembed, ostride, odist, &
+            & FFTW_ESTIMATE)
+
+       rank       = 1
+       n_array(1) = iim
+       howmany    = itmp
+       inembed(1) = iim/2 + 1 ; onembed(1) = iim + 1
+       istride    = 1         ; ostride    = 1
+       idist      = iim/2 + 1 ; odist      = iim + 1
+       CALL dfftw_plan_many_dft_c2r(plan_backward(itmp), rank, n_array, howmany, &
+            & cbidon, inembed, istride, idist, &
+            & dbidon, onembed, ostride, odist, &
+            & FFTW_ESTIMATE)
+
+    ENDDO
+
+    WRITE(*,*)"!-------------------------!"
+    WRITE(*,*)"!                         !"
+    WRITE(*,*)"! FIN INITIALISATION FFTW !"
+    WRITE(*,*)"!                         !"
+    WRITE(*,*)"!-------------------------!"
+
   END SUBROUTINE Init_fft
   
@@ -41,29 +86,25 @@
   SUBROUTINE fft_forward(vect,TF_vect,nb_vect)
     IMPLICIT NONE
-#include <rfftw.h>
-    INTEGER,INTENT(IN)  :: nb_vect
-    REAL,INTENT(IN)     :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(OUT) :: TF_vect(vsize/2+1,nb_vect)
-    REAL                :: work(4*vsize*nb_vect)
-    INTEGER             :: ierr
-    INTEGER, PARAMETER :: isign=-1
-  
-!    CALL DZFFTM(isign,vsize,nb_vect,scale_factor,vect,vsize+inc,TF_vect,vsize/2+1,table_forward,work,ierr)
-     CALL rfftwnd_f77_real_to_complex(plan_forward,nb_vect,vect, 1, vsize+inc , TF_vect, 1, vsize/2+1);  
-    
+#include <fftw3.f>
+    INTEGER,INTENT(IN)     :: nb_vect
+    REAL,INTENT(IN)        :: vect(vsize+inc,nb_vect)
+    COMPLEX,INTENT(OUT) :: TF_vect(vsize/2+1,nb_vect)
+
+    CALL dfftw_execute_dft_r2c(plan_forward(nb_vect),vect,TF_vect)
+
+    TF_vect = scale_factor * TF_vect
+
   END SUBROUTINE fft_forward
   
   SUBROUTINE fft_backward(TF_vect,vect,nb_vect)
     IMPLICIT NONE
-#include <rfftw.h>
-    INTEGER,INTENT(IN)  :: nb_vect
-    REAL,INTENT(OUT)    :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
-    REAL                :: work(4*vsize*nb_vect)
-    INTEGER             :: ierr
-    INTEGER, PARAMETER :: isign=1
-  
-!    CALL ZDFFTM(isign,vsize,nb_vect,scale_factor,TF_vect,vsize/2+1,vect,vsize+inc,table_backward,work,ierr)
-    CALL rfftwnd_f77_complex_to_real(plan_forward,nb_vect,TF_vect, 1, vsize/2+1 , vect, 1, vsize+inc);  
+#include <fftw3.f>
+    INTEGER,INTENT(IN)     :: nb_vect
+    REAL,INTENT(OUT)       :: vect(vsize+inc,nb_vect)
+    COMPLEX,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
+
+    CALL dfftw_execute_dft_c2r(plan_backward(nb_vect),TF_vect,vect)
+
+    vect = scale_factor * vect
 
   END SUBROUTINE fft_backward
@@ -72,3 +113,2 @@
   
 END MODULE mod_fft_fftw
-
Index: /LMDZ4/trunk/libf/filtrez/mod_fft_mathkeisan.F90
===================================================================
--- /LMDZ4/trunk/libf/filtrez/mod_fft_mathkeisan.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/filtrez/mod_fft_mathkeisan.F90	(revision 1403)
@@ -15,5 +15,5 @@
     INTEGER :: nb_vect_max
     REAL    :: rtmp=1.
-    COMPLEX*16 :: ctmp
+    COMPLEX :: ctmp
     INTEGER :: itmp=1
     INTEGER :: isign=0
@@ -37,5 +37,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(IN)     :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(OUT) :: TF_vect(vsize/2+1,nb_vect)
+    COMPLEX,INTENT(OUT) :: TF_vect(vsize/2+1,nb_vect)
     REAL                :: work(4*vsize*nb_vect)
     INTEGER             :: ierr
@@ -51,5 +51,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(OUT)    :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
+    COMPLEX,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
     REAL                :: work(4*vsize*nb_vect)
     INTEGER             :: ierr
Index: /LMDZ4/trunk/libf/filtrez/mod_fft_mkl.F90
===================================================================
--- /LMDZ4/trunk/libf/filtrez/mod_fft_mkl.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/filtrez/mod_fft_mkl.F90	(revision 1403)
@@ -24,5 +24,5 @@
     INTEGER :: nb_vect_max
     REAL    :: rtmp=1.
-    COMPLEX*16 :: ctmp
+    COMPLEX :: ctmp
     INTEGER :: itmp=1
     INTEGER :: isign=0
@@ -60,5 +60,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(IN)     :: vect((vsize+inc)*nb_vect)
-    COMPLEX*16,INTENT(OUT) :: TF_vect((vsize/2+1)*nb_vect)
+    COMPLEX,INTENT(OUT) :: TF_vect((vsize/2+1)*nb_vect)
     REAL                :: work(4*vsize*nb_vect)
     INTEGER             :: ierr
@@ -102,5 +102,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(OUT)    :: vect((vsize+inc)*nb_vect)
-    COMPLEX*16,INTENT(IN ) :: TF_vect((vsize/2+1)*nb_vect)
+    COMPLEX,INTENT(IN ) :: TF_vect((vsize/2+1)*nb_vect)
     REAL                :: work(4*vsize*nb_vect)
     INTEGER             :: ierr
Index: /LMDZ4/trunk/libf/filtrez/mod_fft_wrapper.F90
===================================================================
--- /LMDZ4/trunk/libf/filtrez/mod_fft_wrapper.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/filtrez/mod_fft_wrapper.F90	(revision 1403)
@@ -19,5 +19,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(IN)     :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(INOUT) :: TF_vect(vsize/2+1,nb_vect)
+    COMPLEX,INTENT(INOUT) :: TF_vect(vsize/2+1,nb_vect)
     
     STOP "wrapper fft : une FFT doit etre specifiee a l'aide d'une clee CPP, sinon utiliser le filtre classique"
@@ -29,5 +29,5 @@
     INTEGER,INTENT(IN)  :: nb_vect
     REAL,INTENT(INOUT)    :: vect(vsize+inc,nb_vect)
-    COMPLEX*16,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
+    COMPLEX,INTENT(IN ) :: TF_vect(vsize/2+1,nb_vect)
   
     STOP "wrapper fft : une FFT doit etre specifiee a l'aide d'une clee CPP, sinon utiliser le filtre classique"
Index: /LMDZ4/trunk/libf/filtrez/mod_filtre_fft.F90
===================================================================
--- /LMDZ4/trunk/libf/filtrez/mod_filtre_fft.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/filtrez/mod_filtre_fft.F90	(revision 1403)
@@ -1,2 +1,6 @@
+!
+! $Id$
+!
+
 MODULE mod_filtre_fft
 
@@ -23,5 +27,6 @@
     INTEGER            :: index_vp(iim)
     INTEGER            :: i,j
-    
+    INTEGER            :: l,ll_nb
+
     index_vp(1)=1
     DO i=1,iim/2
@@ -98,7 +103,13 @@
     ENDDO
     
-    
+#ifdef FFT_FFTW
+
+    WRITE (*,*)"COTH jfiltnu,jfiltsu,jfiltnv,jjm-jfiltsv"
+    WRITE (*,*)jfiltnu,jfiltsu,jfiltnv,jjm-jfiltsv
+    WRITE (*,*)MAX(jfiltnu-2,jjm-jfiltsu,jfiltnv-2,jjm-jfiltsv)+1
+    CALL Init_FFT(iim,(llm+1)*(MAX(jfiltnu-2,jjm-jfiltsu,jfiltnv-2,jjm-jfiltsv)+1))
+#else    
     CALL Init_FFT(iim,(jjm+1)*(llm+1))
-        
+#endif        
     
   END SUBROUTINE Init_filtre_fft
@@ -118,11 +129,8 @@
 
     REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
-!    REAL               :: vect_test(iim+inc,jj_end-jj_begin+1,nbniv)
-    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
-!    COMPLEX*16         :: TF_vect_test(iim/2+1,jj_end-jj_begin+1,nbniv)
+    COMPLEX         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     INTEGER            :: nb_vect
     INTEGER :: i,j,l
     INTEGER :: ll_nb
-!    REAL               :: vect_tmp(iim+inc,jj_end-jj_begin+1,nbniv)
     
     ll_nb=0
@@ -140,15 +148,5 @@
     nb_vect=(jj_end-jj_begin+1)*ll_nb
 
-!    vect_tmp=vect
-
     CALL FFT_forward(vect,TF_vect,nb_vect)
-
-!    CALL FFT_forward(vect,TF_vect_test,nb_vect)
-!      PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
-!      DO j=1,jj_end-jj_begin+1
-!      DO i=1,iim/2+1
-!         PRINT *,"====",i,j,"----->",TF_vect_test(i,j,1)
-!       ENDDO
-!      ENDDO
 
     DO l=1,ll_nb
@@ -159,15 +157,8 @@
       ENDDO
     ENDDO
-       
+  
     CALL FFT_backward(TF_vect,vect,nb_vect)
-!    CALL FFT_backward(TF_vect_test,vect_test,nb_vect)
-          
-!      PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
-!      DO j=1,jj_end-jj_begin+1
-!         DO i=1,iim
-!           PRINT *,"====",i,j,"----->",vect_test(i,j,1)
-!         ENDDO
-!      ENDDO
-
+      
+      
     ll_nb=0
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -199,5 +190,5 @@
 
     REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
-    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
+    COMPLEX            :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     INTEGER            :: nb_vect
     INTEGER :: i,j,l
@@ -260,6 +251,6 @@
     REAL,INTENT(INOUT) :: vect_inout(iim+1,nlat,nbniv)
 
-    REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
-    COMPLEX*16         :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
+     REAL               :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
+    COMPLEX            :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
     INTEGER            :: nb_vect
     INTEGER :: i,j,l
@@ -305,37 +296,4 @@
 
   END SUBROUTINE Filtre_inv_fft  
-  
-  
-!  SUBROUTINE get_ll_index(nbniv,ll_index,ll_nb)
-!  IMPLICIT NONE
-!    INTEGER,INTENT(IN)  :: nbniv
-!    INTEGER,INTENT(OUT) :: ll_index(nbniv)
-!    INTEGER,INTENT(OUT) :: ll_nb
-!
-!    INTEGER :: l,ll_begin, ll_end
-!   INTEGER :: omp_rank,omp_size
-!   INTEGER :: OMP_GET_NUM_THREADS
-!   INTEGER :: omp_chunk
-!   EXTERNAL OMP_GET_NUM_THREADS
-!   INTEGER :: OMP_GET_THREAD_NUM
-!   EXTERNAL OMP_GET_THREAD_NUM
-!
-!   
-!   omp_size=OMP_GET_NUM_THREADS()
-!   omp_rank=OMP_GET_THREAD_NUM()    
-!   omp_chunk=nbniv/omp_size+min(1,MOD(nbniv,omp_size))
-!   
-!   ll_begin=omp_rank*OMP_CHUNK+1
-!   ll_nb=0
-!   DO WHILE (ll_begin<=nbniv)
-!     ll_end=min(ll_begin+OMP_CHUNK-1,nbniv)
-!     DO l=ll_begin,ll_end
-!       ll_nb=ll_nb+1
-!       ll_index(ll_nb)=l
-!     ENDDO
-!     ll_begin=ll_begin+omp_size*OMP_CHUNK
-!   ENDDO
-!  
-!  END SUBROUTINE get_ll_index
    
 END MODULE mod_filtre_fft
Index: /LMDZ4/trunk/libf/grid/fxy_new.h
===================================================================
--- /LMDZ4/trunk/libf/grid/fxy_new.h	(revision 1402)
+++ /LMDZ4/trunk/libf/grid/fxy_new.h	(revision 1403)
@@ -8,13 +8,13 @@
 c....stretching in x...
 c
-        ripx(  ri )= (ri-1.0) *2.*pi/FLOAT(iim) 
+        ripx(  ri )= (ri-1.0) *2.*pi/REAL(iim) 
         fx  (  ri )= ripx(ri) + transx  +
      *         alphax * SIN( ripx(ri)+transx-pxo ) - pi
-        fxprim(ri) = 2.*pi/FLOAT(iim)  *
+        fxprim(ri) = 2.*pi/REAL(iim)  *
      *        ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) )
 
 c....stretching in y...
 c
-        bigy(rj)   = 2.* (FLOAT(jjp1)-rj ) *pi/jjm
+        bigy(rj)   = 2.* (REAL(jjp1)-rj ) *pi/jjm
         fy(rj)     =  ( bigy(rj) + transy  +
      *        alphay * SIN( bigy(rj)+transy-pyo ) ) /2.  - pi/2.
Index: /LMDZ4/trunk/libf/grid/fxy_reg.h
===================================================================
--- /LMDZ4/trunk/libf/grid/fxy_reg.h	(revision 1402)
+++ /LMDZ4/trunk/libf/grid/fxy_reg.h	(revision 1403)
@@ -13,13 +13,13 @@
 c
 c
-      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
-      fyprim( rj ) =    pi/FLOAT(jjm)
+      fy    ( rj ) =    pi/REAL(jjm) * ( 0.5 * REAL(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/REAL(jjm)
 
-c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
 c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
 
-      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
-c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
-      fxprim( ri ) = 2.*pi/FLOAT(iim)
+      fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5*  REAL(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/REAL(iim)
 c
 c
Index: /LMDZ4/trunk/libf/grid/fxy_sin.h
===================================================================
--- /LMDZ4/trunk/libf/grid/fxy_sin.h	(revision 1402)
+++ /LMDZ4/trunk/libf/grid/fxy_sin.h	(revision 1403)
@@ -13,10 +13,10 @@
 c
 c
-      fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+      fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
       fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
 
-      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
-c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
-      fxprim( ri ) = 2.*pi/FLOAT(iim)
+      fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5*  REAL(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/REAL(iim)
 c
 c
Index: /LMDZ4/trunk/libf/grid/fxyprim.h
===================================================================
--- /LMDZ4/trunk/libf/grid/fxyprim.h	(revision 1402)
+++ /LMDZ4/trunk/libf/grid/fxyprim.h	(revision 1403)
@@ -13,13 +13,13 @@
 c
 c
-      fy    ( rj ) =    pi/FLOAT(jjm) * ( 0.5 * FLOAT(jjm) +  1. - rj  )
-      fyprim( rj ) =    pi/FLOAT(jjm)
+      fy    ( rj ) =    pi/REAL(jjm) * ( 0.5 * REAL(jjm) +  1. - rj  )
+      fyprim( rj ) =    pi/REAL(jjm)
 
-c     fy(rj)=ASIN(1.+2.*((1.-rj)/FLOAT(jjm)))
+c     fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm)))
 c     fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj))
 
-      fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5*  FLOAT(iim) - 1. )
-c     fx    ( ri ) = 2.*pi/FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )
-      fxprim( ri ) = 2.*pi/FLOAT(iim)
+      fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5*  REAL(iim) - 1. )
+c     fx    ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) )
+      fxprim( ri ) = 2.*pi/REAL(iim)
 c
 c
Index: /LMDZ4/trunk/libf/phylmd/aaam_bud.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/aaam_bud.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/aaam_bud.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       subroutine aaam_bud (iam,nlon,nlev,rjour,rsec,
@@ -117,10 +117,15 @@
       REAL BLSU(801,401),BLSV(801,401)
       REAL ZLON(801),ZLAT(401)
+
+      CHARACTER (LEN=20) :: modname='aaam_bud'
+      CHARACTER (LEN=80) :: abort_message
+
+
 C
 C  PUT AAM QUANTITIES AT ZERO:
 C
       if(iim+1.gt.801.or.jjm+1.gt.401)then
-      print *,' Pb de dimension dans aaam_bud'
-      stop
+        abort_message = 'Pb de dimension dans aaam_bud'
+        CALL abort_gcm (modname,abort_message,1)
       endif
 
@@ -128,6 +133,6 @@
       hadley=1.e18
       hadday=1.e18*24.*3600.
-      dlat=xpi/float(jjm)
-      dlon=2.*xpi/float(iim) 
+      dlat=xpi/REAL(jjm)
+      dlon=2.*xpi/REAL(iim) 
       
       do iax=1,3
Index: /LMDZ4/trunk/libf/phylmd/aeropt.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/aeropt.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/aeropt.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE aeropt(pplay, paprs, t_seri, msulfate, RHcl,
@@ -39,4 +39,8 @@
       REAL alpha_aer_sulfate(nbre_RH,5)   !--unit m2/g SO4
       REAL alphasulfate      
+
+      CHARACTER (LEN=20) :: modname='aeropt'
+      CHARACTER (LEN=80) :: abort_message
+
 c
 c Proprietes optiques
@@ -85,5 +89,8 @@
         rh=MIN(RHcl(i,k)*100.,RH_MAX)
         RH_num = INT( rh/10. + 1.)
-        IF (rh.LT.0.) STOP 'aeropt: RH < 0 not possible'
+        IF (rh.LT.0.) THEN
+          abort_message = 'aeropt: RH < 0 not possible'
+          CALL abort_gcm (modname,abort_message,1)
+        ENDIF
         IF (rh.gt.85.) RH_num=10
         IF (rh.gt.90.) RH_num=11
Index: /LMDZ4/trunk/libf/phylmd/albedo.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/albedo.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/albedo.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -67,5 +67,5 @@
 c prend en compte l'autre moitie de la journee):
       DO k = 1, npts
-         rmu = aa + bb * COS(FLOAT(k)/FLOAT(npts)*zpi)
+         rmu = aa + bb * COS(REAL(k)/REAL(npts)*zpi)
          rmu = MAX(0.0, rmu)
          fauxo = (1.47-ACOS(rmu))/.15
@@ -110,5 +110,5 @@
 c prend en compte l'autre moitie de la journee):
       DO k = 1, npts
-         rmu = aa + bb * COS(FLOAT(k)/FLOAT(npts)*zpi)
+         rmu = aa + bb * COS(REAL(k)/REAL(npts)*zpi)
          rmu = MAX(0.0, rmu)
 cIM cf. PB      alb = 0.058/(rmu + 0.30)
Index: /LMDZ4/trunk/libf/phylmd/calcul_simulISCCP.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/calcul_simulISCCP.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/calcul_simulISCCP.h	(revision 1403)
@@ -1,4 +1,4 @@
 c
-c $Header$
+c $Id$
 c
 c on appelle le simulateur ISCCP toutes les 3h
@@ -18,5 +18,5 @@
        sunlit(i)=1 
        IF(rmu0(i).EQ.0.) sunlit(i)=0
-       nbsunlit(1,i,n)=FLOAT(sunlit(i))
+       nbsunlit(1,i,n)=REAL(sunlit(i))
       ENDDO
 c
@@ -88,9 +88,11 @@
            print*,'seed=0 i paprs aa seed_re',
      .     i,paprs(i,2),aa,seed_re(i,n)
-           STOP
+           abort_message = ''
+           CALL abort_gcm (modname,abort_message,1)
           ELSE IF(seed(i,n).LT.0) THEN
            print*,'seed < 0, i seed itap paprs',i,
      .     seed(i,n),itap,paprs(i,2)
-           STOP
+           abort_message = ''
+           CALL abort_gcm (modname,abort_message,1)
           ENDIF
 c
Index: /LMDZ4/trunk/libf/phylmd/calltherm.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/calltherm.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/calltherm.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       subroutine calltherm(dtime  &
@@ -8,5 +8,5 @@
      &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
      &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
-     &       zmax0,f0,zw2,fraca)
+     &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl)
 
       USE dimphy
@@ -45,7 +45,12 @@
 !********************************************************
 !     declarations
+      LOGICAL flag_bidouille_stratocu
       real fmc_therm(klon,klev+1),zqasc(klon,klev)
       real zqla(klon,klev)
       real zqta(klon,klev)
+      real ztv(klon,klev)
+      real zpspsk(klon,klev)
+      real ztla(klon,klev)
+      real zthl(klon,klev)
       real wmax_sec(klon)
       real zmax_sec(klon)
@@ -82,4 +87,7 @@
 !      save zentr_therm,zfm_therm
 
+      character (len=20) :: modname='calltherm'
+      character (len=80) :: abort_message
+
       integer i,k
       logical, save :: first=.true.
@@ -136,5 +144,5 @@
          if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
 
-         zdt=dtime/float(nsplit_thermals)
+         zdt=dtime/REAL(nsplit_thermals)
          do isplit=1,nsplit_thermals
 
@@ -172,5 +180,7 @@
      &      ,tau_thermals,3)
           else if (iflag_thermals.eq.11) then
-            stop 'cas non prevu dans calltherm'
+              abort_message = 'cas non prevu dans calltherm'
+              CALL abort_gcm (modname,abort_message,1)
+
 !           CALL thermcell_pluie(klon,klev,zdt  &
 !   &      ,pplay,paprs,pphi,zlev  &
@@ -187,6 +197,6 @@
      &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
      &      ,tau_thermals)
-          else if (iflag_thermals.ge.13) then
-            CALL thermcell_main(itap,klon,klev,zdt  &
+          else if (iflag_thermals==13.or.iflag_thermals==14) then
+            CALL thermcellV0_main(itap,klon,klev,zdt  &
      &      ,pplay,paprs,pphi,debut  &
      &      ,u_seri,v_seri,t_seri,q_seri  &
@@ -197,11 +207,29 @@
      &      ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
      &      ,zmax0,f0,zw2,fraca)
+          else if (iflag_thermals==15.or.iflag_thermals==16) then
+
+!            print*,'THERM iflag_thermas_ed=',iflag_thermals_ed
+            CALL thermcell_main(itap,klon,klev,zdt  &
+     &      ,pplay,paprs,pphi,debut  &
+     &      ,u_seri,v_seri,t_seri,q_seri  &
+     &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
+     &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
+     &      ,ratqscth,ratqsdiff,zqsatth  &
+     &      ,r_aspect_thermals,l_mix_thermals &
+     &      ,tau_thermals,iflag_thermals_ed,Ale,Alp,lalim_conv,wght_th &
+     &      ,zmax0,f0,zw2,fraca,ztv,zpspsk &
+     &      ,ztla,zthl)
+           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
+         else
+           abort_message = 'Cas des thermiques non prevu'
+           CALL abort_gcm (modname,abort_message,1)
          endif
 
+       flag_bidouille_stratocu=iflag_thermals.eq.14.or.iflag_thermals.eq.16
 
       fact(:)=0.
       DO i=1,klon
-       logexpr1(i)=iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5
-       IF(logexpr1(i)) fact(i)=1./float(nsplit_thermals)
+       logexpr1(i)=flag_bidouille_stratocu.or.weak_inversion(i).gt.0.5
+       IF(logexpr1(i)) fact(i)=1./REAL(nsplit_thermals)
       ENDDO
 
@@ -235,11 +263,12 @@
             qmemoire(:,:)=q_seri(:,:)
             q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
+           if (prt_level.gt.10) write(lunout,*)'Apres apres thermcell_main OK'
 
        DO i=1,klon
         if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
             fm_therm(i,klev+1)=0.
-            Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals)
+            Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)
 !            write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
-            Alp_bl(i)=Alp_bl(i)+Alp(i)/float(nsplit_thermals)
+            Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)
 !            write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
        ENDDO
@@ -260,5 +289,4 @@
 !    &         'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k)
                  endif
-!       stop
             ENDDO
             ENDDO
Index: /LMDZ4/trunk/libf/phylmd/calwake.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/calwake.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/calwake.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE CALWAKE(paprs,pplay,dtime
      :             ,t,q,omgb
@@ -189,8 +192,8 @@
      $                ,Cstar,d_deltat_gw
      $                ,d_deltatw,d_deltaqw)
-
-      DO i=1,klon 
-       IF (ktopw(i) .GT. 0) THEN
-         DO l=1,klev
+c
+      DO l=1,klev
+       DO i=1,klon 
+        IF (ktopw(i) .GT. 0) THEN
            wake_deltat(i,l)= dtw(i,l)
            wake_deltaq(i,l)= dqw(i,l)
@@ -212,7 +215,5 @@
            wake_ddeltat(i,l) = d_deltatw(i,l)
            wake_ddeltaq(i,l) = d_deltaqw(i,l)
-         ENDDO
-       ELSE
-         DO l = 1,klev
+        ELSE
            wake_deltat(i,l)= 0.
            wake_deltaq(i,l)= 0.
@@ -222,4 +223,6 @@
            wake_dtKE(i,l) = 0.
            wake_dqKE(i,l) = 0.
+ 	   wake_dtPBL(i,l) = 0.
+	   wake_dqPBL(i,l) = 0.
            wake_omg(i,l) = 0.
            wake_dp_deltomg(i,l) = 0.
@@ -230,7 +233,11 @@
            undi_t(i,l)=te(i,l)
            undi_q(i,l)=qe(i,l)
-         ENDDO
-       ENDIF
-
+           wake_ddeltat(i,l) = 0.
+           wake_ddeltaq(i,l) = 0.
+        ENDIF
+       ENDDO
+      ENDDO
+c
+      DO i=1,klon 
        wake_h(i)= hw(i)
        wake_s(i)= sigmaw(i)
@@ -241,10 +248,9 @@
        wake_Cstar(i) = Cstar(i)
        wake_dens(i) = wdens(i)
-c
-cIM 290108 999  CONTINUE
-c
-      ENDDO
+      ENDDO
+c
       RETURN
       END
+
       SUBROUTINE CALWAKE_scal(paprs,pplay,dtime
      :             ,t,q,omgb
Index: /LMDZ4/trunk/libf/phylmd/clesphys.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/clesphys.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/clesphys.h	(revision 1403)
@@ -1,2 +1,3 @@
+
 !
 ! $Id$
@@ -48,4 +49,6 @@
        INTEGER lev_histdayNMC
        Integer lev_histins, lev_histLES  
+
+
 !IM ok_histNMC  : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
@@ -55,4 +58,5 @@
        LOGICAL ok_histNMC(3)
        REAL freq_outNMC(3) , freq_calNMC(3)
+
        CHARACTER(len=4) type_run
 ! aer_type: pour utiliser un fichier constant dans readaerosol 
@@ -69,4 +73,5 @@
        LOGICAL :: ok_strato
        LOGICAL :: ok_hines
+       INTEGER :: nseuil
 
        COMMON/clesphys/cycle_diurne, soil_model, new_oliq,              &
@@ -78,4 +83,5 @@
      &     , f_cdrag_ter,f_cdrag_oce,f_rugoro                           &
      &     , lev_histhf, lev_histday, lev_histmth                       &
+
      &     , lev_histins, lev_histLES, lev_histdayNMC                   &
      &     , pasphys, ok_histNMC, freq_outNMC, freq_calNMC              &
@@ -88,5 +94,5 @@
      &     , ok_lic_melt, cvl_corr, aer_type                            &
      &     , qsol0, iflag_rrtm, ok_strato,ok_hines,ecrit_LES            &
-     &     , co2_ppm0
+     &     , co2_ppm0, nseuil
      
 !$OMP THREADPRIVATE(/clesphys/)
Index: /LMDZ4/trunk/libf/phylmd/cloudth.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cloudth.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/cloudth.F90	(revision 1403)
@@ -0,0 +1,263 @@
+       SUBROUTINE cloudth(ngrid,klev,ind2,  &
+     &           ztv,po,zqta,fraca, & 
+     &           qcloud,ctot,zpspsk,paprs,ztla,zthl, &
+     &           ratqs,zqs,t)
+
+
+      IMPLICIT NONE
+
+
+!===========================================================================
+! Auteur : Arnaud Octavio Jam (LMD/CNRS)
+! Date : 25 Mai 2010
+! Objet : calcule les valeurs de qc et rneb dans les thermiques
+!===========================================================================
+
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "iniprint.h"
+#include "thermcell.h"
+
+      INTEGER itap,ind1,ind2
+      INTEGER ngrid,klev,klon,l,ig 
+      
+      REAL ztv(ngrid,klev)
+      REAL po(ngrid)
+      REAL zqenv(ngrid)   
+      REAL zqta(ngrid,klev)
+          
+      REAL fraca(ngrid,klev+1)
+      REAL zpspsk(ngrid,klev)
+      REAL paprs(ngrid,klev+1)
+      REAL ztla(ngrid,klev)
+      REAL zthl(ngrid,klev)
+
+      REAL zqsatth(ngrid,klev)
+      REAL zqsatenv(ngrid,klev)
+      
+      
+      REAL sigma1(ngrid,klev)                                                         
+      REAL sigma2(ngrid,klev)
+      REAL qlth(ngrid,klev)
+      REAL qlenv(ngrid,klev)
+      REAL qltot(ngrid,klev) 
+      REAL cth(ngrid,klev)  
+      REAL cenv(ngrid,klev)   
+      REAL ctot(ngrid,klev)
+      REAL rneb(ngrid,klev)
+      REAL t(ngrid,klev)                                                                  
+      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
+      REAL rdd,cppd,Lv
+      REAL alth,alenv,ath,aenv
+      REAL sth,senv,sigma1s,sigma2s,xth,xenv
+      REAL Tbef,zdelta,qsatbef,zcor
+      REAL alpha,qlbef  
+      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
+      
+      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
+      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid) 
+      REAL zqs(ngrid), qcloud(ngrid)
+      REAL erf
+
+
+
+
+
+!      print*,ngrid,klev,ind1,ind2,ztv(ind1,ind2),po(ind1),zqta(ind1,ind2), &
+!     &       fraca(ind1,ind2),zpspsk(ind1,ind2),paprs(ind1,ind2),ztla(ind1,ind2),zthl(ind1,ind2), &
+!     &       'verif'
+
+
+!      LOGICAL active(ngrid)   
+      
+!-----------------------------------------------------------------------------------------------------------------
+! Initialisation des variables réelles
+!-----------------------------------------------------------------------------------------------------------------
+      sigma1(:,:)=0.
+      sigma2(:,:)=0.
+      qlth(:,:)=0.
+      qlenv(:,:)=0.  
+      qltot(:,:)=0.
+      rneb(:,:)=0.
+      qcloud(:)=0.
+      cth(:,:)=0.
+      cenv(:,:)=0.
+      ctot(:,:)=0.
+      qsatmmussig1=0.
+      qsatmmussig2=0.
+      rdd=287.04
+      cppd=1005.7
+      pi=3.14159 
+      Lv=2.5e6
+      sqrt2pi=sqrt(2.*pi)
+
+
+
+!------------------------------------------------------------------------------------------------------------------
+! Calcul de la fraction du thermique et des écart-types des distributions
+!------------------------------------------------------------------------------------------------------------------                 
+      do ind1=1,ngrid
+
+      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then 
+
+      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
+
+
+!      zqenv(ind1)=po(ind1)
+      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+
+
+
+
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+
+
+
+
+      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatth(ind1,ind2)=qsatbef
+            
+      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
+      ath=1./(1.+(alth*Lv/cppd))
+      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2)) 
+      
+      
+
+!-----------------------------------------------------------------------------------------------------------------
+! Calcul des écart-types pour s
+!-----------------------------------------------------------------------------------------------------------------
+!      alpha=0.5*(fraca(ind1,ind2)+fraca(ind1,ind2-1))
+!      sigma1s=(Max(1.2*fraca(ind1,ind2)*(sth-senv)**2,(senv/100)**2))**0.5
+!      sigma2s=((0.021/(fraca(ind1,ind2)+0.0)**0.5)*(sth-senv)**2+(sth/100)**2)**0.5 
+!      sigma1s=(1.5**0.5)*(fraca(ind1,ind2)**0.65)*(sth-senv)+0.000045
+!      sigma2s=0.1265*(sth-senv)/(fraca(ind1,ind2)+0.0)**0.35+0.000045     
+
+      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.00003
+      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003  
+
+!      sigma1s=(1.5**0.5)*(alpha**0.65)*(sth-senv)+0.000045
+!      sigma2s=0.1265*(sth-senv)/alpha**0.35+0.000045
+      
+!      sigma1s=(2.8**0.5)*(0.1**0.7)*(sth-senv)+0.00002
+!      sigma2s=((0.126/(0.1)**0.3)*(sth-senv))+0.00002
+
+
+ 
+!-----------------------------------------------------------------------------------------------------------------
+! Calcul de l'eau condensée et de la couverture nuageuse
+!-----------------------------------------------------------------------------------------------------------------
+      sqrt2pi=sqrt(2.*pi)
+      xth=sth/(sqrt(2.)*sigma2s)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
+      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv)) 
+      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
+!      ctot(ind1,ind2)=alpha*cth(ind1,ind2)+(1.-1.*alpha)*cenv(ind1,ind2) 
+
+
+
+      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
+      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
+      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
+!      qltot(ind1,ind2)=alpha*qlth(ind1,ind2)+(1.-1.*alpha)*qlenv(ind1,ind2)
+     
+
+!      print*,senv,sth,sigma1s,sigma2s,fraca(ind1,ind2),'senv et sth et sig1 et sig2 et alpha'
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      if (ctot(ind1,ind2).lt.1.e-10) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else   
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
+
+      endif                           
+      
+          
+!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
+
+
+      else  ! gaussienne environnement seule
+      
+      zqenv(ind1)=po(ind1)
+      Tbef=t(ind1,ind2)
+      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
+      qsatbef=MIN(0.5,qsatbef)
+      zcor=1./(1.-retv*qsatbef)
+      qsatbef=qsatbef*zcor
+      zqsatenv(ind1,ind2)=qsatbef
+      
+
+!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
+      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
+      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)  
+      aenv=1./(1.+(alenv*Lv/cppd))
+      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2)) 
+      
+!      if (zqenv(ind1).gt.0.005) then
+      sigma1s=0.005*zqenv(ind1)
+!      else 
+!      sigma1s=0.0005
+!      endif
+
+!      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
+
+
+
+!      sigma1s=0.00003
+      sqrt2pi=sqrt(2.*pi)
+      xenv=senv/(sqrt(2.)*sigma1s)
+      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
+      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
+      
+      if (ctot(ind1,ind2).lt.1.e-3) then
+      ctot(ind1,ind2)=0.
+      qcloud(ind1)=zqsatenv(ind1,ind2) 
+
+      else   
+                
+      ctot(ind1,ind2)=ctot(ind1,ind2) 
+      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
+
+      endif    
+ 
+ 
+ 
+ 
+ 
+ 
+      endif   
+      enddo
+     
+      return
+      end
+
+
+
+
+
+                                                                            
+
+
+
+
+
Index: /LMDZ4/trunk/libf/phylmd/conema3.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/conema3.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/conema3.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra,
@@ -360,5 +360,5 @@
       cape(i) = em_CAPE
       wd(i) = em_wd
-      rflag(i) = float(iflag)
+      rflag(i) = REAL(iflag)
 c SB      kbas(i) = em_bas
 c SB      ktop(i) = em_top
Index: /LMDZ4/trunk/libf/phylmd/conf_phys.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/conf_phys.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/conf_phys.F90	(revision 1403)
@@ -22,5 +22,6 @@
                        iflag_thermals,nsplit_thermals,tau_thermals, &
                        iflag_thermals_ed,iflag_thermals_optflux, &
-                       iflag_coupl,iflag_clos,iflag_wake, read_climoz)
+                       iflag_coupl,iflag_clos,iflag_wake, read_climoz, &
+                       alp_offset)
 
    use IOIPSL
@@ -28,4 +29,5 @@
    USE phys_cal_mod
    USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl
+   use control_mod
 
  include "conema3.h"
@@ -37,5 +39,4 @@
 include "clesphys.h"
 include "compbl.h"
-include "control.h"
 include "comsoil.h"
 !
@@ -111,4 +112,6 @@
   integer :: iflag_clos
   integer :: iflag_wake
+  real :: alp_offset
+  REAL, SAVE :: alp_offset_omp
   integer,SAVE :: iflag_coupl_omp,iflag_clos_omp,iflag_wake_omp
   integer,SAVE :: iflag_cvl_sigd_omp
@@ -150,4 +153,5 @@
   REAL,SAVE :: ecrit_LES_omp
   REAL,SAVE :: ecrit_tra_omp
+  INTEGER, SAVE :: nseuil_omp   
   REAL,SAVE :: cvl_corr_omp
   LOGICAL,SAVE :: ok_lic_melt_omp
@@ -1038,4 +1042,12 @@
   call getin('iflag_wake',iflag_wake_omp)
 
+!Config Key  = alp_offset
+!Config Desc =  
+!Config Def  = 0
+!Config Help = 
+!
+  alp_offset_omp = 0.
+  call getin('alp_offset',alp_offset_omp)
+
 !
 !Config Key  = lev_histhf
@@ -1256,4 +1268,14 @@
   ecrit_tra_omp = 30.
   call getin('ecrit_tra',ecrit_tra_omp)
+!
+!Config Key  = nseuil
+!Config Desc = Numero du traceur a partir duquel on ne transporte 
+!              pas par convection
+!Config Def  = 7 !a partir du numero 7 pour les pseudo-traceurs de Remy
+!Config Help =
+!
+  nseuil_omp = 7
+  call getin('nseuil',nseuil_omp)
+!
 !
 !Config Key  = ecrit_reg
@@ -1531,4 +1553,5 @@
     iflag_clos = iflag_clos_omp
     iflag_wake = iflag_wake_omp
+    alp_offset = alp_offset_omp
     iflag_cvl_sigd = iflag_cvl_sigd_omp
     type_run = type_run_omp
@@ -1548,4 +1571,5 @@
     ecrit_mth = ecrit_mth_omp
     ecrit_tra = ecrit_tra_omp
+    nseuil = nseuil_omp
     ecrit_reg = ecrit_reg_omp
     cvl_corr = cvl_corr_omp
@@ -1708,4 +1732,6 @@
   write(numout,*)' Fmax = ', Fmax
   write(numout,*)' alphas = ', alphas
+  write(numout,*)' iflag_wake = ', iflag_wake
+  write(numout,*)' alp_offset = ', alp_offset
 
   write(numout,*)' lonmin lonmax latmin latmax bilKP_ins =',&
@@ -1713,4 +1739,5 @@
   write(numout,*)' ecrit_ hf, ins, day, mth, reg, tra, ISCCP, LES',&
    ecrit_hf, ecrit_ins, ecrit_day, ecrit_mth, ecrit_reg, ecrit_tra, ecrit_ISCCP, ecrit_LES
+  write(numout,*)' nseuil ',nseuil
 
   write(numout,*) 'ok_strato = ', ok_strato
Index: /LMDZ4/trunk/libf/phylmd/convect2.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/convect2.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/convect2.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       subroutine convect2(ncum,idcum,len,nd,ndp1,nl,minorig,
Index: /LMDZ4/trunk/libf/phylmd/cpl_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cpl_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cpl_mod.F90	(revision 1403)
@@ -24,4 +24,6 @@
   USE oasis
   USE write_field_phy
+  USE control_mod
+
   
 ! Global attributes
@@ -101,5 +103,4 @@
     INCLUDE "dimensions.h"
     INCLUDE "indicesol.h"
-    INCLUDE "control.h"
     INCLUDE "temps.h"
     INCLUDE "iniprint.h"
@@ -583,31 +584,31 @@
     DO ig = 1, knon
        cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
-            swdown(ig)      / FLOAT(nexca)
+            swdown(ig)      / REAL(nexca)
        cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
-            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca)
+            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
        cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
-            precip_rain(ig) / FLOAT(nexca)
+            precip_rain(ig) / REAL(nexca)
        cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
-            precip_snow(ig) / FLOAT(nexca)
+            precip_snow(ig) / REAL(nexca)
        cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
-            evap(ig)        / FLOAT(nexca)
+            evap(ig)        / REAL(nexca)
        cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
-            tsurf(ig)       / FLOAT(nexca)
+            tsurf(ig)       / REAL(nexca)
        cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
-            fder(ig)        / FLOAT(nexca)
+            fder(ig)        / REAL(nexca)
        cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
-            albsol(ig)      / FLOAT(nexca)
+            albsol(ig)      / REAL(nexca)
        cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
-            taux(ig)        / FLOAT(nexca)
+            taux(ig)        / REAL(nexca)
        cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
-            tauy(ig)        / FLOAT(nexca)      
+            tauy(ig)        / REAL(nexca)      
        cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
-            windsp(ig)      / FLOAT(nexca)
+            windsp(ig)      / REAL(nexca)
        cpl_taumod(ig,cpl_index) =   cpl_taumod(ig,cpl_index) + &
-          SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT (nexca)
+          SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca)
 
        IF (carbon_cycle_cpl) THEN
           cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
-               co2_send(knindex(ig))/ FLOAT(nexca) 
+               co2_send(knindex(ig))/ REAL(nexca) 
        END IF
      ENDDO
@@ -777,25 +778,25 @@
     DO ig = 1, knon
        cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
-            swdown(ig)      / FLOAT(nexca)
+            swdown(ig)      / REAL(nexca)
        cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
-            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca)
+            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
        cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
-            precip_rain(ig) / FLOAT(nexca)
+            precip_rain(ig) / REAL(nexca)
        cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
-            precip_snow(ig) / FLOAT(nexca)
+            precip_snow(ig) / REAL(nexca)
        cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
-            evap(ig)        / FLOAT(nexca)
+            evap(ig)        / REAL(nexca)
        cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
-            tsurf(ig)       / FLOAT(nexca)
+            tsurf(ig)       / REAL(nexca)
        cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
-            fder(ig)        / FLOAT(nexca)
+            fder(ig)        / REAL(nexca)
        cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
-            albsol(ig)      / FLOAT(nexca)
+            albsol(ig)      / REAL(nexca)
        cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
-            taux(ig)        / FLOAT(nexca)
+            taux(ig)        / REAL(nexca)
        cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
-            tauy(ig)        / FLOAT(nexca)     
+            tauy(ig)        / REAL(nexca)     
        cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
-            SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT(nexca) 
+            SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca) 
     ENDDO
 
@@ -944,6 +945,6 @@
 !*************************************************************************************    
 !$OMP MASTER
-    cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / FLOAT(nexca)
-    cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / FLOAT(nexca)
+    cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca)
+    cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca)
 !$OMP END MASTER
 
@@ -998,5 +999,5 @@
 !*************************************************************************************    
 !$OMP MASTER
-    cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / FLOAT(nexca)
+    cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
 !$OMP END MASTER
 
Index: /LMDZ4/trunk/libf/phylmd/cv30_routines.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv30_routines.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv30_routines.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -749,4 +749,5 @@
 
 #include "cv30param.h"
+      include 'iniprint.h'
 
 c inputs:
@@ -778,4 +779,7 @@
 c local variables:
       integer i,k,nn,j
+
+      CHARACTER (LEN=20) :: modname='cv30_compress'
+      CHARACTER (LEN=80) :: abort_message
 
 
@@ -820,6 +824,7 @@
 
       if (nn.ne.ncum) then
-         print*,'strange! nn not equal to ncum: ',nn,ncum
-         stop
+         write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       endif
 
Index: /LMDZ4/trunk/libf/phylmd/cv3_cine.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3_cine.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3_cine.F	(revision 1403)
@@ -1,5 +1,8 @@
+!
+! $Id$
+!
         SUBROUTINE cv3_cine(nloc,ncum,nd,icb,inb
      :                      ,pbase,plcl,p,ph,tv,tvp
-     :                      ,cina,cinb)
+     :                      ,cina,cinb,plfc)
 
 ***************************************************************
@@ -26,5 +29,5 @@
 c
 c output
-      real cina(nloc),cinb(nloc)
+      real cina(nloc),cinb(nloc),plfc(nloc)
 c
 c local variables
@@ -34,5 +37,4 @@
       logical lswitch(nloc),lswitch1(nloc),lswitch2(nloc)
       logical exist_lfc(nloc)
-      real plfc(nloc)
       real dpmax
       real deltap,dcin
Index: /LMDZ4/trunk/libf/phylmd/cv3_inicp.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3_inicp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3_inicp.F	(revision 1403)
@@ -13,4 +13,6 @@
 c
       INTEGER iflag_clos
+      CHARACTER (LEN=20) :: modname='cv3_inicp'
+      CHARACTER (LEN=80) :: abort_message
 c
 c --   Mixing probability distribution functions
@@ -105,5 +107,6 @@
         if (abs(aire-1.0) .gt. 0.02) then
             print *,'WARNING:: AREA OF MIXING PDF IS::', aire
-            stop
+            abort_message = ''
+            CALL abort_gcm (modname,abort_message,1)
         else
             print *,'Area, mean & std deviation are ::', aire,mu,sigma
Index: /LMDZ4/trunk/libf/phylmd/cv3_inip.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3_inip.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3_inip.F	(revision 1403)
@@ -12,4 +12,9 @@
 c
 c      INTEGER iflag_mix
+      include 'iniprint.h'
+
+      CHARACTER (LEN=20) :: modname='cv3_inip'
+      CHARACTER (LEN=80) :: abort_message
+
 c
 c --   Mixing probability distribution functions
@@ -104,6 +109,7 @@
 c
         if (abs(aire-1.0) .gt. 0.02) then
-            print *,'WARNING:: AREA OF MIXING PDF IS::', aire
-            stop
+            write(lunout,*)'WARNING:: AREA OF MIXING PDF IS::', aire
+            abort_message = ''
+            CALL abort_gcm (modname,abort_message,1)
         else
             print *,'Area, mean & std deviation are ::', aire,mu,sigma
Index: /LMDZ4/trunk/libf/phylmd/cv3_routines.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3_routines.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3_routines.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/cv3_routines.F,v 1.16 2008-11-06 16:29:35 lmdzadmin Exp $
+! $Id$
 !
 c
@@ -36,4 +36,7 @@
       real delt ! timestep (seconds)
 
+      CHARACTER (LEN=20) :: modname='cv3_param'
+      CHARACTER (LEN=80) :: abort_message
+
 c noff: integer limit for convection (nd-noff)
 c minorig: First level of convection
@@ -71,7 +74,6 @@
 c      dtcrit = -5.0
 c      tau    = 3000.
-cc      tau = 1800.
-c     tau= 2800.
-      tau=8000.
+      tau = 1800.
+cc      tau=8000.
       beta   = 1.0 - delt/tau
       alpha1 = 1.5e-3
@@ -767,4 +769,5 @@
 
 #include "cv3param.h"
+      include 'iniprint.h'
 
 c inputs:
@@ -797,4 +800,6 @@
       integer i,k,nn,j
 
+      CHARACTER (LEN=20) :: modname='cv3_compress'
+      CHARACTER (LEN=80) :: abort_message
 
       do 110 k=1,nl+1
@@ -839,6 +844,7 @@
 
       if (nn.ne.ncum) then
-         print*,'strange! nn not equal to ncum: ',nn,ncum
-         stop
+         write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       endif
 
@@ -2087,5 +2093,5 @@
 cc---end jyg---
 c
-c--------retour à la formulation originale d''Emanuel.
+c--------retour à la formulation originale d'Emanuel.
       b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
       c6=water(il,i+1)+bfac*wdtrain(il)
@@ -2093,6 +2099,12 @@
       if(c6.gt.0.0)then
        revap=0.5*(-b6+sqrt(b6*b6+4.*c6))
-       water(il,i)=revap*revap      !equation de conservation
+cjyg    Dans sa formulation originale, Emanuel calcule l'evaporation par:
+cc             evap(il,i)=sigt*afac*revap
+c     ce qui n'est pas correct. Dans cv_routines, la formulation a été modifiee.
+c     Ici,l'evaporation evap est simplement calculee par l'equation de
+c     conservation.
+       water(il,i)=revap*revap
       else
+cjyg----   Correction : si c6 <= 0, water(il,i)=0.
        water(il,i) = 0.
       endif
@@ -2338,5 +2350,5 @@
       real esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
       real th_wake(nloc,nd)
-      real alpha_qpos(nloc)
+      real alpha_qpos(nloc),alpha_qpos1(nloc)
       real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd)  ! cld
       real siga(nloc,nd), sax(nloc,nd), mac(nloc,nd)      ! cld
@@ -3043,4 +3055,13 @@
        do il=1,ncum
         IF (iflag(il) .le. 1) THEN
+	IF (cvflag_grav) then
+        ex=0.01*grav*ment(il,inb(il),inb(il))
+     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
+     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
+        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
+        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
+     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
+     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+	else
         ex=0.1*ment(il,inb(il),inb(il))
      :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
@@ -3050,4 +3071,5 @@
      :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
      :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
+        ENDIF   !cvflag grav
         ENDIF    !iflag
        enddo
@@ -3115,7 +3137,11 @@
 c        in order to ensure moisture positivity
       DO il = 1,ncum
+      alpha_qpos(il)=1.
        IF (iflag(il) .le. 1) THEN
-        alpha_qpos(il) = max(1. , -delt*fr(il,1)/
+        if (fr(il,1) .le. 0.) then
+            alpha_qpos(il) = max(alpha_qpos(il) ,
+     :	   (-delt*fr(il,1))/
      :     (s_wake(il)*rr_wake(il,1)+(1.-s_wake(il))*rr(il,1)))
+        end if
        ENDIF
       ENDDO
@@ -3123,6 +3149,10 @@
        DO il = 1,ncum
         IF (iflag(il) .le. 1) THEN
-        alpha_qpos(il) = max(alpha_qpos(il) , -delt*fr(il,i)/
+          IF (fr(il,i) .le. 0.) THEN
+           alpha_qpos1(il)=max(1. , (-delt*fr(il,i))/
      :     (s_wake(il)*rr_wake(il,i)+(1.-s_wake(il))*rr(il,i)))
+             IF (alpha_qpos1(il) .ge. alpha_qpos(il))
+     :           alpha_qpos(il)=alpha_qpos1(il)
+          ENDIF
         ENDIF
        ENDDO
Index: /LMDZ4/trunk/libf/phylmd/cv3a_compress.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3a_compress.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3a_compress.F	(revision 1403)
@@ -76,4 +76,7 @@
       integer i,k,nn,j
 
+      CHARACTER (LEN=20) :: modname='cv3a_compress'
+      CHARACTER (LEN=80) :: abort_message
+
 
       do 110 k=1,nl+1
@@ -127,6 +130,7 @@
 
       if (nn.ne.ncum) then
-         print*,'WARNING nn not equal to ncum: ',nn,ncum
-         stop
+        print*,'WARNING nn not equal to ncum: ',nn,ncum
+        abort_message = ''
+        CALL abort_gcm (modname,abort_message,1)
       endif
 
@@ -157,5 +161,6 @@
       if (nn.ne.ncum) then
          print*,'WARNING nn not equal to ncum: ',nn,ncum
-         stop
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       endif
 
Index: /LMDZ4/trunk/libf/phylmd/cv3p1_closure.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv3p1_closure.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv3p1_closure.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE cv3p1_closure(nloc,ncum,nd,icb,inb
      :                      ,pbase,plcl,p,ph,tv,tvp,buoy
@@ -60,5 +63,5 @@
       integer nsupmax(nloc)
       real supcrit,temp(nloc,nd)
-      real P1(nloc),Pmin(nloc)
+      real P1(nloc),Pmin(nloc),plfc(nloc)
       real asupmax0(nloc)
       logical ok(nloc)
@@ -74,4 +77,7 @@
       real wb,sigmax
       data wb /2./, sigmax /0.1/
+
+      CHARACTER (LEN=20) :: modname='cv3p1_closure'
+      CHARACTER (LEN=80) :: abort_message
 c
 c      print *,' -> cv3p1_closure, Ale ',ale(1)
@@ -379,5 +385,5 @@
       CALL cv3_cine (nloc,ncum,nd,icb,inb
      :                      ,pbase,plcl,p,ph,tv,tvp
-     :                      ,cina,cinb)
+     :                      ,cina,cinb,plfc)
 c
       DO il = 1,ncum
@@ -489,6 +495,8 @@
       do k= 1,nl
        do il = 1,ncum
-!IM       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
-        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
+!old       IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
+!IM        IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
+       IF (k .ge. icb(il) .and. k .le. inb(il)         !cor jyg
+     $     .and. icb(il)+1 .le. inb(il)) THEN          !cor jyg
          cbmflim(il) = cbmflim(il)+MLIM(il,k)
         ENDIF
@@ -509,7 +517,9 @@
        cbmf1(il) = alp2(il)/(0.5*wb*wb-Cin(il))
        if(cbmf1(il).EQ.0.AND.alp2(il).NE.0.) THEN
-        print*,'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il,
+        write(lunout,*)
+     &  'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il,
      . alp2(il),alp(il),cin(il)
-        STOP 
+        abort_message = ''
+        CALL abort_gcm (modname,abort_message,1)
        endif
        cbmfmax(il) = sigmax*wb2(il)*100.*p(il,icb(il))
@@ -540,8 +550,10 @@
         do il = 1,ncum
          IF ( k .ge. icb(il)+1 .AND. k .le. inb(il)) THEN
-         sig(il,k) = beta*sig(il,k)+(1.-beta)*coef(il)*siglim(il,k)
-cc         sig(il,k) = beta*sig(il,k)+siglim(il,k)
-         w0(il,k) = beta*w0(il,k)  +(1.-beta)*wlim(il,k)
-         AMU=SIG(il,k)*W0(il,k)
+         amu=beta*sig(il,k)*w0(il,k)+
+     :   (1.-beta)*coef(il)*siglim(il,k)*wlim(il,k)
+         w0(il,k) = wlim(il,k)
+         w0(il,k) =max(w0(il,k),1.e-10)
+         sig(il,k)=amu/w0(il,k)
+         sig(il,k)=min(sig(il,k),1.)
 cc         amu = 0.5*(SIG(il,k)+sigold(il,k))*W0(il,k)
          M(il,k)=AMU*0.007*P(il,k)*(PH(il,k)-PH(il,k+1))/TV(il,k)
Index: /LMDZ4/trunk/libf/phylmd/cv_routines.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cv_routines.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cv_routines.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE cv_param(nd)
@@ -38,4 +38,6 @@
 #include "cvparam.h"
       integer nd
+      CHARACTER (LEN=20) :: modname='cv_routines'
+      CHARACTER (LEN=80) :: abort_message
 
 c noff: integer limit for convection (nd-noff)
@@ -429,4 +431,8 @@
 c local variables:
       integer i,k,nn
+      CHARACTER (LEN=20) :: modname='cv_compress'
+      CHARACTER (LEN=80) :: abort_message
+
+      include 'iniprint.h'
 
 
@@ -456,6 +462,7 @@
 
       if (nn.ne.ncum) then
-         print*,'strange! nn not equal to ncum: ',nn,ncum
-         stop
+         write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       endif
 
Index: /LMDZ4/trunk/libf/phylmd/cva_driver.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/cva_driver.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/cva_driver.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE cva_driver(len,nd,ndp1,ntra,nloc,
      &                   iflag_con,iflag_mix,
@@ -106,4 +109,6 @@
 #include "dimensions.h"
 ccccc#include "dimphy.h"
+      include 'iniprint.h'
+
 c
 c Input
@@ -151,5 +156,5 @@
       real Ma1(len,nd)
       real mip1(len,nd)
-!      real Vprecip1(len,nd) Correction abderr le 23 03 10
+!      real Vprecip1(len,nd)
       real Vprecip1(len,nd+1)
       real upwd1(len,nd)
@@ -421,4 +426,6 @@
       logical, save :: first=.true.
 c$OMP THREADPRIVATE(first)
+      CHARACTER (LEN=20) :: modname='cva_driver'
+      CHARACTER (LEN=80) :: abort_message
 
 c
@@ -566,7 +573,8 @@
 c test niveaux couche alimentation KE
        if(sig1feed1.eq.sig2feed1) then
-               print*,'impossible de choisir sig1feed=sig2feed'
-               print*,'changer la valeur de sig2feed dans physiq.def'
-       stop
+         write(lunout,*)'impossible de choisir sig1feed=sig2feed'
+         write(lunout,*)'changer la valeur de sig2feed dans physiq.def'
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
        endif
 c
Index: /LMDZ4/trunk/libf/phylmd/fisrtilp.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/fisrtilp.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/fisrtilp.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -7,5 +7,6 @@
      s                   pfrac_impa, pfrac_nucl, pfrac_1nucl,
      s                   frac_impa, frac_nucl,
-     s                   prfl, psfl, rhcl)
+     s                   prfl, psfl, rhcl, zqta, fraca,
+     s                   ztv, zpspsk, ztla, zthl, iflag_cldcon)
 
 c
@@ -41,5 +42,12 @@
       REAL snow(klon) ! neige (mm/s)
       REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
-      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
+      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 
+      REAL ztv(klon,klev)
+      REAL zqta(klon,klev),fraca(klon,klev) 
+      REAL sigma1(klon,klev),sigma2(klon,klev)
+      REAL qltot(klon,klev),ctot(klon,klev)
+      REAL zpspsk(klon,klev),ztla(klon,klev)
+      REAL zthl(klon,klev)
+
 cAA
 c Coeffients de fraction lessivee : pour OFF-LINE
@@ -63,5 +71,6 @@
 
       INTEGER ninter ! sous-intervals pour la precipitation
-      INTEGER ncoreczq
+      INTEGER ncoreczq  
+      INTEGER iflag_cldcon
       PARAMETER (ninter=5)
       LOGICAL evap_prec ! evaporation de la pluie
@@ -72,5 +81,6 @@
       real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
       real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
-      real erf
+      real erf   
+      REAL qcloud(klon)
 c
       LOGICAL cpartiel ! condensation partielle
@@ -82,5 +92,5 @@
 c
       INTEGER i, k, n, kk
-      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5
+      REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5   
       REAL zrfl(klon), zrfln(klon), zqev, zqevt
       REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
@@ -130,4 +140,5 @@
       zdelq=0.0
       
+      print*,'CLOUDTH4 A. JAM'
       IF (appel1er) THEN
 c
@@ -135,5 +146,5 @@
          PRINT*, 'fisrtilp, evap_prec:', evap_prec
          PRINT*, 'fisrtilp, cpartiel:', cpartiel
-         IF (ABS(dtime/FLOAT(ninter)-360.0).GT.0.001) THEN
+         IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
           PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
           PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
@@ -322,4 +333,5 @@
 c de l'eau condensee:
 c
+
       IF (cpartiel) THEN
 
@@ -351,6 +363,21 @@
                 zq(i)=1.e-15
               endif
-           enddo
-           do i=1,klon
+           enddo 
+
+              if (iflag_cldcon.eq.5) then
+
+                 call cloudth(klon,klev,k,ztv,
+     .           zq,zqta,fraca,
+     .           qcloud,ctot,zpspsk,paprs,ztla,zthl,
+     .           ratqs,zqs,t)
+
+                 do i=1,klon
+                 rneb(i,k)=ctot(i,k)
+                 zqn(i)=qcloud(i)
+                 enddo
+
+              else
+
+            do i=1,klon
             zpdf_sig(i)=ratqs(i,k)*zq(i)
             zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2))
@@ -372,5 +399,7 @@
             endif
             
-           enddo
+           enddo 
+
+         endif ! iflag_cldcon
 
         endif ! iflag_pdf
@@ -436,5 +465,5 @@
          zfice(i) = zfice(i)**nexpo
          zneb(i) = MAX(rneb(i,k), seuil_neb)
-         radliq(i,k) = zoliq(i)/FLOAT(ninter+1)
+         radliq(i,k) = zoliq(i)/REAL(ninter+1)
       ENDIF
       ENDDO
@@ -453,13 +482,13 @@
                 zcl   =cld_lc_con
                 zct   =1./cld_tau_con
-                zfroi    = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
+                zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i)
      .              *fallvc(zrhol(i)) * zfice(i)
              else
                 zcl   =cld_lc_lsc
                 zct   =1./cld_tau_lsc
-                zfroi    = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
+                zfroi    = dtime/REAL(ninter)/zdz(i)*zoliq(i)
      .              *fallvs(zrhol(i)) * zfice(i)
              endif
-             zchau    = zct   *dtime/FLOAT(ninter) * zoliq(i)
+             zchau    = zct   *dtime/REAL(ninter) * zoliq(i)
      .         *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl   )**2)) *(1.-zfice(i))
              ztot    = zchau    + zfroi
@@ -468,5 +497,5 @@
          ztot    = MIN(ztot,zoliq(i))
          zoliq(i) = MAX(zoliq(i)-ztot   , 0.0)
-         radliq(i,k) = radliq(i,k) + zoliq(i)/FLOAT(ninter+1)
+         radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
       ENDIF
       ENDDO
Index: /LMDZ4/trunk/libf/phylmd/fisrtilp_tr.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/fisrtilp_tr.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/fisrtilp_tr.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -140,5 +140,5 @@
          PRINT*, 'fisrtilp, evap_prec:', evap_prec
          PRINT*, 'fisrtilp, cpartiel:', cpartiel
-         IF (ABS(dtime/FLOAT(ninter)-360.0).GT.0.001) THEN
+         IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
           PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime
           PRINT*, 'Je prefere un sous-intervalle de 6 minutes'
@@ -335,5 +335,5 @@
          zfice(i) = zfice(i)**nexpo
          zneb(i) = MAX(rneb(i,k), seuil_neb)
-         radliq(i,k) = zoliq(i)/FLOAT(ninter+1)
+         radliq(i,k) = zoliq(i)/REAL(ninter+1)
       ENDIF
       ENDDO
@@ -342,8 +342,8 @@
       DO i = 1, klon
       IF (rneb(i,k).GT.0.0) THEN
-         zchau(i) = ct*dtime/FLOAT(ninter) * zoliq(i)
+         zchau(i) = ct*dtime/REAL(ninter) * zoliq(i)
      .          * (1.0-EXP(-(zoliq(i)/zneb(i)/cl)**2)) *(1.-zfice(i))
          zrhol(i) = zrho(i) * zoliq(i) / zneb(i)
-         zfroi(i) = dtime/FLOAT(ninter)/zdz(i)*zoliq(i)
+         zfroi(i) = dtime/REAL(ninter)/zdz(i)*zoliq(i)
      .              *fallv(zrhol(i)) * zfice(i)
          ztot(i) = zchau(i) + zfroi(i)
@@ -351,5 +351,5 @@
          ztot(i) = MIN(MAX(ztot(i),0.0),zoliq(i))
          zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0)
-         radliq(i,k) = radliq(i,k) + zoliq(i)/FLOAT(ninter+1)
+         radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
       ENDIF
       ENDDO
Index: /LMDZ4/trunk/libf/phylmd/hines_gwd.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/hines_gwd.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/hines_gwd.F	(revision 1403)
@@ -847,5 +847,5 @@
 C  Use horizontal isotropy to calculate azimuthal variances at bottom level.
 C
-      AZFAC = 1. / FLOAT(NAZ)
+      AZFAC = 1. / REAL(NAZ)
       DO 20 N = 1,NAZ
         DO 10 I = IL1,IL2
Index: /LMDZ4/trunk/libf/phylmd/ini_bilKP_ave.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_bilKP_ave.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_bilKP_ave.h	(revision 1403)
@@ -1,4 +1,4 @@
 c
-c $Header$
+c $Id$
 c
       IF (ok_journe) THEN
@@ -17,5 +17,5 @@
 cym         ENDDO
          DO ll=1,klev
-            znivsig(ll)=float(ll)
+            znivsig(ll)=REAL(ll)
          ENDDO
 cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
Index: /LMDZ4/trunk/libf/phylmd/ini_bilKP_ins.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_bilKP_ins.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_bilKP_ins.h	(revision 1403)
@@ -1,4 +1,4 @@
 c
-c $Header$
+c $Id$
 c
       IF (ok_journe) THEN
@@ -17,5 +17,5 @@
 cym         ENDDO
          DO ll=1,klev
-            znivsig(ll)=float(ll)
+            znivsig(ll)=REAL(ll)
          ENDDO
 cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
Index: /LMDZ4/trunk/libf/phylmd/ini_histISCCP.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_histISCCP.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_histISCCP.h	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       IF (ok_isccp) THEN
@@ -49,5 +49,5 @@
 c
         DO l=1, ncol(n)
-          vertlev(l,n)=float(l)
+          vertlev(l,n)=REAL(l)
         ENDDO !ncol
 c
Index: /LMDZ4/trunk/libf/phylmd/ini_histday_seri.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_histday_seri.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_histday_seri.h	(revision 1403)
@@ -1,4 +1,4 @@
 c
-c $Header$
+c $Id$
 c
 cym Ne fonctionnera pas en mode parallele
@@ -19,5 +19,5 @@
          ENDDO
          DO ll=1,klev
-            znivsig(ll)=float(ll)
+            znivsig(ll)=REAL(ll)
          ENDDO
          CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
Index: /LMDZ4/trunk/libf/phylmd/ini_histmthNMC.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_histmthNMC.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_histmthNMC.h	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c$OMP MASTER
@@ -17,5 +17,5 @@
 cym         ENDDO
          DO ll=1,klev
-            znivsig(ll)=float(ll)
+            znivsig(ll)=REAL(ll)
          ENDDO
 cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
Index: /LMDZ4/trunk/libf/phylmd/ini_histrac.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_histrac.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_histrac.h	(revision 1403)
@@ -14,4 +14,7 @@
      CALL histdef(nid_tra, "aire", "Grid area", "-",              &
           iim,jj_nb,nhori, 1,1,1, -99, 32,"once",  zsto,zout)
+     CALL histdef(nid_tra, "zmasse", "column density of air in cell", &
+          "kg m-2", iim, jj_nb, nhori, klev, 1, klev, nvert, 32, "ave(X)", &
+          zsto,zout)
 
 !TRACEURS
@@ -91,8 +94,8 @@
           "inst(X)",  zout,zout)
 ! DIVERS
-     CALL histdef(nid_tra, "pplay", "flux u mont","-",     &
+     CALL histdef(nid_tra, "pplay", "pressure","-",        &
           iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
           "inst(X)", zout,zout)
-     CALL histdef(nid_tra, "t", "flux u mont","-",         &
+     CALL histdef(nid_tra, "T", "temperature","K",         &
           iim,jj_nb,nhori, klev,1,klev,nvert, 32,          &
           "inst(X)", zout,zout)
Index: /LMDZ4/trunk/libf/phylmd/ini_undefSTD.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_undefSTD.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_undefSTD.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 
Index: /LMDZ4/trunk/libf/phylmd/ini_wake.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/ini_wake.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/ini_wake.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE INI_WAKE(wape,fip,it_wape_prescr,
      :     wape_prescr, fip_prescr, alp_bl_prescr, ale_bl_prescr)
@@ -23,4 +26,6 @@
 c   wape_prescr    : valeur prescrite de la WAPE.
 c   fip_prescr     : valeur prescrite de la FIP.
+c   ale_bl_prescr  : valeur prescrite de la Ale de PBL.
+c   alp_bl_prescr  : valeur prescrite de la Alp de PBL.
 c
 c Variables internes
@@ -29,17 +34,12 @@
 c   w  = WAPE lue
 c   f  = FIP lue
+c   alebl  = Ale de PBL lue
+c   alpbl  = Alp de PBL lue
 c
+      include 'iniprint.h'
 cdeclarations
       real ale_bl_prescr
       real alp_bl_prescr
       real it
-cCR: on rajoute ale et alp de la PBL precrits
-c     open (99,file='wake.data',form='formatted')
-c     read (99,*) it
-c     read (99,*) w
-c     read (99,*) f
-c     read (99,*) u
-c     read (99,*) p
-c     close (99)
 
 ! FH A mettre si besoin dans physiq.def
@@ -48,8 +48,19 @@
       w=4.
       f=0.1
-      u=0.1
-      p=4.
+      alebl=4.
+      alpbl=0.1
 c
-      print *,' it,w ',it,w
+cCR: on rajoute ale et alp de la PBL precrits
+      open (99,file='ini_wake_param.data',form='formatted',
+     s      status='old',err=902)
+      read (99,*) it
+      read (99,*) w
+      read (99,*) f
+      read (99,*,end=901) alebl
+      read (99,*,end=901) alpbl
+901   close (99)
+902   continue
+c
+      write(lunout,*)' it,wape ',it,wape
       it_wape_prescr = it
       if (w .lt. 0) then
@@ -61,7 +72,7 @@
       endif
 c
-      print *,' u,p ',u,p
-      alp_bl_prescr=u
-      ale_bl_prescr=p
+      write(lunout,*)' alebl, alpbl ',alebl,alpbl
+      ale_bl_prescr=alebl
+      alp_bl_prescr=alpbl
       print *,'Initialisation de la poche : WAPE, FIP imposees ='
      $               ,wape_prescr, fip_prescr
Index: /LMDZ4/trunk/libf/phylmd/inifis.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/inifis.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/inifis.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE inifis(ngrid,nlayer,
@@ -45,4 +45,5 @@
 cym#include "dimphy.h"
 
+      INCLUDE 'iniprint.h'
       REAL prad,pg,pr,pcpp,punjours
  
@@ -52,4 +53,7 @@
  
       REAL ptimestep
+      CHARACTER (LEN=20) :: modname='inifis'
+      CHARACTER (LEN=80) :: abort_message
+
  
       IF (nlayer.NE.klev) THEN
@@ -58,5 +62,6 @@
          PRINT*,'nlayer     = ',nlayer
          PRINT*,'klev   = ',klev
-         STOP
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 
@@ -66,8 +71,13 @@
          PRINT*,'ngrid     = ',ngrid
          PRINT*,'klon   = ',klon
-         STOP
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 
       RETURN
-9999  STOP'Cette version demande les fichier rnatur.dat et surf.def'
+9999  continue
+      abort_message = 'Cette version demande les fichier rnatur.dat
+     & et surf.def'
+      CALL abort_gcm (modname,abort_message,1)
+
       END
Index: /LMDZ4/trunk/libf/phylmd/iniphysiq.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/iniphysiq.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/iniphysiq.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -61,4 +61,6 @@
  
       REAL ptimestep
+      CHARACTER (LEN=20) :: modname='iniphysiq'
+      CHARACTER (LEN=80) :: abort_message
  
       IF (nlayer.NE.klev) THEN
@@ -67,5 +69,6 @@
          PRINT*,'nlayer     = ',nlayer
          PRINT*,'klev   = ',klev
-         STOP
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 
@@ -75,5 +78,6 @@
          PRINT*,'ngrid     = ',ngrid
          PRINT*,'klon   = ',klon_glo
-         STOP
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 c$OMP PARALLEL PRIVATE(ibegin,iend) 
@@ -96,4 +100,8 @@
 
       RETURN
-9999  STOP'Cette version demande les fichier rnatur.dat et surf.def'
+9999  CONTINUE
+      abort_message ='Cette version demande les fichier rnatur.dat
+     & et surf.def'
+      CALL abort_gcm (modname,abort_message,1)
+
       END
Index: /LMDZ4/trunk/libf/phylmd/initphysto.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/initphysto.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/initphysto.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 C
@@ -12,4 +12,6 @@
        USE IOIPSL
        USE iophy
+       USE control_mod
+
       implicit none
 
@@ -52,5 +54,4 @@
 #include "serre.h"
 #include "indicesol.h"
-#include "control.h"
 cym#include "dimphy.h"
 
@@ -108,5 +109,5 @@
 C
 	DO l=1,llm
-            nivsigs(l)=float(l)
+            nivsigs(l)=REAL(l)
          ENDDO
 
Index: /LMDZ4/trunk/libf/phylmd/initrrnpb.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/initrrnpb.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/initrrnpb.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Id $
+! $Id$
 !
 SUBROUTINE  initrrnpb(ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr)
@@ -39,9 +39,16 @@
   REAL                                  :: s
 
+  CHARACTER (LEN=20) :: modname='initrrnpb'
+  CHARACTER (LEN=80) :: abort_message
+
+
   WRITE(*,*)'PASSAGE initrrnpb ...'
 !
 ! Radon it = 1
 !----------------
-  IF ( nbtr .LE. 0 ) STOP '**PHYTRAC:initrrnpb:** nbtr < 0; verifier RN dans traceur.def' 
+  IF ( nbtr .LE. 0 ) then
+    abort_message = '**PHYTRAC:initrrnpb:** nbtr < 0; verifier RN dans traceur.def' 
+    CALL abort_gcm (modname,abort_message,1)
+  ENDIF
   it = 1
   s = 1.E4             ! Source: atome par m2
@@ -68,5 +75,8 @@
 ! 210Pb it = 2
 !----------------
-  IF ( nbtr .LE. 1 ) STOP '**PHYTRAC**:initrrnpb:** nbtr <= 1; verifier PB dans traceur.def' 
+  IF ( nbtr .LE. 1 ) THEN
+    abort_message='**PHYTRAC**:initrrnpb:** nbtr <= 1; verifier PB dans traceur.def' 
+    CALL abort_gcm (modname,abort_message,1)
+  ENDIF
   it = 2
   s = 0.                ! Pas de source 
Index: /LMDZ4/trunk/libf/phylmd/iostart.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/iostart.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/iostart.F90	(revision 1403)
@@ -5,5 +5,5 @@
     INTEGER,SAVE :: nid_restart
     
-    INTEGER,SAVE :: idim1,idim2,idim3
+    INTEGER,SAVE :: idim1,idim2,idim3,idim4
     INTEGER,PARAMETER :: length=100
     
@@ -317,4 +317,5 @@
       ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
       ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
+      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
 
       ierr = NF90_ENDDEF(nid_restart)
@@ -386,9 +387,11 @@
     
     IF (is_mpi_root .AND. is_omp_root) THEN
-      
+
       IF (field_size==1) THEN
         idim=idim2
       ELSE IF (field_size==klev) THEN
         idim=idim3
+      ELSE IF (field_size==klevp1) THEN
+        idim=idim4
       ELSE
         PRINT *, "erreur phyredem : probleme de dimension"
@@ -467,5 +470,5 @@
          
     IF (is_mpi_root .AND. is_omp_root) THEN
-    
+
       IF (var_size/=length) THEN
         PRINT *, "erreur phyredem : probleme de dimension"
Index: /LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_data.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_data.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/mod_phys_lmdz_omp_data.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-!$Header$
+!$Id$
 !
 MODULE mod_phys_lmdz_omp_data
@@ -27,4 +27,8 @@
     INTEGER :: i
 
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
 #ifdef CPP_OMP    
     INTEGER :: OMP_GET_NUM_THREADS
@@ -51,6 +55,6 @@
      is_omp_root=.TRUE.
    ELSE
-     PRINT *,'ANORMAL : OMP_MASTER /= 0'
-     STOP
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
    ENDIF
 !$OMP END MASTER
Index: /LMDZ4/trunk/libf/phylmd/moy_undefSTD.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/moy_undefSTD.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/moy_undefSTD.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE moy_undefSTD(itap,freq_outNMC,freq_moyNMC)
Index: /LMDZ4/trunk/libf/phylmd/o3_chem_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/o3_chem_m.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/o3_chem_m.F90	(revision 1403)
@@ -0,0 +1,172 @@
+! $Id$
+module o3_chem_m
+
+  IMPLICIT none
+
+  private o3_prod
+
+contains
+
+  subroutine o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, rlat, rlon, q)
+
+    ! This procedure evolves the ozone mass fraction through a time
+    ! step taking only chemistry into account.
+
+    ! All the 2-dimensional arrays are on the partial "physics" grid.
+    ! Their shape is "(/klon, llm/)".
+    ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
+
+    use assert_m, only: assert
+    use dimphy, only: klon
+    use regr_pr_comb_coefoz_m, only: c_Mob, a4_mass, a2, r_het_interm
+
+    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
+    real, intent(in):: gmtime ! heure de la journée en fraction de jour
+    real, intent(in):: t_seri(:, :) ! (klon, llm) temperature, in K
+
+    real, intent(in):: zmasse(:, :) ! (klon, llm)
+    ! (column-density of mass of air in a cell, in kg m-2)
+    ! "zmasse(:, k)" is for layer "k".)
+
+    real, intent(in):: pdtphys ! time step for physics, in s
+
+    REAL, intent(in):: rlat(:), rlon(:)
+    ! (longitude and latitude of each horizontal position, in degrees)
+
+    real, intent(inout):: q(:, :) ! (klon, llm) mass fraction of ozone
+    ! "q(:, k)" is at middle of layer "k".)
+
+    ! Variables local to the procedure:
+    include "dimensions.h"
+    include "comconst.h"
+    ! (for "pi")
+    integer k
+
+    real c(klon, llm)
+    ! (constant term during a time step in the net mass production
+    ! rate of ozone by chemistry, per unit mass of air, in s-1)
+    ! "c(:, k)" is at middle of layer "k".)
+
+    real b(klon, llm)
+    ! (coefficient of "q" in the net mass production
+    ! rate of ozone by chemistry, per unit mass of air, in s-1)
+    ! "b(:, k)" is at middle of layer "k".)
+
+    real dq_o3_chem(klon, llm)
+    ! (variation of ozone mass fraction due to chemistry during a time step)
+    ! "dq_o3_chem(:, k)" is at middle of layer "k".)
+
+    real earth_long
+    ! (longitude vraie de la Terre dans son orbite solaire, par
+    ! rapport au point vernal (21 mars), en degrés)
+
+    real pmu0(klon) ! mean of cosine of solar zenith angle during "pdtphys"
+    real trash1
+    real trash2(klon)
+
+    !-------------------------------------------------------------
+
+    call assert(klon == (/size(q, 1), size(t_seri, 1), size(zmasse, 1), &
+         size(rlat), size(rlon)/), "o3_chem klon")
+    call assert(llm == (/size(q, 2), size(t_seri, 2), size(zmasse, 2)/), &
+         "o3_chem llm")
+
+    c = c_Mob + a4_mass * t_seri
+
+    ! Compute coefficient "b":
+
+    ! Heterogeneous chemistry is only at low temperature:
+    where (t_seri < 195.)
+       b = r_het_interm
+    elsewhere
+       b = 0.
+    end where
+
+    ! Heterogeneous chemistry is only during daytime:
+    call orbite(real(julien), earth_long, trash1)
+    call zenang(earth_long, gmtime, pdtphys, rlat, rlon, pmu0, trash2)
+    forall (k = 1: llm)
+       where (pmu0 <= cos(87. / 180. * pi)) b(:, k) = 0.
+    end forall
+
+    b = b + a2
+
+    ! Midpoint method:
+
+    ! Trial step to the midpoint:
+    dq_o3_chem = o3_prod(q, zmasse, c, b) * pdtphys  / 2
+    ! "Real" step across the whole interval:
+    dq_o3_chem = o3_prod(q + dq_o3_chem, zmasse, c, b) * pdtphys
+    q = q + dq_o3_chem
+
+    ! Confine the mass fraction:
+    q = min(max(q, 0.), .01)
+
+  end subroutine o3_chem
+
+  !*************************************************
+
+  function o3_prod(q, zmasse, c, b)
+
+    ! This function computes the production rate of ozone by chemistry.
+
+    ! All the 2-dimensional arrays are on the partial "physics" grid.
+    ! Their shape is "(/klon, llm/)".
+    ! Index "(i, :)" is for longitude "rlon(i)", latitude "rlat(i)".
+
+    use regr_pr_comb_coefoz_m, only: a6_mass
+    use assert_m, only: assert
+    use dimphy, only: klon
+
+    real, intent(in):: q(:, :) ! mass fraction of ozone
+    ! "q(:, k)" is at middle of layer "k".)
+
+    real, intent(in):: zmasse(:, :)
+    ! (column-density of mass of air in a layer, in kg m-2)
+    ! ("zmasse(:, k)" is for layer "k".)
+
+    real, intent(in):: c(:, :)
+    ! (constant term during a time step in the net mass production
+    ! rate of ozone by chemistry, per unit mass of air, in s-1)
+    ! "c(:, k)" is at middle of layer "k".)
+
+    real, intent(in):: b(:, :)
+    ! (coefficient of "q" in the net mass production rate of ozone by
+    ! chemistry, per unit mass of air, in s-1)
+    ! ("b(:, k)" is at middle of layer "k".)
+
+    include "dimensions.h"
+
+    real o3_prod(klon, llm)
+    ! (net mass production rate of ozone by chemistry, per unit mass
+    ! of air, in s-1)
+    ! ("o3_prod(:, k)" is at middle of layer "k".)
+
+    ! Variables local to the procedure:
+
+    real sigma_mass(klon, llm)
+    ! (mass column-density of ozone above point, in kg m-2)
+    ! ("sigma_mass(:, k)" is at middle of layer "k".)
+
+    integer k
+
+    !-------------------------------------------------------------------
+
+    call assert(klon == (/size(q, 1), size(zmasse, 1), size(c, 1), &
+         size(b, 1)/), "o3_prod 1")
+    call assert(llm == (/size(q, 2), size(zmasse, 2), size(c, 2), &
+         size(b, 2)/), "o3_prod 2")
+
+    ! Compute the column-density above the base of layer
+    ! "k", and, as a first approximation, take it as column-density
+    ! above the middle of layer "k":
+    sigma_mass(:, llm) = zmasse(:, llm) * q(:, llm) ! top layer
+    do k =  llm - 1, 1, -1
+       sigma_mass(:, k) = sigma_mass(:, k+1) + zmasse(:, k) * q(:, k)
+    end do
+
+    o3_prod = c + b * q + a6_mass * sigma_mass
+
+  end function o3_prod
+
+end module o3_chem_m
Index: /LMDZ4/trunk/libf/phylmd/o3cm.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/o3cm.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/o3cm.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE o3cm (amb, bmb, sortie, ntab)
@@ -19,4 +19,6 @@
 c======================================================================
       external mbtozm
+      CHARACTER (LEN=20) :: modname=''
+      CHARACTER (LEN=80) :: abort_message
 c======================================================================
 c la fonction en ligne w(x) donne le profil de l'ozone en fonction
@@ -27,6 +29,9 @@
       w(x) = wp/h * EXP((x-xp)/h)/ (con+EXP((x-xp)/h))**2
 c======================================================================
-      IF (ntab .GT. 499) STOP 'BIG ntab'
-      xincr = (bmb-amb) / FLOAT(ntab)
+      IF (ntab .GT. 499) THEN
+        abort_message = 'BIG ntab'
+        CALL abort_gcm (modname,abort_message,1)
+      ENDIF
+      xincr = (bmb-amb) / REAL(ntab)
       xtab(1) = amb
       DO n = 2, ntab
Index: /LMDZ4/trunk/libf/phylmd/orografi.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/orografi.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/orografi.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE drag_noro (nlon,nlev,dtime,paprs,pplay,
@@ -1497,4 +1497,6 @@
      *       ZDVDT(KLON)
       REAL ZHCRIT(KLON,KLEV)
+      CHARACTER (LEN=20) :: modname='orografi'
+      CHARACTER (LEN=80) :: abort_message
 C-----------------------------------------------------------------------
 C
@@ -1504,5 +1506,8 @@
       LIFTHIGH=.FALSE.
 
-      IF(NLON.NE.KLON.OR.NLEV.NE.KLEV)STOP
+      IF(NLON.NE.KLON.OR.NLEV.NE.KLEV)THEN
+        abort_message = 'pb dimension'
+        CALL abort_gcm (modname,abort_message,1)
+      ENDIF
       ZCONS1=1./RD
 cym      KLEVM1=KLEV-1
Index: /LMDZ4/trunk/libf/phylmd/orografi_strato.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/orografi_strato.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/orografi_strato.F	(revision 1403)
@@ -89,4 +89,6 @@
       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 
@@ -1680,4 +1682,7 @@
       logical lifthigh
       real zcons1,ztmst
+      CHARACTER (LEN=20) :: modname='orolift_strato'
+      CHARACTER (LEN=80) :: abort_message
+
 
 C-----------------------------------------------------------------------
@@ -1688,5 +1693,8 @@
       lifthigh=.false.
 
-      if(nlon.ne.klon.or.nlev.ne.klev)stop
+      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
Index: /LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90	(revision 1403)
@@ -22,4 +22,6 @@
   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
@@ -257,5 +259,4 @@
     INCLUDE "YOETHF.h"
     INCLUDE "temps.h"
-    INCLUDE "control.h"
 ! Input variables
 !****************************************************************************************
@@ -483,5 +484,5 @@
       
        ! Initialize ok_flux_surf (for 1D model)
-       ok_flux_surf=.FALSE.
+       if (klon>1) ok_flux_surf=.FALSE.
        
        ! Initilize debug IO
@@ -657,5 +658,5 @@
           tabindx(:)=0.
           DO i=1,knon
-             tabindx(i)=FLOAT(i)
+             tabindx(i)=REAL(i)
           END DO
           debugtab(:,:) = 0.
Index: /LMDZ4/trunk/libf/phylmd/phyetat0.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phyetat0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phyetat0.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -228,4 +228,5 @@
      $          'coherente ', i, zmasq(i), pctsrf(i, is_ter)
      $          ,pctsrf(i, is_lic)
+            WRITE(*,*) 'Je force la coherence zmasq=fractint'
             zmasq(i) = fractint(i)
         ENDIF 
@@ -238,4 +239,5 @@
      $          'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
      $          ,pctsrf(i, is_sic)
+            WRITE(*,*) 'Je force la coherence zmasq=fractint'
             zmasq(i) = fractint(i)
         ENDIF 
@@ -987,4 +989,18 @@
       PRINT*,'(ecart-type) wake_cstar:', xmin, xmax
 c
+c wake_pe
+c
+      CALL get_field("WAKE_PE",wake_pe,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <WAKE_PE> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         wake_pe=0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINval(wake_pe)
+      xmax = MAXval(wake_pe)
+      PRINT*,'(ecart-type) wake_pe:', xmin, xmax
+c
 c wake_fip
 c
@@ -1000,4 +1016,46 @@
       xmax = MAXval(wake_fip)
       PRINT*,'(ecart-type) wake_fip:', xmin, xmax
+c
+c  thermiques
+c
+
+      CALL get_field("FM_THERM",fm_therm,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <fm_therm> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         fm_therm=0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINval(fm_therm)
+      xmax = MAXval(fm_therm)
+      PRINT*,'(ecart-type) fm_therm:', xmin, xmax
+
+      CALL get_field("ENTR_THERM",entr_therm,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <entr_therm> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         entr_therm=0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINval(entr_therm)
+      xmax = MAXval(entr_therm)
+      PRINT*,'(ecart-type) entr_therm:', xmin, xmax
+
+      CALL get_field("DETR_THERM",detr_therm,found)
+      IF (.NOT. found) THEN
+         PRINT*, "phyetat0: Le champ <detr_therm> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         detr_therm=0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      xmin = MINval(detr_therm)
+      xmax = MAXval(detr_therm)
+      PRINT*,'(ecart-type) detr_therm:', xmin, xmax
+
+
+
 c
 c Read and send field trs to traclmdz
Index: /LMDZ4/trunk/libf/phylmd/phyredem.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phyredem.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phyredem.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -14,4 +14,6 @@
       USE traclmdz_mod, ONLY : traclmdz_to_restart
       USE infotrac
+      USE control_mod
+
 
       IMPLICIT none
@@ -24,5 +26,4 @@
 #include "dimsoil.h"
 #include "clesphys.h"
-#include "control.h"
 #include "temps.h"
 #include "thermcell.h"
@@ -247,23 +248,23 @@
       ENDDO
 c
-      CALL put_field("ZMEA","",zmea)
-c
-      CALL put_field("ZSTD","",zstd)
-      
-      CALL put_field("ZSIG","",zsig)
-      
-      CALL put_field("ZGAM","",zgam)
-      
-      CALL put_field("ZTHE","",zthe)
-      
-      CALL put_field("ZPIC","",zpic)
-      
-      CALL put_field("ZVAL","",zval)
+      CALL put_field("ZMEA","ZMEA",zmea)
+c
+      CALL put_field("ZSTD","ZSTD",zstd)
+      
+      CALL put_field("ZSIG","ZSIG",zsig)
+      
+      CALL put_field("ZGAM","ZGAM",zgam)
+      
+      CALL put_field("ZTHE","ZTHE",zthe)
+      
+      CALL put_field("ZPIC","ZPIC",zpic)
+      
+      CALL put_field("ZVAL","ZVAL",zval)
       
       CALL put_field("RUGSREL","RUGSREL",rugoro)
       
-      CALL put_field("TANCIEN","",t_ancien)
-      
-      CALL put_field("QANCIEN","",q_ancien)
+      CALL put_field("TANCIEN","TANCIEN",t_ancien)
+      
+      CALL put_field("QANCIEN","QANCIEN",q_ancien)
       
       CALL put_field("RUGMER","Longueur de rugosite sur mer",
@@ -298,25 +299,34 @@
 !!!!!!!!!!!!!!!!!!!! FIN TKE PBL !!!!!!!!!!!!!!!!!!!!!!!!!
 cIM ajout zmax0, f0, ema_work1, ema_work2
-cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_fip
-      
-      CALL put_field("ZMAX0","",zmax0)
-      
-      CALL put_field("F0","",f0)
-      
-      CALL put_field("EMA_WORK1","",ema_work1)
-      
-      CALL put_field("EMA_WORK2","",ema_work2)
+cIM wake_deltat, wake_deltaq, wake_s, wake_cstar, wake_pe, wake_fip
+      
+      CALL put_field("ZMAX0","ZMAX0",zmax0)
+      
+      CALL put_field("F0","F0",f0)
+      
+      CALL put_field("EMA_WORK1","EMA_WORK1",ema_work1)
+      
+      CALL put_field("EMA_WORK2","EMA_WORK2",ema_work2)
       
 c wake_deltat
-      CALL put_field("WAKE_DELTAT","",wake_deltat)
-
-      CALL put_field("WAKE_DELTAQ","",wake_deltaq)
-      
-      CALL put_field("WAKE_S","",wake_s)
-      
-      CALL put_field("WAKE_CSTAR","",wake_cstar)
-      
-      CALL put_field("WAKE_FIP","",wake_fip)
-
+      CALL put_field("WAKE_DELTAT","WAKE_DELTAT",wake_deltat)
+
+      CALL put_field("WAKE_DELTAQ","WAKE_DELTAQ",wake_deltaq)
+      
+      CALL put_field("WAKE_S","WAKE_S",wake_s)
+      
+      CALL put_field("WAKE_CSTAR","WAKE_CSTAR",wake_cstar)
+      
+      CALL put_field("WAKE_PE","WAKE_PE",wake_pe)
+
+      CALL put_field("WAKE_FIP","WAKE_FIP",wake_fip)
+
+c thermiques
+
+      CALL put_field("FM_THERM","FM_THERM",fm_therm)
+
+      CALL put_field("ENTR_THERM","ENTR_THERM",entr_therm)
+
+      CALL put_field("DETR_THERM","DETR_THERM",detr_therm)
 
 ! trs from traclmdz_mod
Index: /LMDZ4/trunk/libf/phylmd/phys_output_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phys_output_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phys_output_mod.F90	(revision 1403)
@@ -10,5 +10,5 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-MODULE phys_output_mod
+MODULE phys_output_mod 
 
   IMPLICIT NONE
@@ -60,8 +60,9 @@
   
 !!! 2D
-  type(ctrl_out),save :: o_flat         = ctrl_out((/ 5, 1, 10, 10, 5 /),'flat')
-  type(ctrl_out),save :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 10 /),'slp')
-  type(ctrl_out),save :: o_tsol         = ctrl_out((/ 1, 1, 1, 5, 10 /),'tsol')
-  type(ctrl_out),save :: o_t2m          = ctrl_out((/ 1, 1, 1, 5, 10 /),'t2m')
+
+  type(ctrl_out),save :: o_flat         = ctrl_out((/ 5, 1, 10, 5, 1 /),'flat')
+  type(ctrl_out),save :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 1 /),'slp')
+  type(ctrl_out),save :: o_tsol         = ctrl_out((/ 1, 1, 1, 5, 1 /),'tsol')
+  type(ctrl_out),save :: o_t2m          = ctrl_out((/ 1, 1, 1, 5, 1 /),'t2m')
   type(ctrl_out),save :: o_t2m_min      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_min')
   type(ctrl_out),save :: o_t2m_max      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_max')
@@ -74,8 +75,8 @@
   type(ctrl_out),save :: o_wind10max    = ctrl_out((/ 10, 1, 10, 10, 10 /),'wind10max')
   type(ctrl_out),save :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10 /),'sicf')
-  type(ctrl_out),save :: o_q2m          = ctrl_out((/ 1, 1, 1, 5, 10 /),'q2m')
-  type(ctrl_out),save :: o_u10m         = ctrl_out((/ 1, 1, 1, 5, 10 /),'u10m')
-  type(ctrl_out),save :: o_v10m         = ctrl_out((/ 1, 1, 1, 5, 10 /),'v10m')
-  type(ctrl_out),save :: o_psol         = ctrl_out((/ 1, 1, 1, 5, 10 /),'psol')
+  type(ctrl_out),save :: o_q2m          = ctrl_out((/ 1, 1, 1, 5, 1 /),'q2m')
+  type(ctrl_out),save :: o_u10m         = ctrl_out((/ 1, 1, 1, 5, 1 /),'u10m')
+  type(ctrl_out),save :: o_v10m         = ctrl_out((/ 1, 1, 1, 5, 1 /),'v10m')
+  type(ctrl_out),save :: o_psol         = ctrl_out((/ 1, 1, 1, 5, 1 /),'psol')
   type(ctrl_out),save :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10 /),'qsurf')
 
@@ -93,9 +94,9 @@
 
   type(ctrl_out),save :: o_ndayrain     = ctrl_out((/ 1, 10, 10, 10, 10 /),'ndayrain')
-  type(ctrl_out),save :: o_precip       = ctrl_out((/ 1, 1, 1, 10, 5 /),'precip')
+  type(ctrl_out),save :: o_precip       = ctrl_out((/ 1, 1, 1, 5, 10 /),'precip')
   type(ctrl_out),save :: o_plul         = ctrl_out((/ 1, 1, 1, 10, 10 /),'plul')
 
-  type(ctrl_out),save :: o_pluc         = ctrl_out((/ 1, 1, 1, 10, 5 /),'pluc')
-  type(ctrl_out),save :: o_snow         = ctrl_out((/ 1, 1, 10, 10, 5 /),'snow') 
+  type(ctrl_out),save :: o_pluc         = ctrl_out((/ 1, 1, 1, 5, 10 /),'pluc')
+  type(ctrl_out),save :: o_snow         = ctrl_out((/ 1, 1, 10, 5, 10 /),'snow') 
   type(ctrl_out),save :: o_evap         = ctrl_out((/ 1, 1, 10, 10, 10 /),'evap')
   type(ctrl_out),save,dimension(4) :: o_evap_srf     = (/ ctrl_out((/ 1, 1, 10, 10, 10 /),'evap_ter'), &
@@ -136,14 +137,14 @@
   type(ctrl_out),save :: o_soll0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'soll0')
   type(ctrl_out),save :: o_radsol       = ctrl_out((/ 1, 1, 10, 10, 10 /),'radsol')
-  type(ctrl_out),save :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 10, 5 /),'SWupSFC')
-  type(ctrl_out),save :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5 /),'SWupSFCclr')
-  type(ctrl_out),save :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 10, 5 /),'SWdnSFC') 
-  type(ctrl_out),save :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5 /),'SWdnSFCclr')
-  type(ctrl_out),save :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 5 /),'LWupSFC')
-  type(ctrl_out),save :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5 /),'LWupSFCclr')
-  type(ctrl_out),save :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 10, 5 /),'LWdnSFC')
-  type(ctrl_out),save :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 5 /),'LWdnSFCclr')
+  type(ctrl_out),save :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 5, 10 /),'SWupSFC')
+  type(ctrl_out),save :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFCclr')
+  type(ctrl_out),save :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 5, 10 /),'SWdnSFC') 
+  type(ctrl_out),save :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 5, 10 /),'SWdnSFCclr')
+  type(ctrl_out),save :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFC')
+  type(ctrl_out),save :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 5, 10 /),'LWupSFCclr')
+  type(ctrl_out),save :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 5, 10 /),'LWdnSFC')
+  type(ctrl_out),save :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 5, 10 /),'LWdnSFCclr')
   type(ctrl_out),save :: o_bils         = ctrl_out((/ 1, 2, 10, 5, 10 /),'bils')
-  type(ctrl_out),save :: o_sens         = ctrl_out((/ 1, 1, 10, 10, 5 /),'sens')
+  type(ctrl_out),save :: o_sens         = ctrl_out((/ 1, 1, 10, 5, 10 /),'sens')
   type(ctrl_out),save :: o_fder         = ctrl_out((/ 1, 2, 10, 10, 10 /),'fder')
   type(ctrl_out),save :: o_ffonte       = ctrl_out((/ 1, 10, 10, 10, 10 /),'ffonte')
@@ -215,5 +216,5 @@
   type(ctrl_out),save :: o_cldm         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldm')
   type(ctrl_out),save :: o_cldh         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldh')
-  type(ctrl_out),save :: o_cldt         = ctrl_out((/ 1, 1, 2, 10, 5 /),'cldt')
+  type(ctrl_out),save :: o_cldt         = ctrl_out((/ 1, 1, 2, 5, 10 /),'cldt')
   type(ctrl_out),save :: o_cldq         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldq')
   type(ctrl_out),save :: o_lwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'lwp')
@@ -230,15 +231,14 @@
   type(ctrl_out),save :: o_prw          = ctrl_out((/ 1, 1, 10, 10, 10 /),'prw')
 
-  type(ctrl_out),save :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_pblh')
-  type(ctrl_out),save :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_pblt')
+  type(ctrl_out),save :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 10, 1 /),'s_pblh')
+  type(ctrl_out),save :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 10, 1 /),'s_pblt')
   type(ctrl_out),save :: o_s_lcl        = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_lcl')
-  type(ctrl_out),save :: o_s_therm      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_therm')
-!IM : Les champs suivants (s_capCL, s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F
-! type(ctrl_out),save :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_capCL')
-! type(ctrl_out),save :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_oliqCL')
-! type(ctrl_out),save :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_cteiCL')
-! type(ctrl_out),save :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb1')
-! type(ctrl_out),save :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb2')
-! type(ctrl_out),save :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb3')
+  type(ctrl_out),save :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_capCL')
+  type(ctrl_out),save :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_oliqCL')
+  type(ctrl_out),save :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 10, 1 /),'s_cteiCL')
+  type(ctrl_out),save :: o_s_therm      = ctrl_out((/ 1, 10, 10, 10, 1 /),'s_therm')
+  type(ctrl_out),save :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb1')
+  type(ctrl_out),save :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb2')
+  type(ctrl_out),save :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 10, 10 /),'s_trmb3')
 
   type(ctrl_out),save :: o_slab_bils    = ctrl_out((/ 1, 1, 10, 10, 10 /),'slab_bils_oce')
@@ -357,76 +357,76 @@
   type(ctrl_out),save :: o_solswai      = ctrl_out((/ 2, 10, 10, 10, 10 /),'solswai')
 
-  type(ctrl_out),save,dimension(10) :: o_tausumaero  = (/ ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_ASBCM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_ASPOMM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_ASSO4M'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_CSSO4M'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_SSSSM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_ASSSM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_CSSSM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_CIDUSTM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_AIBCM'), &
-                                                     ctrl_out((/ 2, 6, 10, 10, 10 /),'OD550_AIPOMM') /)
-
-  type(ctrl_out),save :: o_od550aer     = ctrl_out((/ 2, 6, 10, 10, 10 /),'od550aer')
-  type(ctrl_out),save :: o_od865aer     = ctrl_out((/ 2, 6, 10, 10, 10 /),'od865aer')
-  type(ctrl_out),save :: o_absvisaer    = ctrl_out((/ 2, 6, 10, 10, 10 /),'absvisaer')
-  type(ctrl_out),save :: o_od550lt1aer  = ctrl_out((/ 2, 6, 10, 10, 10 /),'od550lt1aer')
-
-  type(ctrl_out),save :: o_sconcso4     = ctrl_out((/ 2, 6, 10, 10, 10 /),'sconcso4')
-  type(ctrl_out),save :: o_sconcoa      = ctrl_out((/ 2, 6, 10, 10, 10 /),'sconcoa')
-  type(ctrl_out),save :: o_sconcbc      = ctrl_out((/ 2, 6, 10, 10, 10 /),'sconcbc')
-  type(ctrl_out),save :: o_sconcss      = ctrl_out((/ 2, 6, 10, 10, 10 /),'sconcss')
-  type(ctrl_out),save :: o_sconcdust    = ctrl_out((/ 2, 6, 10, 10, 10 /),'sconcdust')
-  type(ctrl_out),save :: o_concso4      = ctrl_out((/ 2, 6, 10, 10, 10 /),'concso4')
-  type(ctrl_out),save :: o_concoa       = ctrl_out((/ 2, 6, 10, 10, 10 /),'concoa')
-  type(ctrl_out),save :: o_concbc       = ctrl_out((/ 2, 6, 10, 10, 10 /),'concbc')
-  type(ctrl_out),save :: o_concss       = ctrl_out((/ 2, 6, 10, 10, 10 /),'concss')
-  type(ctrl_out),save :: o_concdust     = ctrl_out((/ 2, 6, 10, 10, 10 /),'concdust')
-  type(ctrl_out),save :: o_loadso4      = ctrl_out((/ 2, 6, 10, 10, 10 /),'loadso4')
-  type(ctrl_out),save :: o_loadoa       = ctrl_out((/ 2, 6, 10, 10, 10 /),'loadoa')
-  type(ctrl_out),save :: o_loadbc       = ctrl_out((/ 2, 6, 10, 10, 10 /),'loadbc')
-  type(ctrl_out),save :: o_loadss       = ctrl_out((/ 2, 6, 10, 10, 10 /),'loadss')
-  type(ctrl_out),save :: o_loaddust     = ctrl_out((/ 2, 6, 10, 10, 10 /),'loaddust')
-
-  type(ctrl_out),save :: o_swtoaas_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoaas_nat')
-  type(ctrl_out),save :: o_swsrfas_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfas_nat')
-  type(ctrl_out),save :: o_swtoacs_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoacs_nat')
-  type(ctrl_out),save :: o_swsrfcs_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfcs_nat')
-
-  type(ctrl_out),save :: o_swtoaas_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoaas_ant')
-  type(ctrl_out),save :: o_swsrfas_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfas_ant')
-  type(ctrl_out),save :: o_swtoacs_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoacs_ant')
-  type(ctrl_out),save :: o_swsrfcs_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfcs_ant')
-
-  type(ctrl_out),save :: o_swtoacf_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoacf_nat')
-  type(ctrl_out),save :: o_swsrfcf_nat  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfcf_nat')
-  type(ctrl_out),save :: o_swtoacf_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoacf_ant')
-  type(ctrl_out),save :: o_swsrfcf_ant  = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfcf_ant')
-  type(ctrl_out),save :: o_swtoacf_zero = ctrl_out((/ 4, 6, 10, 10, 10 /),'swtoacf_zero')
-  type(ctrl_out),save :: o_swsrfcf_zero = ctrl_out((/ 4, 6, 10, 10, 10 /),'swsrfcf_zero')
-
-  type(ctrl_out),save :: o_cldncl       = ctrl_out((/ 2, 6, 10, 10, 10 /),'cldncl')
-  type(ctrl_out),save :: o_reffclwtop   = ctrl_out((/ 2, 6, 10, 10, 10 /),'reffclwtop')
-  type(ctrl_out),save :: o_cldnvi       = ctrl_out((/ 2, 6, 10, 10, 10 /),'cldnvi')
-  type(ctrl_out),save :: o_lcc          = ctrl_out((/ 2, 6, 10, 10, 10 /),'lcc')
+  type(ctrl_out),save,dimension(10) :: o_tausumaero  = (/ ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_ASBCM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_ASPOMM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_ASSO4M'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_CSSO4M'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_SSSSM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_ASSSM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_CSSSM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_CIDUSTM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_AIBCM'), &
+                                                     ctrl_out((/ 4, 4, 10, 10, 10 /),'OD550_AIPOMM') /)
+
+  type(ctrl_out),save :: o_od550aer         = ctrl_out((/ 4, 4, 10, 10, 10 /),'od550aer')
+  type(ctrl_out),save :: o_od865aer         = ctrl_out((/ 4, 4, 10, 10, 10 /),'od865aer')
+  type(ctrl_out),save :: o_absvisaer        = ctrl_out((/ 4, 4, 10, 10, 10 /),'absvisaer')
+  type(ctrl_out),save :: o_od550lt1aer      = ctrl_out((/ 4, 4, 10, 10, 10 /),'od550lt1aer')
+
+  type(ctrl_out),save :: o_sconcso4         = ctrl_out((/ 4, 4, 10, 10, 10 /),'sconcso4')
+  type(ctrl_out),save :: o_sconcoa          = ctrl_out((/ 4, 4, 10, 10, 10 /),'sconcoa')
+  type(ctrl_out),save :: o_sconcbc          = ctrl_out((/ 4, 4, 10, 10, 10 /),'sconcbc')
+  type(ctrl_out),save :: o_sconcss          = ctrl_out((/ 4, 4, 10, 10, 10 /),'sconcss')
+  type(ctrl_out),save :: o_sconcdust        = ctrl_out((/ 4, 4, 10, 10, 10 /),'sconcdust')
+  type(ctrl_out),save :: o_concso4          = ctrl_out((/ 4, 4, 10, 10, 10 /),'concso4')
+  type(ctrl_out),save :: o_concoa           = ctrl_out((/ 4, 4, 10, 10, 10 /),'concoa')
+  type(ctrl_out),save :: o_concbc           = ctrl_out((/ 4, 4, 10, 10, 10 /),'concbc')
+  type(ctrl_out),save :: o_concss           = ctrl_out((/ 4, 4, 10, 10, 10 /),'concss')
+  type(ctrl_out),save :: o_concdust         = ctrl_out((/ 4, 4, 10, 10, 10 /),'concdust')
+  type(ctrl_out),save :: o_loadso4          = ctrl_out((/ 4, 4, 10, 10, 10 /),'loadso4')
+  type(ctrl_out),save :: o_loadoa           = ctrl_out((/ 4, 4, 10, 10, 10 /),'loadoa')
+  type(ctrl_out),save :: o_loadbc           = ctrl_out((/ 4, 4, 10, 10, 10 /),'loadbc')
+  type(ctrl_out),save :: o_loadss           = ctrl_out((/ 4, 4, 10, 10, 10 /),'loadss')
+  type(ctrl_out),save :: o_loaddust         = ctrl_out((/ 4, 4, 10, 10, 10 /),'loaddust')
+
+
+  type(ctrl_out),save :: o_swtoaas_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoaas_nat')
+  type(ctrl_out),save :: o_swsrfas_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfas_nat')
+  type(ctrl_out),save :: o_swtoacs_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoacs_nat')
+  type(ctrl_out),save :: o_swsrfcs_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfcs_nat')
+
+  type(ctrl_out),save :: o_swtoaas_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoaas_ant')
+  type(ctrl_out),save :: o_swsrfas_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfas_ant')
+  type(ctrl_out),save :: o_swtoacs_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoacs_ant')
+  type(ctrl_out),save :: o_swsrfcs_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfcs_ant')
+  type(ctrl_out),save :: o_swtoacf_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoacf_nat')
+  type(ctrl_out),save :: o_swsrfcf_nat      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfcf_nat')
+  type(ctrl_out),save :: o_swtoacf_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoacf_ant')
+  type(ctrl_out),save :: o_swsrfcf_ant      = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfcf_ant')
+  type(ctrl_out),save :: o_swtoacf_zero     = ctrl_out((/ 4, 4, 10, 10, 10 /),'swtoacf_zero')
+  type(ctrl_out),save :: o_swsrfcf_zero     = ctrl_out((/ 4, 4, 10, 10, 10 /),'swsrfcf_zero')
+
+  type(ctrl_out),save :: o_cldncl          = ctrl_out((/ 4, 4, 10, 10, 10 /),'cldncl')
+  type(ctrl_out),save :: o_reffclwtop      = ctrl_out((/ 4, 4, 10, 10, 10 /),'reffclwtop')
+  type(ctrl_out),save :: o_cldnvi          = ctrl_out((/ 4, 4, 10, 10, 10 /),'cldnvi')
+  type(ctrl_out),save :: o_lcc             = ctrl_out((/ 4, 4, 10, 10, 10 /),'lcc')
 
 
 !!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  type(ctrl_out),save :: o_ec550aer     = ctrl_out((/ 2, 6, 10, 10, 10 /),'ec550aer')
-  type(ctrl_out),save :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 10 /),'lwcon')
+  type(ctrl_out),save :: o_ec550aer     = ctrl_out((/ 4,  4, 10, 10, 1 /),'ec550aer')
+  type(ctrl_out),save :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 1 /),'lwcon')
   type(ctrl_out),save :: o_iwcon        = ctrl_out((/ 2, 5, 10, 10, 10 /),'iwcon')
-  type(ctrl_out),save :: o_temp         = ctrl_out((/ 2, 3, 4, 10, 10 /),'temp')
-  type(ctrl_out),save :: o_theta        = ctrl_out((/ 2, 3, 4, 10, 10 /),'theta')
-  type(ctrl_out),save :: o_ovap         = ctrl_out((/ 2, 3, 4, 10, 10 /),'ovap')
-  type(ctrl_out),save :: o_ovapinit     = ctrl_out((/ 2, 3, 10, 10, 10 /),'ovapinit')
+  type(ctrl_out),save :: o_temp         = ctrl_out((/ 2, 3, 4, 10, 1 /),'temp')
+  type(ctrl_out),save :: o_theta        = ctrl_out((/ 2, 3, 4, 10, 1 /),'theta')
+  type(ctrl_out),save :: o_ovap         = ctrl_out((/ 2, 3, 4, 10, 1 /),'ovap')
+  type(ctrl_out),save :: o_ovapinit         = ctrl_out((/ 2, 3, 10, 10, 1 /),'ovapinit')
   type(ctrl_out),save :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10 /),'wvapp')
-  type(ctrl_out),save :: o_geop         = ctrl_out((/ 2, 3, 10, 10, 10 /),'geop')
-  type(ctrl_out),save :: o_vitu         = ctrl_out((/ 2, 3, 4, 6, 10 /),'vitu')
-  type(ctrl_out),save :: o_vitv         = ctrl_out((/ 2, 3, 4, 6, 10 /),'vitv')
-  type(ctrl_out),save :: o_vitw         = ctrl_out((/ 2, 3, 10, 6, 10 /),'vitw')
-  type(ctrl_out),save :: o_pres         = ctrl_out((/ 2, 3, 10, 10, 10 /),'pres')
-  type(ctrl_out),save :: o_paprs        = ctrl_out((/ 2, 3, 10, 10, 10 /),'paprs')
-  type(ctrl_out),save :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 10 /),'rneb')
-  type(ctrl_out),save :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 10 /),'rnebcon')
+  type(ctrl_out),save :: o_geop         = ctrl_out((/ 2, 3, 10, 10, 1 /),'geop')
+  type(ctrl_out),save :: o_vitu         = ctrl_out((/ 2, 3, 4, 5, 1 /),'vitu')
+  type(ctrl_out),save :: o_vitv         = ctrl_out((/ 2, 3, 4, 5, 1 /),'vitv')
+  type(ctrl_out),save :: o_vitw         = ctrl_out((/ 2, 3, 10, 5, 1 /),'vitw')
+  type(ctrl_out),save :: o_pres         = ctrl_out((/ 2, 3, 10, 10, 1 /),'pres')
+  type(ctrl_out),save :: o_paprs        = ctrl_out((/ 2, 3, 10, 10, 1 /),'paprs')
+  type(ctrl_out),save :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 1 /),'rneb')
+  type(ctrl_out),save :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 1 /),'rnebcon')
   type(ctrl_out),save :: o_rhum         = ctrl_out((/ 2, 5, 10, 10, 10 /),'rhum')
   type(ctrl_out),save :: o_ozone        = ctrl_out((/ 2, 10, 10, 10, 10 /),'ozone')
@@ -441,10 +441,10 @@
   type(ctrl_out),save :: o_re           = ctrl_out((/ 5, 10, 10, 10, 10 /),'re')
   type(ctrl_out),save :: o_fl           = ctrl_out((/ 5, 10, 10, 10, 10 /),'fl')
-  type(ctrl_out),save :: o_scdnc        = ctrl_out((/ 2,  6, 10, 10, 10 /),'scdnc')
-  type(ctrl_out),save :: o_reffclws     = ctrl_out((/ 2,  6, 10, 10, 10 /),'reffclws')
-  type(ctrl_out),save :: o_reffclwc     = ctrl_out((/ 2,  6, 10, 10, 10 /),'reffclwc')
-  type(ctrl_out),save :: o_lcc3d        = ctrl_out((/ 2,  6, 10, 10, 10 /),'lcc3d')
-  type(ctrl_out),save :: o_lcc3dcon     = ctrl_out((/ 2,  6, 10, 10, 10 /),'lcc3dcon')
-  type(ctrl_out),save :: o_lcc3dstra    = ctrl_out((/ 2,  6, 10, 10, 10 /),'lcc3dstra')
+  type(ctrl_out),save :: o_scdnc        =ctrl_out((/ 4,  4, 10, 10, 1 /),'scdnc')
+  type(ctrl_out),save :: o_reffclws     =ctrl_out((/ 4,  4, 10, 10, 1 /),'reffclws')
+  type(ctrl_out),save :: o_reffclwc     =ctrl_out((/ 4,  4, 10, 10, 1 /),'reffclwc')
+  type(ctrl_out),save :: o_lcc3d        =ctrl_out((/ 4,  4, 10, 10, 1 /),'lcc3d')
+  type(ctrl_out),save :: o_lcc3dcon     =ctrl_out((/ 4,  4, 10, 10, 1 /),'lcc3dcon')
+  type(ctrl_out),save :: o_lcc3dstra    =ctrl_out((/ 4,  4, 10, 10, 1 /),'lcc3dstra')
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -464,6 +464,6 @@
                                                      ctrl_out((/ 3, 4, 10, 10, 10 /),'rugs_sic') /)
 
-  type(ctrl_out),save :: o_alb1         = ctrl_out((/ 3, 10, 10, 10, 10 /),'alb1')
-  type(ctrl_out),save :: o_alb2       = ctrl_out((/ 3, 10, 10, 10, 10 /),'alb2')
+  type(ctrl_out),save :: o_alb1         = ctrl_out((/ 3, 10, 10, 10, 10 /),'albs')
+  type(ctrl_out),save :: o_alb2       = ctrl_out((/ 3, 10, 10, 10, 10 /),'albslw')
 
   type(ctrl_out),save :: o_clwcon       = ctrl_out((/ 4, 10, 10, 10, 10 /),'clwcon')
@@ -471,10 +471,10 @@
   type(ctrl_out),save :: o_dnwd         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd')
   type(ctrl_out),save :: o_dnwd0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd0')
-  type(ctrl_out),save :: o_mc           = ctrl_out((/ 4, 5, 10, 10, 10 /),'mc')
+  type(ctrl_out),save :: o_mc           = ctrl_out((/ 4, 10, 10, 10, 10 /),'mc')
   type(ctrl_out),save :: o_ftime_con    = ctrl_out((/ 4, 10, 10, 10, 10 /),'ftime_con')
-  type(ctrl_out),save :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtdyn')
-  type(ctrl_out),save :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqdyn')
-  type(ctrl_out),save :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dudyn')  !AXC
-  type(ctrl_out),save :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvdyn')  !AXC
+  type(ctrl_out),save :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtdyn')
+  type(ctrl_out),save :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqdyn')
+  type(ctrl_out),save :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dudyn')  !AXC
+  type(ctrl_out),save :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dvdyn')  !AXC
   type(ctrl_out),save :: o_dtcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtcon')
   type(ctrl_out),save :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ducon')
@@ -504,5 +504,5 @@
   type(ctrl_out),save :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'w_th')
   type(ctrl_out),save :: o_lambda_th    = ctrl_out((/ 10, 10, 10, 10, 10 /),'lambda_th')
-  type(ctrl_out),save :: o_ftime_th     = ctrl_out((/ 4, 10, 10, 10, 10 /),'ftime_th')
+  type(ctrl_out),save :: o_ftime_th     = ctrl_out((/ 10, 10, 10, 10, 10 /),'ftime_th')
   type(ctrl_out),save :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'q_th')
   type(ctrl_out),save :: o_a_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'a_th')
@@ -524,8 +524,5 @@
   type(ctrl_out),save :: o_dulif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dulif')
   type(ctrl_out),save :: o_dvlif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvlif')
-
-! Attention a refaire correctement
-  type(ctrl_out),save,dimension(2) :: o_trac         = (/ ctrl_out((/ 4, 10, 10, 10, 10 /),'trac01'), &
-                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'trac02') /)
+  type(ctrl_out),save,allocatable :: o_trac(:)
     CONTAINS
 
@@ -602,10 +599,14 @@
   real, dimension(nfiles), save     :: phys_out_latmin        = (/ -90., -90., -90., -90., -90. /)
   real, dimension(nfiles), save     :: phys_out_latmax        = (/ 90., 90., 90., 90., 90. /)
-  
-  
-
-! 
+
+!IM definition dynamique flag o_trac pour sortie traceurs
+  INTEGER :: nq
+  CHARACTER(len=8) :: solsym(nqtot)
+
    print*,'Debut phys_output_mod.F90'
 ! Initialisations (Valeurs par defaut
+
+   if (.not. allocated(o_trac)) ALLOCATE(o_trac(nqtot))
+
    levmax = (/ klev, klev, klev, klev, klev /)
 
@@ -903,6 +904,4 @@
   CALL histdef2d(iff,o_absvisaer%flag,o_absvisaer%name, "Absorption aerosol visible optical depth", "-")
   CALL histdef2d(iff,o_od550lt1aer%flag,o_od550lt1aer%name, "Fine mode optical depth", "-")
-
-
   CALL histdef2d(iff,o_sconcso4%flag,o_sconcso4%name,"Surface Concentration of Sulfate ","kg/m3")
   CALL histdef2d(iff,o_sconcoa%flag,o_sconcoa%name,"Surface Concentration of Organic Aerosol ","kg/m3")
@@ -1224,12 +1223,22 @@
      ENDIF
 
-      if (nqtot>=3) THEN
-!Attention    DO iq=3,nqtot
-    DO iq=3,4  
+!IM traceurs dynamiques
+    DO nq=1,nqtot
+      IF(nq.LT.10) THEN
+       WRITE(solsym(nq),'(i1)') nq
+       o_trac(nq)    =  ctrl_out((/ 4, 5, 1, 1, 1 /),'trac0'//TRIM(solsym(nq)))
+      ELSE
+       WRITE(solsym(nq),'(i2)') nq
+       o_trac(nq)    =  ctrl_out((/ 4, 5, 1, 1, 1 /),'trac'//TRIM(solsym(nq)))
+      ENDIF
+     WRITE(*,*) 'nq, o_trac(nq)=',nq, o_trac(nq)
+    ENDDO
+!
+    if (nqtot>=3) THEN
+     DO iq=3,nqtot  
        iiq=niadv(iq)
-! CALL histdef3d (iff, o_trac%flag,'o_'//tnom(iq)%name,ttext(iiq), "-" )
   CALL histdef3d (iff, o_trac(iq-2)%flag,o_trac(iq-2)%name,ttext(iiq), "-" )
-    ENDDO
-      endif
+     ENDDO
+    endif
 
         CALL histend(nid_files(iff))
Index: /LMDZ4/trunk/libf/phylmd/phys_output_write.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phys_output_write.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phys_output_write.h	(revision 1403)
@@ -1423,5 +1423,4 @@
        ENDIF
 
-!IM   ENDIF !iflag_thermals
 
        IF (o_f0_th%flag(iff)<=lev_files(iff)) THEN
@@ -1509,14 +1508,12 @@
         ENDIF
 
-!       IF (o_trac%flag(iff)<=lev_files(iff)) THEN
-         if (nqtot.GE.3) THEN
-!           DO iq=3,nqtot
-           DO iq=3,4
+        if (nqtot.GE.3) THEN
+         DO iq=3,nqtot
        IF (o_trac(iq-2)%flag(iff)<=lev_files(iff)) THEN
          CALL histwrite_phy(nid_files(iff),
      s                  o_trac(iq-2)%name,itau_w,qx(:,:,iq))
        ENDIF
-           ENDDO
-         endif
+         ENDDO
+        endif
 
       if (ok_sync) then
Index: /LMDZ4/trunk/libf/phylmd/phys_state_var_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phys_state_var_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phys_state_var_mod.F90	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       MODULE phys_state_var_mod
 ! Variables sauvegardees pour le startphy.nc
@@ -201,4 +204,5 @@
 ! wake_Cstar  : vitesse d'etalement de la poche
 ! wake_s      : fraction surfacique occupee par la poche froide
+! wake_pe     : wake potential energy - WAPE
 ! wake_fip    : Gust Front Impinging power - ALP
 ! dt_wake, dq_wake: LS tendencies due to wake
@@ -211,4 +215,6 @@
       REAL,ALLOCATABLE,SAVE :: wake_s(:)
 !$OMP THREADPRIVATE(wake_s)
+      REAL,ALLOCATABLE,SAVE :: wake_pe(:)
+!$OMP THREADPRIVATE(wake_pe)
       REAL,ALLOCATABLE,SAVE :: wake_fip(:)
 !$OMP THREADPRIVATE(wake_fip)
@@ -321,4 +327,5 @@
 SUBROUTINE phys_state_var_init(read_climoz)
 use dimphy
+USE control_mod
 use aero_mod
 IMPLICIT NONE
@@ -333,5 +340,4 @@
 
 #include "indicesol.h"
-#include "control.h"
       ALLOCATE(rlat(klon), rlon(klon))
       ALLOCATE(pctsrf(klon,nbsrf))
@@ -416,5 +422,6 @@
       ALLOCATE(wght_th(klon,klev))
       ALLOCATE(wake_deltat(klon,klev), wake_deltaq(klon,klev))
-      ALLOCATE(wake_Cstar(klon), wake_s(klon), wake_fip(klon))
+      ALLOCATE(wake_Cstar(klon), wake_s(klon))
+      ALLOCATE(wake_pe(klon), wake_fip(klon))
       ALLOCATE(dt_wake(klon,klev), dq_wake(klon,klev))
       ALLOCATE(pfrac_impa(klon,klev), pfrac_nucl(klon,klev))
@@ -457,7 +464,7 @@
 SUBROUTINE phys_state_var_end
 use dimphy
+use control_mod
 IMPLICIT NONE
 #include "indicesol.h"
-#include "control.h"
 
       deallocate(rlat, rlon, pctsrf, ftsol, falb1, falb2)
@@ -516,5 +523,5 @@
       deallocate(lalim_conv, wght_th)
       deallocate(wake_deltat, wake_deltaq)
-      deallocate(wake_Cstar, wake_s, wake_fip)
+      deallocate(wake_Cstar, wake_s, wake_pe, wake_fip)
       deallocate(dt_wake, dq_wake)
       deallocate(pfrac_impa, pfrac_nucl)
Index: /LMDZ4/trunk/libf/phylmd/physiq.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/physiq.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/physiq.F	(revision 1403)
@@ -41,4 +41,6 @@
       use conf_phys_m, only: conf_phys
       use radlwsw_m, only: radlwsw
+      USE control_mod
+
 
       IMPLICIT none
@@ -99,5 +101,4 @@
 #include "dimsoil.h"
 #include "clesphys.h"
-#include "control.h"
 #include "temps.h"
 #include "iniprint.h"
@@ -216,4 +217,6 @@
       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)
 c
 cIM Amip2 PV a theta constante 
@@ -258,5 +261,5 @@
       CHARACTER*4 bb2
       CHARACTER*2 bb3
-c 
+
       real twriteSTD(klon,nlevSTD,nfiles)
       real qwriteSTD(klon,nlevSTD,nfiles)
@@ -473,5 +476,5 @@
 c
 c cnameisccp
-      CHARACTER *27 cnameisccp(lmaxm1,kmaxm1)
+      CHARACTER *29 cnameisccp(lmaxm1,kmaxm1)
 cIM bad 151205     DATA cnameisccp/'pc< 50hPa, tau< 0.3', 
       DATA cnameisccp/'pc= 50-180hPa, tau< 0.3',
@@ -639,5 +642,6 @@
       REAL q_undi(klon,klev)               ! humidite moyenne dans la zone non perturbee
 c
-      REAL wake_pe(klon)              ! Wake potential energy - WAPE 
+cjyg
+ccc      REAL wake_pe(klon)              ! Wake potential energy - WAPE 
 
       REAL wake_gfl(klon)             ! Gust Front Length
@@ -655,4 +659,7 @@
       REAL dt_a(klon,klev)
       REAL dq_a(klon,klev)
+      REAL, SAVE :: alp_offset
+c$OMP THREADPRIVATE(alp_offset)
+
 c
 cRR:fin declarations poches froides
@@ -660,5 +667,9 @@
 
       REAL zw2(klon,klev+1)
-      REAL fraca(klon,klev+1)
+      REAL fraca(klon,klev+1)        
+      REAL ztv(klon,klev) 
+      REAL zpspsk(klon,klev)
+      REAL ztla(klon,klev) 
+      REAL zthl(klon,klev)
 
 c Variables locales pour la couche limite (al1):
@@ -1217,5 +1228,6 @@
      .     iflag_thermals_ed,iflag_thermals_optflux,
 c     nv flags pour la convection et les poches froides
-     .     iflag_coupl,iflag_clos,iflag_wake, read_climoz)
+     .     iflag_coupl,iflag_clos,iflag_wake, read_climoz,
+     &     alp_offset)
       call phys_state_var_init(read_climoz)
       call phys_output_var_init
@@ -1239,6 +1251,7 @@
 c         pmflxr=0.
 c         pmflxs=0.
-          itau_con=0
-	first=.false.
+
+        itau_con=0
+        first=.false.
 
       endif  ! first
@@ -1263,5 +1276,5 @@
 ! Gestion calendrier : mise a jour du module phys_cal_mod
 !
-cIM     CALL phys_cal_update(jD_cur,jH_cur)
+c     CALL phys_cal_update(jD_cur,jH_cur)
 
 c
@@ -1386,5 +1399,5 @@
          ENDIF
 c
-         IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN 
+         IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN 
            WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
            WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
@@ -1496,5 +1509,6 @@
      &                        type_ocean,iflag_pbl,ok_mensuel,ok_journe,
      &                        ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, 
-     &                        read_climoz, new_aod, aerosol_couple)
+     &                        read_climoz, new_aod, aerosol_couple
+     &                        )
 c$OMP END MASTER
 c$OMP BARRIER
@@ -1558,6 +1572,6 @@
          CALL VTb(VTinca)
 !         iii = MOD(NINT(xjour),360)
-!         calday = FLOAT(iii) + jH_cur
-         calday = FLOAT(days_elapsed) + jH_cur
+!         calday = REAL(iii) + jH_cur
+         calday = REAL(days_elapsed) + jH_cur
          WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
 
@@ -1841,5 +1855,5 @@
 !   solarlong0
         if (solarlong0<-999.) then
-           CALL orbite(FLOAT(days_elapsed+1),zlongi,dist)
+           CALL orbite(REAL(days_elapsed+1),zlongi,dist)
         else
            zlongi=solarlong0  ! longitude solaire vraie
@@ -1852,5 +1866,5 @@
 !  Avec ou sans cycle diurne
       IF (cycle_diurne) THEN
-        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
+        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
         CALL zenang(zlongi,jH_cur,zdtime,rlat,rlon,rmu0,fract)
       ELSE
@@ -1862,5 +1876,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
@@ -1919,5 +1933,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
@@ -2001,5 +2015,6 @@
 
       IF (iflag_con.EQ.1) THEN
-          stop'reactiver le call conlmd dans physiq.F'
+        abort_message ='reactiver le call conlmd dans physiq.F'
+        CALL abort_gcm (modname,abort_message,1)
 c     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
 c    .             d_t_con, d_q_con,
@@ -2059,17 +2074,29 @@
 c
 ccalcul de ale_wake et alp_wake
-       do i = 1,klon
-          if (iflag_wake.eq.1) then
-          ale_wake(i) = 0.5*wake_cstar(i)**2
-          alp_wake(i) = wake_fip(i)
-          else
-          ale_wake(i) = 0.
-          alp_wake(i) = 0.
-          endif
-       enddo
+       if (iflag_wake.eq.1) then
+         if (itap .le. it_wape_prescr) then
+          do i = 1,klon
+           ale_wake(i) = wape_prescr
+           alp_wake(i) = fip_prescr
+          enddo
+         else
+          do i = 1,klon
+cjyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
+ccc           ale_wake(i) = 0.5*wake_cstar(i)**2
+           ale_wake(i) = wake_pe(i)
+           alp_wake(i) = wake_fip(i)
+          enddo
+         endif
+       else
+         do i = 1,klon
+           ale_wake(i) = 0.
+           alp_wake(i) = 0.
+         enddo
+       endif
 ccombinaison avec ale et alp de couche limite: constantes si pas de couplage, valeurs calculees
 cdans le thermique sinon
        if (iflag_coupl.eq.0) then
-          if (debut) print*,'ALE et ALP imposes'
+          if (debut.and.prt_level.gt.9)
+     $                     WRITE(lunout,*)'ALE et ALP imposes'
           do i = 1,klon
 con ne couple que ale
@@ -2082,10 +2109,31 @@
        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))
-              ALP(i) = alp_wake(i) + Alp_bl(i)
-c         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
-c         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
-          enddo
+!         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
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Modif FH 2010/04/27. Sans doute temporaire.
+! Deux options pour le alp_offset : constant si >Ã 0 ou proportionnel Ãa
+! w si <0
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+       do i = 1,klon
+          ALE(i) = max(ale_wake(i),Ale_bl(i))
+          if (alp_offset>=0.) then
+            ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
+          else
+            ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
+            if (alp(i)<0.) then
+               print*,'ALP ',alp(i),alp_wake(i)
+     s         ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
+            endif
+          endif
+       enddo
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
        endif
        do i=1,klon
@@ -2224,5 +2272,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
@@ -2246,7 +2294,7 @@
           za = 0.0
           DO i = 1, klon
-            za = za + airephy(i)/FLOAT(klon)
+            za = za + airephy(i)/REAL(klon)
             zx_t = zx_t + (rain_con(i)+
-     .                   snow_con(i))*airephy(i)/FLOAT(klon)
+     .                   snow_con(i))*airephy(i)/REAL(klon)
           ENDDO
           zx_t = zx_t/za*dtime
@@ -2328,4 +2376,19 @@
 
       endif
+c
+c===================================================================
+cJYG
+      IF (ip_ebil_phy.ge.2) THEN 
+        ztit='after wake'
+        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
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
 c      print*,'apres callwake iflag_cldcon=', iflag_cldcon
 c
@@ -2347,7 +2410,7 @@
       clwcon0th(:,:)=0.
 c
-      fm_therm(:,:)=0.
-      entr_therm(:,:)=0.
-      detr_therm(:,:)=0.
+c      fm_therm(:,:)=0.
+c      entr_therm(:,:)=0.
+c      detr_therm(:,:)=0.
 c
       IF(prt_level>9)WRITE(lunout,*)
@@ -2377,6 +2440,18 @@
      s      ,ratqsdiff,zqsatth
 con rajoute ale et alp, et les caracteristiques de la couche alim
-     s      ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca)
+     s      ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca
+     s      ,ztv,zpspsk,ztla,zthl)
+
+! ----------------------------------------------------------------------
+! Transport de la TKE par les panaches thermiques.
+! FH : 2010/02/01
+      if (iflag_pbl.eq.10) then
+      call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
+     s           rg,paprs,pbl_tke)
+      endif
+! ----------------------------------------------------------------------
+
          endif
+
 
 
@@ -2430,4 +2505,9 @@
      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
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 
@@ -2478,5 +2558,7 @@
          enddo
          tau_overturning_th(:)=zmax_th(:)/max(0.5*wmax_th(:),0.1)
-         print*,'TAU TH OK ',tau_overturning_th(1),detr_therm(1,3)
+         if(prt_level.ge.9)
+     &     write(lunout,*)'TAU TH OK ',
+     &     tau_overturning_th(1),detr_therm(1,3)
 
 c On impose que l'air autour de la fraction couverte par le thermique
@@ -2589,5 +2671,6 @@
 
 !   les ratqs sont une combinaison de ratqss et ratqsc
-!       print*,'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
+       if(prt_level.ge.9)
+     $       write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
 
          if (tau_ratqs>1.e-10) then
@@ -2620,5 +2703,6 @@
      .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
      .           frac_impa, frac_nucl,
-     .           prfl, psfl, rhcl)
+     .           prfl, psfl, rhcl, 
+     .           zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon )
 
       WHERE (rain_lsc < 0) rain_lsc = 0.
@@ -2640,7 +2724,7 @@
          za = 0.0
          DO i = 1, klon
-            za = za + airephy(i)/FLOAT(klon)
+            za = za + airephy(i)/REAL(klon)
             zx_t = zx_t + (rain_lsc(i)
-     .                  + snow_lsc(i))*airephy(i)/FLOAT(klon)
+     .                  + snow_lsc(i))*airephy(i)/REAL(klon)
         ENDDO
          zx_t = zx_t/za*dtime
@@ -2664,5 +2748,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
@@ -2741,4 +2825,7 @@
      &        tausum_aero, tau3d_aero)
       ELSE
+cIM 170310 BEG
+         tausum_aero(:,:,:) = 0.
+cIM 170310 END
          tau_aero(:,:,:,:) = 0.
          piz_aero(:,:,:,:) = 0.
@@ -2813,4 +2900,9 @@
      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
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 c
@@ -2845,7 +2937,7 @@
        IF (thermcep) THEN
         IF(zt2m(i).LT.RTT) then
-	 Lheat=RLSTT
-	ELSE
-	 Lheat=RLVTT
+         Lheat=RLSTT
+        ELSE
+         Lheat=RLVTT
         ENDIF
        ELSE
@@ -2853,5 +2945,5 @@
          Lheat=RLSTT
         ELSE
-	 Lheat=RLVTT
+         Lheat=RLVTT
         ENDIF
        ENDIF
@@ -2864,5 +2956,5 @@
          CALL VTe(VTphysiq)
          CALL VTb(VTinca)
-         calday = FLOAT(days_elapsed + 1) + jH_cur
+         calday = REAL(days_elapsed + 1) + jH_cur
 
          call chemtime(itap+itau_phy-1, date0, dtime)
@@ -2908,6 +3000,6 @@
      $                          cdragm,
      $                          pctsrf,
-     $				pdtphys,
-     $				itap)
+     $                          pdtphys,
+     $                            itap)
 
          CALL VTe(VTinca)
@@ -2964,5 +3056,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+       call writefield_phy('q_seri',q_seri,llm)
       endif
       
@@ -3020,5 +3112,5 @@
       itaprad = itaprad + 1
 
-      if (iflag_radia.eq.0) then
+      if (iflag_radia.eq.0 .and. prt_level.ge.9) then
       print *,'--------------------------------------------------'
       print *,'>>>> ATTENTION rayonnement desactive pour ce cas'
@@ -3043,5 +3135,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
  
@@ -3124,5 +3216,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
       
@@ -3188,5 +3280,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
@@ -3223,4 +3315,9 @@
      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
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 c
@@ -3292,5 +3389,6 @@
       IF (offline) THEN
 
-         print*,'Attention on met a 0 les thermiques pour phystoke'
+       IF (prt_level.ge.9)
+     $    print*,'Attention on met a 0 les thermiques pour phystoke'
 	 call phystokenc (
      I                   nlon,klev,pdtphys,rlon,rlat,
@@ -3400,4 +3498,5 @@
 c
 cIM initialisation 5eme fichier de sortie 
+cIM ajoute 5eme niveau 170310 BEG
       twriteSTD(:,:,5)=tlevSTD(:,:)
       qwriteSTD(:,:,5)=qlevSTD(:,:)
@@ -3484,5 +3583,5 @@
         call writefield_phy('v_seri',v_seri,llm)
         call writefield_phy('t_seri',t_seri,llm)
-	call writefield_phy('q_seri',q_seri,llm)
+        call writefield_phy('q_seri',q_seri,llm)
       endif
 
Index: /LMDZ4/trunk/libf/phylmd/phystokenc.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phystokenc.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phystokenc.F	(revision 1403)
@@ -13,4 +13,6 @@
       USE infotrac, ONLY : nqtot
       USE iophy
+      USE control_mod
+
       IMPLICIT none
 
@@ -24,5 +26,4 @@
 #include "tracstoke.h"
 #include "indicesol.h"
-#include "control.h"
 c======================================================================
 
Index: /LMDZ4/trunk/libf/phylmd/phytrac.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/phytrac.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/phytrac.F90	(revision 1403)
@@ -33,4 +33,6 @@
   USE traclmdz_mod
   USE tracinca_mod
+  USE control_mod
+
 
 
@@ -43,5 +45,4 @@
   INCLUDE "temps.h"
   INCLUDE "paramet.h"
-  INCLUDE "control.h"
   INCLUDE "thermcell.h"
 !==========================================================================
@@ -212,5 +213,6 @@
      SELECT CASE(type_trac)
      CASE('lmdz')
-        CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
+!IM ajout t_seri, pplay, sh    CALL traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
+        CALL traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage)
      CASE('inca')
         source(:,:)=0.
@@ -226,4 +228,10 @@
 !############################################ END INITIALIZATION #######
 
+  DO k=1,klev
+     DO i=1,klon
+        zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
+     END DO
+  END DO
+
 !===============================================================================
 !    -- Do specific treatment according to chemestry model or local LMDZ tracers
@@ -234,10 +242,7 @@
      !    -- Traitement des traceurs avec traclmdz
      
-     CALL traclmdz(&
-          nstep,    pdtphys,      t_seri,           &
-          paprs,    pplay,        cdragh,  coefh,   &
-          yu1,      yv1,          ftsol,   pctsrf,  &
-          xlat,     couchelimite,                   &
-          tr_seri,  source,       solsym,  d_tr_cl)
+     CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
+          cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, &
+          sh, tr_seri, source, solsym, d_tr_cl, zmasse)
      
   CASE('inca')
@@ -276,4 +281,7 @@
         END IF
 
+!IM ajout traceurs RR 
+!      print*,'phytrac it,nseuil=',it,nseuil
+       IF (it.lt.nseuil) THEN
         DO k = 1, klev
            DO i = 1, klon        
@@ -281,4 +289,5 @@
            END DO
         END DO
+       END IF !(it.lt.nseuil) then
 
         CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it))
@@ -290,10 +299,4 @@
 !    -- Calcul de l'effet des thermiques --
 !======================================================================
-
-  DO k=1,klev
-     DO i=1,klon
-        zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
-     END DO
-  END DO
 
   DO it=1,nbtr
Index: /LMDZ4/trunk/libf/phylmd/press_coefoz_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/press_coefoz_m.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/press_coefoz_m.F90	(revision 1403)
@@ -0,0 +1,72 @@
+! $Id$
+module press_coefoz_m
+
+  implicit none
+
+  real, pointer, save:: plev(:)
+  ! (pressure level of Mobidic input data, converted to Pa, in strictly
+  ! ascending order)
+
+  real, allocatable, save:: press_in_edg(:)
+  ! (edges of pressure intervals for Mobidic input data, in Pa, in strictly
+  ! ascending order)
+
+contains
+
+  subroutine press_coefoz
+
+    ! This procedure is called once per "gcm" run.
+    ! A single thread of the root process reads the pressure levels
+    ! from "coefoz_LMDZ.nc" and broadcasts them to the other processes.
+
+    ! We assume that, in "coefoz_LMDZ.nc", the pressure levels are in hPa
+    ! and in strictly ascending order.
+
+    use netcdf95, only: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
+    use netcdf, only: nf90_nowrite
+
+    use mod_phys_lmdz_mpi_data, only: is_mpi_root
+    use mod_phys_lmdz_mpi_transfert, only: bcast_mpi ! broadcast
+
+    ! Variables local to the procedure:
+    integer ncid, varid ! for NetCDF
+    integer n_plev ! number of pressure levels in the input data
+    integer k
+
+    !---------------------------------------
+
+    !$omp single
+    print *, "Call sequence information: press_coefoz"
+
+    if (is_mpi_root) then
+       call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
+
+       call nf95_inq_varid(ncid, "plev", varid)
+       call nf95_gw_var(ncid, varid, plev)
+       ! Convert from hPa to Pa because "paprs" and "pplay" are in Pa:
+       plev = plev * 100.
+       n_plev = size(plev)
+
+       call nf95_close(ncid)
+    end if
+
+    call bcast_mpi(n_plev)
+    if (.not. is_mpi_root) allocate(plev(n_plev))
+    call bcast_mpi(plev)
+    
+    ! Compute edges of pressure intervals:
+    allocate(press_in_edg(n_plev + 1))
+    if (is_mpi_root) then
+       press_in_edg(1) = 0.
+       ! We choose edges halfway in logarithm:
+       forall (k = 2:n_plev) press_in_edg(k) = sqrt(plev(k - 1) * plev(k))
+       press_in_edg(n_plev + 1) = huge(0.)
+       ! (infinity, but any value guaranteed to be greater than the
+       ! surface pressure would do)
+    end if
+    call bcast_mpi(press_in_edg)
+    !$omp end single
+
+  end subroutine press_coefoz
+
+end module press_coefoz_m
Index: /LMDZ4/trunk/libf/phylmd/printflag.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/printflag.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/printflag.F	(revision 1403)
@@ -85,5 +85,5 @@
        IF( INT( tabcntr0( 6 ) ) .NE. nbapp_rad  )   THEN
         PRINT 21,  INT(tabcntr0(6)), nbapp_rad
-        radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
+!        radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
         PRINT 100
         PRINT 22, radpas0, radpas
Index: /LMDZ4/trunk/libf/phylmd/read_pstoke.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/read_pstoke.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/read_pstoke.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -18,6 +18,8 @@
 C******************************************************************************
 
-	use netcdf
-       USE dimphy
+      use netcdf
+      USE dimphy
+      USE control_mod
+
        IMPLICIT NONE
 
@@ -33,5 +35,4 @@
 #include "serre.h"
 #include "indicesol.h"
-#include "control.h"
 cccc#include "dimphy.h"
 	
Index: /LMDZ4/trunk/libf/phylmd/read_pstoke0.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/read_pstoke0.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/read_pstoke0.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 c
@@ -19,4 +19,6 @@
 	use netcdf
        USE dimphy
+       USE control_mod
+
        IMPLICIT NONE
 
@@ -32,5 +34,4 @@
 #include "serre.h"
 #include "indicesol.h"
-#include "control.h"
 cccc#include "dimphy.h"
 	  
Index: /LMDZ4/trunk/libf/phylmd/readaerosol.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/readaerosol.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/readaerosol.F90	(revision 1403)
@@ -137,5 +137,5 @@
                  DO i = 1, klon
                     pt_out(i,k,it) = &
-                         pt_out(i,k,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
+                         pt_out(i,k,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
                          (pt_out(i,k,it) - pt_2(i,k,it))
                  END DO
@@ -144,9 +144,9 @@
               DO i = 1, klon
                  psurf(i,it) = &
-                      psurf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
+                      psurf(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
                       (psurf(i,it) - psurf2(i,it))
 
                  load(i,it) = &
-                      load(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &
+                      load(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * &
                       (load(i,it) - load2(i,it))
               END DO
@@ -514,6 +514,6 @@
                 spole = spole + varyear(i,jjm+1,k,imth)
              END DO
-             npole = npole/FLOAT(iim)
-             spole = spole/FLOAT(iim)
+             npole = npole/REAL(iim)
+             spole = spole/REAL(iim)
              varyear(:,1,    k,imth) = npole
              varyear(:,jjm+1,k,imth) = spole
Index: /LMDZ4/trunk/libf/phylmd/readaerosol_interp.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/readaerosol_interp.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/readaerosol_interp.F90	(revision 1403)
@@ -127,8 +127,8 @@
   IF(mpi_rank == 0 .AND. debug)then
      ! 0.02 is about 0.5/24, namly less than half an hour
-     OLDNEWDAY = (r_day-FLOAT(iday) < 0.02)
+     OLDNEWDAY = (r_day-REAL(iday) < 0.02)
      ! Once per day, update aerosol fields
      lmt_pas = NINT(86400./pdtphys)
-     PRINT*,'r_day-FLOAT(iday) =',r_day-FLOAT(iday) 
+     PRINT*,'r_day-REAL(iday) =',r_day-REAL(iday) 
      PRINT*,'itap =',itap
      PRINT*,'pdtphys =',pdtphys
@@ -234,10 +234,10 @@
 !
      DO i = 2, 13
-       month_len(i) = float(ioget_mon_len(year_cur, i-1))
+       month_len(i) = REAL(ioget_mon_len(year_cur, i-1))
        CALL ymds2ju(year_cur, i-1, 1, 0.0, month_start(i))
      ENDDO
-     month_len(1) = float(ioget_mon_len(year_cur-1, 12))
+     month_len(1) = REAL(ioget_mon_len(year_cur-1, 12))
      CALL ymds2ju(year_cur-1, 12, 1, 0.0, month_start(1))
-     month_len(14) = float(ioget_mon_len(year_cur+1, 1))
+     month_len(14) = REAL(ioget_mon_len(year_cur+1, 1))
      CALL ymds2ju(year_cur+1, 1, 1, 0.0, month_start(14))
      month_mid(:) = month_start (:) + month_len(:)/2.
Index: /LMDZ4/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90	(revision 1403)
@@ -0,0 +1,357 @@
+! $Id$
+module regr_lat_time_coefoz_m
+
+  ! Author: Lionel GUEZ
+
+  implicit none
+
+  private
+  public regr_lat_time_coefoz
+
+contains
+
+  subroutine regr_lat_time_coefoz
+
+    ! "regr_lat_time_coefoz" stands for "regrid latitude time
+    ! coefficients ozone".
+
+    ! This procedure reads from a NetCDF file coefficients for ozone
+    ! chemistry, regrids them in latitude and time, and writes the
+    ! regridded fields to a new NetCDF file.
+
+    ! The input fields depend on time, pressure level and latitude.
+    ! We assume that the input fields are step functions of latitude.
+    ! Regridding in latitude is made by averaging, with a cosine of
+    ! latitude factor.
+    ! The target LMDZ latitude grid is the "scalar" grid: "rlatu".
+    ! The values of "rlatu" are taken to be the centers of intervals.
+    ! Regridding in time is by linear interpolation.
+    ! Monthly values are processed to get daily values, on the basis
+    ! of a 360-day calendar.
+
+    ! We assume that in the input file:
+    ! -- the latitude is in degrees and strictly monotonic (as all
+    ! NetCDF coordinate variables should be);
+    ! -- time increases from January to December (even though we do
+    ! not use values of the input time coordinate);
+    ! -- pressure is in hPa and in strictly ascending order (even
+    ! though we do not use pressure values here, we write the unit of
+    ! pressure in the NetCDF header, and we will use the assumptions later,
+    ! when we regrid in pressure).
+
+    use regr1_step_av_m, only: regr1_step_av
+    use regr3_lint_m, only: regr3_lint
+    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err, &
+         nf95_put_var, nf95_gw_var
+    use netcdf, only: nf90_nowrite, nf90_get_var
+
+    ! Variables local to the procedure:
+
+    include "dimensions.h"
+    ! (for "jjm")
+    include "paramet.h"
+    include "comgeom2.h"
+    ! (for "rlatv")
+    include "comconst.h"
+    ! (for "pi")
+
+    integer ncid_in, ncid_out ! NetCDF IDs for input and output files
+    integer n_plev ! number of pressure levels in the input data
+    integer n_lat! number of latitudes in the input data
+
+    real, pointer:: latitude(:)
+    ! (of input data, converted to rad, sorted in strictly ascending order)
+
+    real, allocatable:: lat_in_edg(:)
+    ! (edges of latitude intervals for input data, in rad, in strictly
+    ! ascending order)
+
+    real, pointer:: plev(:) ! pressure level of input data
+    logical desc_lat ! latitude in descending order in the input file
+
+    real, allocatable:: o3_par_in(:, :, :) ! (n_lat, n_plev, 12)
+    ! (ozone parameter from the input file)
+    ! ("o3_par_in(j, l, month)" is at latitude "latitude(j)" and pressure
+    ! level "plev(l)". "month" is between 1 and 12.)
+
+    real, allocatable:: v_regr_lat(:, :, :) ! (jjm + 1, n_plev, 0:13)
+    ! (mean of a variable "v" over a latitude interval)
+    ! (First dimension is latitude interval.
+    ! The latitude interval for "v_regr_lat(j,:, :)" contains "rlatu(j)".
+    ! If "j" is between 2 and "jjm" then the interval is:
+    ! [rlatv(j), rlatv(j-1)]
+    ! If "j" is 1 or "jjm + 1" then the interval is:
+    ! [rlatv(1), pi / 2]
+    ! or:
+    ! [- pi / 2, rlatv(jjm)]
+    ! respectively.
+    ! "v_regr_lat(:, l, :)" is for pressure level "plev(l)".
+    ! Last dimension is month number.)
+
+    real, allocatable:: o3_par_out(:, :, :) ! (jjm + 1, n_plev, 360)
+    ! (regridded ozone parameter)
+    ! ("o3_par_out(j, l, day)" is at latitude "rlatu(j)", pressure
+    ! level "plev(l)" and date "January 1st 0h" + "tmidday(day)", in a
+    ! 360-day calendar.)
+
+    integer j
+    integer i_v ! index of ozone parameter
+    integer, parameter:: n_o3_param = 8 ! number of ozone parameters
+
+    character(len=11) name_in(n_o3_param)
+    ! (name of NetCDF primary variable in the input file)
+
+    character(len=9) name_out(n_o3_param)
+    ! (name of NetCDF primary variable in the output file)
+
+    integer varid_in(n_o3_param), varid_out(n_o3_param), varid_plev, varid_time
+    integer ncerr, varid
+    ! (for NetCDF)
+
+    real, parameter:: tmidmonth(0:13) = (/(-15. + 30. * j, j = 0, 13)/)
+    ! (time to middle of month, in days since January 1st 0h, in a
+    ! 360-day calendar)
+    ! (We add values -15 and 375 so that, for example, day 3 of the year is
+    ! interpolated between the December and the January value.)
+
+    real, parameter:: tmidday(360) = (/(j + 0.5, j = 0, 359)/)
+    ! (time to middle of day, in days since January 1st 0h, in a
+    ! 360-day calendar)
+
+    !---------------------------------
+
+    print *, "Call sequence information: regr_lat_time_coefoz"
+
+    ! Names of ozone parameters:
+    i_v = 0
+
+    i_v = i_v + 1
+    name_in(i_v) = "P_net"
+    name_out(i_v) = "P_net_Mob"
+
+    i_v = i_v + 1
+    name_in(i_v) = "a2"
+    name_out(i_v) = "a2"
+
+    i_v = i_v + 1
+    name_in(i_v) = "tro3"
+    name_out(i_v) = "r_Mob"
+
+    i_v = i_v + 1
+    name_in(i_v) = "a4"
+    name_out(i_v) = "a4"
+
+    i_v = i_v + 1
+    name_in(i_v) = "temperature"
+    name_out(i_v) = "temp_Mob"
+
+    i_v = i_v + 1
+    name_in(i_v) = "a6"
+    name_out(i_v) = "a6"
+
+    i_v = i_v + 1
+    name_in(i_v) = "Sigma"
+    name_out(i_v) = "Sigma_Mob"
+
+    i_v = i_v + 1
+    name_in(i_v) = "R_Het"
+    name_out(i_v) = "R_Het"
+
+    call nf95_open("coefoz.nc", nf90_nowrite, ncid_in)
+
+    ! Get coordinates from the input file:
+
+    call nf95_inq_varid(ncid_in, "latitude", varid)
+    call nf95_gw_var(ncid_in, varid, latitude)
+    ! Convert from degrees to rad, because "rlatv" is in rad:
+    latitude = latitude / 180. * pi
+    n_lat = size(latitude)
+    ! We need to supply the latitudes to "regr1_step_av" in
+    ! ascending order, so invert order if necessary:
+    desc_lat = latitude(1) > latitude(n_lat)
+    if (desc_lat) latitude = latitude(n_lat:1:-1)
+
+    ! Compute edges of latitude intervals:
+    allocate(lat_in_edg(n_lat + 1))
+    lat_in_edg(1) = - pi / 2
+    forall (j = 2:n_lat) lat_in_edg(j) = (latitude(j - 1) + latitude(j)) / 2
+    lat_in_edg(n_lat + 1) = pi / 2
+    deallocate(latitude) ! pointer
+
+    call nf95_inq_varid(ncid_in, "plev", varid)
+    call nf95_gw_var(ncid_in, varid, plev)
+    n_plev = size(plev)
+    ! (We only need the pressure coordinate to copy it to the output file.)
+
+    ! Get the IDs of ozone parameters in the input file:
+    do i_v = 1, n_o3_param
+       call nf95_inq_varid(ncid_in, trim(name_in(i_v)), varid_in(i_v))
+    end do
+
+    ! Create the output file and get the variable IDs:
+    call prepare_out(ncid_in, varid_in, n_plev, name_out, ncid_out, &
+         varid_out, varid_plev, varid_time)
+
+    ! Write remaining coordinate variables:
+    call nf95_put_var(ncid_out, varid_time, tmidday)
+    call nf95_put_var(ncid_out, varid_plev, plev)
+
+    deallocate(plev) ! pointer
+
+    allocate(o3_par_in(n_lat, n_plev, 12))
+    allocate(v_regr_lat(jjm + 1, n_plev, 0:13))
+    allocate(o3_par_out(jjm + 1, n_plev, 360))
+
+    do i_v = 1, n_o3_param
+       ! Process ozone parameter "name_in(i_v)"
+
+       ncerr = nf90_get_var(ncid_in, varid_in(i_v), o3_par_in)
+       call handle_err("nf90_get_var", ncerr, ncid_in)
+
+       if (desc_lat) o3_par_in = o3_par_in(n_lat:1:-1, :, :)
+
+       ! Regrid in latitude:
+       ! We average with respect to sine of latitude, which is
+       ! equivalent to weighting by cosine of latitude:
+       v_regr_lat(jjm+1:1:-1, :, 1:12) = regr1_step_av(o3_par_in, &
+            xs=sin(lat_in_edg), xt=sin((/- pi / 2, rlatv(jjm:1:-1), pi / 2/)))
+       ! (invert order of indices in "v_regr_lat" because "rlatu" is
+       ! in descending order)
+
+       ! Duplicate January and December values, in preparation of time
+       ! interpolation:
+       v_regr_lat(:, :, 0) = v_regr_lat(:, :, 12)
+       v_regr_lat(:, :, 13) = v_regr_lat(:, :, 1)
+
+       ! Regrid in time by linear interpolation:
+       o3_par_out = regr3_lint(v_regr_lat, tmidmonth, tmidday)
+
+       ! Write to file:
+       call nf95_put_var(ncid_out, varid_out(i_v), &
+            o3_par_out(jjm+1:1:-1, :, :))
+       ! (The order of "rlatu" is inverted in the output file)
+    end do
+
+    call nf95_close(ncid_out)
+    call nf95_close(ncid_in)
+
+  end subroutine regr_lat_time_coefoz
+
+  !********************************************
+
+  subroutine prepare_out(ncid_in, varid_in, n_plev, name_out, ncid_out, &
+       varid_out, varid_plev, varid_time)
+
+    ! This subroutine creates the NetCDF output file, defines
+    ! dimensions and variables, and writes one of the coordinate variables.
+
+    use assert_eq_m, only: assert_eq
+
+    use netcdf95, only: nf95_create, nf95_def_dim, nf95_def_var, &
+         nf95_put_att, nf95_enddef, nf95_copy_att, nf95_put_var
+    use netcdf, only: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
+
+    integer, intent(in):: ncid_in, varid_in(:), n_plev
+    character(len=*), intent(in):: name_out(:) ! of NetCDF variables
+    integer, intent(out):: ncid_out, varid_out(:), varid_plev, varid_time
+
+    ! Variables local to the procedure:
+
+    include "dimensions.h"
+    ! (for "jjm")
+    include "paramet.h"
+    include "comgeom2.h"
+    ! (for "rlatu")
+    include "comconst.h"
+    ! (for "pi")
+
+    integer ncerr
+    integer dimid_rlatu, dimid_plev, dimid_time
+    integer varid_rlatu
+    integer i, n_o3_param
+
+    !---------------------------
+
+    print *, "Call sequence information: prepare_out"
+    n_o3_param = assert_eq(size(varid_in), size(varid_out), &
+         size(name_out), "prepare_out") 
+
+    call nf95_create("coefoz_LMDZ.nc", nf90_clobber, ncid_out)
+
+    ! Dimensions:
+    call nf95_def_dim(ncid_out, "time", 360, dimid_time)
+    call nf95_def_dim(ncid_out, "plev", n_plev, dimid_plev)
+    call nf95_def_dim(ncid_out, "rlatu", jjm + 1, dimid_rlatu)
+
+    ! Define coordinate variables:
+
+    call nf95_def_var(ncid_out, "time", nf90_float, dimid_time, varid_time)
+    call nf95_put_att(ncid_out, varid_time, "units", "days since 2000-1-1")
+    call nf95_put_att(ncid_out, varid_time, "calendar", "360_day")
+    call nf95_put_att(ncid_out, varid_time, "standard_name", "time")
+
+    call nf95_def_var(ncid_out, "plev", nf90_float, dimid_plev, varid_plev)
+    call nf95_put_att(ncid_out, varid_plev, "units", "millibar")
+    call nf95_put_att(ncid_out, varid_plev, "standard_name", "air_pressure")
+    call nf95_put_att(ncid_out, varid_plev, "long_name", "air pressure")
+
+    call nf95_def_var(ncid_out, "rlatu", nf90_float, dimid_rlatu, varid_rlatu)
+    call nf95_put_att(ncid_out, varid_rlatu, "units", "degrees_north")
+    call nf95_put_att(ncid_out, varid_rlatu, "standard_name", "latitude")
+
+    ! Define primary variables:
+
+    do i = 1, n_o3_param
+       call nf95_def_var(ncid_out, name_out(i), nf90_float, &
+            (/dimid_rlatu, dimid_plev, dimid_time/), varid_out(i))
+
+       ! The following commands may fail. That is OK. It should just
+       ! mean that the attribute is not defined in the input file.
+
+       ncerr = nf90_copy_att(ncid_in, varid_in(i), "long_name",&
+            & ncid_out, varid_out(i))
+       call handle_err_copy_att("long_name")
+
+       ncerr = nf90_copy_att(ncid_in, varid_in(i), "units", ncid_out,&
+            & varid_out(i))
+       call handle_err_copy_att("units")
+
+       ncerr = nf90_copy_att(ncid_in, varid_in(i), "standard_name", ncid_out,&
+            & varid_out(i))
+       call handle_err_copy_att("standard_name")
+    end do
+
+    ! Global attributes:
+    call nf95_copy_att(ncid_in, nf90_global, "Conventions", ncid_out, &
+         nf90_global)
+    call nf95_copy_att(ncid_in, nf90_global, "title", ncid_out, nf90_global)
+    call nf95_copy_att(ncid_in, nf90_global, "source", ncid_out, nf90_global)
+    call nf95_put_att(ncid_out, nf90_global, "comment", "Regridded for LMDZ")
+
+    call nf95_enddef(ncid_out)
+
+    ! Write one of the coordinate variables:
+    call nf95_put_var(ncid_out, varid_rlatu, rlatu(jjm+1:1:-1) / pi * 180.)
+    ! (convert from rad to degrees and sort in ascending order)
+
+  contains
+
+    subroutine handle_err_copy_att(att_name)
+
+      use netcdf, only: nf90_noerr, nf90_strerror
+
+      character(len=*), intent(in):: att_name
+
+      !----------------------------------------
+
+      if (ncerr /= nf90_noerr) then
+         print *, "prepare_out " // trim(name_out(i)) &
+              // " nf90_copy_att " // att_name // " -- " &
+              // trim(nf90_strerror(ncerr))
+      end if
+
+    end subroutine handle_err_copy_att
+
+  end subroutine prepare_out
+
+end module regr_lat_time_coefoz_m
Index: /LMDZ4/trunk/libf/phylmd/regr_pr_av_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/regr_pr_av_m.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/regr_pr_av_m.F90	(revision 1403)
@@ -21,7 +21,7 @@
     ! latitude, pressure, julian day.
     ! We assume that the input fields are already on the "rlatu"
-    ! latitudes, excepth that latitudes are in ascending order in the input
+    ! latitudes, except that latitudes are in ascending order in the input
     ! file.
-    ! We assume that the inputs fields have the same pressure coordinate.
+    ! We assume that all the inputs fields have the same coordinates.
 
     ! The target vertical LMDZ grid is the grid of layer boundaries.
@@ -91,10 +91,11 @@
     if (is_mpi_root) then
        do i = 1, n_var
-          call nf95_inq_varid(ncid, name(i), varid)
+          call nf95_inq_varid(ncid, trim(name(i)), varid)
           
           ! Get data at the right day from the input file:
           ncerr = nf90_get_var(ncid, varid, v1(1, :, :, i), &
                start=(/1, 1, julien/))
-          call handle_err("regr_pr_av nf90_get_var " // name(i), ncerr, ncid)
+          call handle_err("regr_pr_av nf90_get_var " // trim(name(i)), ncerr, &
+               ncid)
        end do
        
Index: /LMDZ4/trunk/libf/phylmd/regr_pr_comb_coefoz_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/regr_pr_comb_coefoz_m.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/regr_pr_comb_coefoz_m.F90	(revision 1403)
@@ -0,0 +1,163 @@
+! $Id$
+module regr_pr_comb_coefoz_m
+
+  implicit none
+
+  ! The five module variables declared here are on the partial
+  ! "physics" grid.
+  ! The value of each variable for index "(i, k)" is at longitude
+  ! "rlon(i)", latitude "rlat(i)" and middle of layer "k".
+
+  real, allocatable, save:: c_Mob(:, :)
+  ! (sum of Mobidic terms in the net mass production rate of ozone
+  ! by chemistry, per unit mass of air, in s-1)
+
+  real, allocatable, save:: a2(:, :)
+  ! (derivative of mass production rate of ozone per unit mass of
+  ! air with respect to ozone mass fraction, in s-1)
+
+  real, allocatable, save:: a4_mass(:, :)
+  ! (derivative of mass production rate of ozone per unit mass of
+  ! air with respect to temperature, in s-1 K-1)
+
+  real, allocatable, save:: a6_mass(:, :)
+  ! (derivative of mass production rate of ozone per unit mass of
+  ! air with respect to mass column-density of ozone above, in m2 s-1 kg-1)
+
+  real, allocatable, save:: r_het_interm(:, :)
+  ! (net mass production rate by heterogeneous chemistry, per unit
+  ! mass of ozone, corrected for chlorine content and latitude, but
+  ! not for temperature and sun direction, in s-1)
+
+  !$omp threadprivate(c_Mob, a2, a4_mass, a6_mass, r_het_interm)
+
+contains
+
+  subroutine alloc_coefoz
+
+    ! This procedure is called once per run.
+    ! It allocates module variables.
+
+    use dimphy, only: klon
+
+    ! Variables local to the procedure:
+    include "dimensions.h"
+
+    !---------------------------------------
+
+    !$omp master
+    print *, "Call sequence information: alloc_coefoz"
+    !$omp end master
+    allocate(c_Mob(klon, llm), a2(klon, llm), a4_mass(klon, llm))
+    allocate(a6_mass(klon, llm), r_het_interm(klon, llm))
+
+  end subroutine alloc_coefoz
+
+  !*******************************************************
+
+  subroutine regr_pr_comb_coefoz(julien, rlat, paprs, pplay)
+
+    ! "regr_pr_comb_coefoz" stands for "regrid pressure combine
+    ! coefficients ozone".
+
+    ! In this subroutine:
+    ! -- the master thread of the root process reads from a file all
+    !    eight coefficients for ozone chemistry, at the current day;
+    ! -- the coefficients are packed to the "physics" horizontal grid
+    !    and scattered to all threads of all processes;
+    ! -- in all the threads of all the processes, the coefficients are
+    !    regridded in pressure to the LMDZ vertical grid;
+    ! -- in all the threads of all the processes, the eight
+    !    coefficients are combined to define the five module variables.
+
+    use netcdf95, only: nf95_open, nf95_close
+    use netcdf, only: nf90_nowrite
+    use assert_m, only: assert
+    use dimphy, only: klon
+    use mod_phys_lmdz_mpi_data, only: is_mpi_root
+    use regr_pr_av_m, only: regr_pr_av
+    use regr_pr_int_m, only: regr_pr_int
+    use press_coefoz_m, only: press_in_edg, plev
+
+    integer, intent(in):: julien ! jour julien, 1 <= julien <= 360
+
+    REAL, intent(in):: rlat(:)
+    ! (latitude on the partial "physics" grid, in degrees)
+
+    real, intent(in):: paprs(:, :) ! (klon, llm + 1)
+    ! (pression pour chaque inter-couche, en Pa)
+
+    real, intent(in):: pplay(:, :) ! (klon, llm)
+    ! (pression pour le mileu de chaque couche, en Pa)
+
+    ! Variables local to the procedure:
+
+    include "dimensions.h"
+    integer ncid ! for NetCDF
+
+    real coefoz(klon, llm, 7)
+    ! (temporary storage for 7 ozone coefficients)
+    ! (On the partial "physics" grid.
+    ! "coefoz(i, k, :)" is at longitude "rlon(i)", latitude "rlat(i)",
+    ! middle of layer "k".)
+
+    real a6(klon, llm)
+    ! (derivative of "P_net_Mob" with respect to column-density of ozone
+    ! above, in cm2 s-1)
+    ! (On the partial "physics" grid.
+    ! "a6(i, k)" is at longitude "rlon(i)", latitude "rlat(i)",
+    ! middle of layer "k".)
+
+    real, parameter:: amu = 1.6605402e-27 ! atomic mass unit, in kg
+
+    real, parameter:: Clx = 3.8e-9
+    ! (total chlorine content in the upper stratosphere)
+
+    integer k
+
+    !------------------------------------
+
+    !!print *, "Call sequence information: regr_pr_comb_coefoz"
+    call assert((/size(rlat), size(paprs, 1), size(pplay, 1)/) == klon, &
+         "regr_pr_comb_coefoz klon")
+    call assert((/size(paprs, 2) - 1, size(pplay, 2)/) == llm, &
+         "regr_pr_comb_coefoz llm")
+
+    !$omp master
+    if (is_mpi_root) call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
+    !$omp end master
+
+    call regr_pr_av(ncid, (/"a2       ", "a4       ", "a6       ", &
+         "P_net_Mob", "r_Mob    ", "temp_Mob ", "R_Het    "/), julien, &
+         press_in_edg, paprs, coefoz)
+    a2 = coefoz(:, :, 1)
+    a4_mass = coefoz(:, :, 2) * 48. / 29.
+
+    ! Compute "a6_mass" avoiding underflow, do not divide by 1e4
+    ! before dividing by molecular mass:
+    a6_mass = coefoz(:, :, 3) / (1e4 * 29. * amu)
+    ! (factor 1e4: conversion from cm2 to m2)
+
+    ! We can overwrite "coefoz(:, :, 1)", which was saved to "a2":
+    call regr_pr_int(ncid, "Sigma_Mob", julien, plev, pplay, top_value=0., &
+         v3=coefoz(:, :, 1))
+
+    ! Combine coefficients to get "c_Mob":
+    c_mob = (coefoz(:, :, 4) - a2 * coefoz(:, :, 5) &
+         - coefoz(:, :, 3) * coefoz(:, :, 1)) * 48. / 29. &
+         - a4_mass * coefoz(:, :, 6)
+
+    r_het_interm = coefoz(:, :, 7)
+    ! Heterogeneous chemistry is only at high latitudes:
+    forall (k = 1: llm)
+       where (abs(rlat) <= 45.) r_het_interm(:, k) = 0.
+    end forall
+    r_het_interm = r_het_interm * (Clx / 3.8e-9)**2
+
+    !$omp master
+    if (is_mpi_root) call nf95_close(ncid)
+    !$omp end master
+
+  end subroutine regr_pr_comb_coefoz
+
+end module regr_pr_comb_coefoz_m
Index: /LMDZ4/trunk/libf/phylmd/regr_pr_o3_m.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/regr_pr_o3_m.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/regr_pr_o3_m.F90	(revision 1403)
@@ -0,0 +1,103 @@
+! $Id$
+module regr_pr_o3_m
+
+  implicit none
+
+contains
+
+  subroutine regr_pr_o3(p3d, o3_mob_regr)
+
+    ! "regr_pr_o3" stands for "regrid pressure ozone".
+    ! This procedure reads Mobidic ozone mole fraction from
+    ! "coefoz_LMDZ.nc" at the initial day of the run and regrids it in
+    ! pressure.
+    ! Ozone mole fraction from "coefoz_LMDZ.nc" at the initial day is
+    ! a 2D latitude -- pressure variable.
+    ! The target horizontal LMDZ grid is the "scalar" grid: "rlonv", "rlatu".
+    ! The target vertical LMDZ grid is the grid of layer boundaries.
+    ! We assume that the input variable is already on the LMDZ "rlatu"
+    ! latitude grid.
+    ! The input variable does not depend on longitude, but the
+    ! pressure at LMDZ layers does.
+    ! Therefore, the values on the LMDZ grid do depend on longitude.
+    ! Regridding is by averaging, assuming a step function.
+    ! We assume that, in the input file, the pressure levels are in
+    ! hPa and strictly increasing.
+
+    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, handle_err
+    use netcdf, only:  nf90_nowrite, nf90_get_var
+    use assert_m, only: assert
+    use regr1_step_av_m, only: regr1_step_av
+    use press_coefoz_m, only: press_in_edg
+    use control_mod, only: dayref
+
+    REAL, intent(in):: p3d(:, :, :) ! pressure at layer interfaces, in Pa
+    ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)",
+    ! for interface "l")
+
+    real, intent(out):: o3_mob_regr(:, :, :) ! (iim + 1, jjm + 1, llm)
+    ! (ozone mole fraction from Mobidic adapted to the LMDZ grid)
+    ! ("o3_mob_regr(i, j, l)" is at longitude "rlonv(i)", latitude
+    ! "rlatu(j)" and pressure level "pls(i, j, l)")
+
+    ! Variables local to the procedure:
+
+    include "dimensions.h"
+
+    integer ncid, varid, ncerr ! for NetCDF
+    integer i, j
+
+    real r_mob(jjm + 1, size(press_in_edg) - 1)
+    ! (ozone mole fraction from Mobidic at day "dayref")
+    ! (r_mob(j, k) is at latitude "rlatu(j)", in pressure interval
+    ! "[press_in_edg(k), press_in_edg(k+1)]".)
+
+    !------------------------------------------------------------
+
+    print *, "Call sequence information: regr_pr_o3"
+    call assert(shape(o3_mob_regr) == (/iim + 1, jjm + 1, llm/), &
+         "regr_pr_o3 o3_mob_regr")
+    call assert(shape(p3d) == (/iim + 1, jjm + 1, llm + 1/), "regr_pr_o3 p3d")
+
+    call nf95_open("coefoz_LMDZ.nc", nf90_nowrite, ncid)
+
+    call nf95_inq_varid(ncid, "r_Mob", varid)
+    ! Get data at the right day from the input file:
+    ncerr = nf90_get_var(ncid, varid, r_mob, start=(/1, 1, dayref/))
+    call handle_err("nf90_get_var r_Mob", ncerr)
+    ! Latitudes are in ascending order in the input file while
+    ! "rlatu" is in descending order so we need to invert order:
+    r_mob = r_mob(jjm+1:1:-1, :)
+
+    call nf95_close(ncid)
+
+    ! Regrid in pressure by averaging a step function of pressure:
+
+    ! Poles:
+    do j = 1, jjm + 1, jjm
+       o3_mob_regr(1, j, llm:1:-1) &
+            = regr1_step_av(r_mob(j, :), press_in_edg, p3d(1, j, llm+1:1:-1))
+       ! (invert order of indices because "p3d" is in descending order)
+    end do
+
+    ! Other latitudes:
+    do j = 2, jjm
+       do i = 1, iim
+          o3_mob_regr(i, j, llm:1:-1) &
+               = regr1_step_av(r_mob(j, :), press_in_edg, &
+               p3d(i, j, llm+1:1:-1))
+             ! (invert order of indices because "p3d" is in descending order)
+       end do
+    end do
+
+    ! Duplicate pole values on all longitudes:
+    o3_mob_regr(2:, 1, :) = spread(o3_mob_regr(1, 1, :), dim=1, ncopies=iim)
+    o3_mob_regr(2:, jjm + 1, :) &
+         = spread(o3_mob_regr(1, jjm + 1, :), dim=1, ncopies=iim)
+
+    ! Duplicate first longitude to last longitude:
+    o3_mob_regr(iim + 1, 2:jjm, :) = o3_mob_regr(1, 2:jjm, :)
+
+  end subroutine regr_pr_o3
+
+end module regr_pr_o3_m
Index: /LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90	(revision 1403)
@@ -186,4 +186,14 @@
        ENDDO
 
+!****************************************************************************************
+       snow_o=0.
+       zfra_o = 0.
+       DO j = 1, knon
+           i = knindex(j)
+           snow_o(i) = snow(j)
+           zfra_o(i) = zfra(j)
+       ENDDO
+
+
   END SUBROUTINE surf_landice
 !
Index: /LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90	(revision 1403)
@@ -141,5 +141,5 @@
 !****************************************************************************************
     IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
-       CALL alboc(FLOAT(jour),rlat,alb_eau)
+       CALL alboc(REAL(jour),rlat,alb_eau)
     ELSE  ! diurnal cycle
        CALL alboc_cd(rmu0,alb_eau)
Index: /LMDZ4/trunk/libf/phylmd/thermcell.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell.F	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE calcul_sec(ngrid,nlay,ptimestep
      s                  ,pplay,pplev,pphi,zlev
@@ -132,4 +135,8 @@
       character*10 str10
 
+      character (len=20) :: modname='calcul_sec'
+      character (len=80) :: abort_message
+
+
 !      LOGICAL vtest(klon),down
 
@@ -530,5 +537,5 @@
 c      write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
       enddo
-con stoppe après les calculs de zmax et wmax
+con stope après les calculs de zmax et wmax
       RETURN
 
@@ -776,5 +783,7 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1) then
-               stop'fracd trop petit'
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1)
+
             else
 c    vitesse descendante "diagnostique"
@@ -860,6 +869,6 @@
 cRC
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/REAL(tho)
       else
          fm0=fm
Index: /LMDZ4/trunk/libf/phylmd/thermcellV0_main.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcellV0_main.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/thermcellV0_main.F90	(revision 1403)
@@ -0,0 +1,2101 @@
+!
+! $Id$
+!
+      SUBROUTINE thermcellV0_main(itap,ngrid,nlay,ptimestep  &
+     &                  ,pplay,pplev,pphi,debut  &
+     &                  ,pu,pv,pt,po  &
+     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
+     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
+     &                  ,ratqscth,ratqsdiff,zqsatth  &
+     &                  ,r_aspect,l_mix,tau_thermals &
+     &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
+     &                  ,zmax0, f0,zw2,fraca)
+
+      USE dimphy
+      USE comgeomphy , ONLY:rlond,rlatd
+      IMPLICIT NONE
+
+!=======================================================================
+!   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
+!   Version du 09.02.07
+!   Calcul du transport vertical dans la couche limite en presence
+!   de "thermiques" explicitement representes avec processus nuageux
+!
+!   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+!
+!   le thermique est supposé homogène et dissipé par mélange avec
+!   son environnement. la longueur l_mix contrôle l'efficacité du
+!   mélange
+!
+!   Le calcul du transport des différentes espèces se fait en prenant
+!   en compte:
+!     1. un flux de masse montant
+!     2. un flux de masse descendant
+!     3. un entrainement
+!     4. un detrainement
+!
+!=======================================================================
+
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "iniprint.h"
+
+!   arguments:
+!   ----------
+
+!IM 140508
+      INTEGER itap
+
+      INTEGER ngrid,nlay,w2di
+      real tau_thermals
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+!   local:
+!   ------
+
+      integer icount
+      data icount/0/
+      save icount
+!$OMP THREADPRIVATE(icount)
+
+      integer,save :: igout=1
+!$OMP THREADPRIVATE(igout)
+      integer,save :: lunout1=6
+!$OMP THREADPRIVATE(lunout1)
+      integer,save :: lev_out=10
+!$OMP THREADPRIVATE(lev_out)
+
+      INTEGER ig,k,l,ll
+      real zsortie1d(klon)
+      INTEGER lmax(klon),lmin(klon),lalim(klon)
+      INTEGER lmix(klon)
+      INTEGER lmix_bis(klon)
+      real linter(klon)
+      real zmix(klon)
+      real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1)
+!      real fraca(klon,klev)
+
+      real zmax_sec(klon)
+!on garde le zmax du pas de temps precedent
+      real zmax0(klon)
+!FH/IM     save zmax0
+
+      real lambda
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      real deltaz(klon,klev)
+      REAL zh(klon,klev)
+      real zthl(klon,klev),zdthladj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      real zl(klon,klev)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zta(klon,klev)
+      real zha(klon,klev)
+      real fraca(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
+      real q2(klon,klev)
+! FH probleme de dimensionnement avec l'allocation dynamique
+!     common/comtherm/thetath2,wth2
+    
+      real ratqscth(klon,klev)
+      real var
+      real vardiff
+      real ratqsdiff(klon,klev)
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+      real wmax(klon)
+      real wmax_sec(klon)
+      real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev),detr(klon,klev)
+
+      real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
+!niveau de condensation
+      integer nivcon(klon)
+      real zcon(klon)
+      REAL CHI
+      real zcon2(klon)
+      real pcon(klon)
+      real zqsat(klon,klev)
+      real zqsatth(klon,klev) 
+
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real detr_star(klon,klev)
+      real alim_star_tot(klon),alim_star2(klon)
+      real alim_star(klon,klev)
+      real f(klon), f0(klon)
+!FH/IM     save f0
+      real zlevinter(klon)
+      logical debut
+       real seuil
+
+! Declaration uniquement pour les sorties dans thermcell_out3d.
+! Inutilise en 3D
+      real wthl(klon,klev)
+      real wthv(klon,klev)
+      real wq(klon,klev)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!
+      !nouvelles variables pour la convection
+      real Ale_bl(klon)
+      real Alp_bl(klon)
+      real alp_int(klon)
+      real ale_int(klon)
+      integer n_int(klon)
+      real fm_tot(klon)
+      real wght_th(klon,klev)
+      integer lalim_conv(klon)
+!v1d     logical therm
+!v1d     save therm
+
+      character*2 str2
+      character*10 str10
+
+      character (len=20) :: modname='thermcellV0_main'
+      character (len=80) :: abort_message
+
+      EXTERNAL SCOPY
+!
+
+!-----------------------------------------------------------------------
+!   initialisation:
+!   ---------------
+!
+
+      seuil=0.25
+
+      if (debut)  then
+         fm0=0.
+         entr0=0.
+         detr0=0.
+
+
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+! Initialisation des sorties grads pour les thermiques.
+! Pour l'instant en 1D sur le point igout.
+! Utilise par thermcell_out3d.h
+         str10='therm'
+         call inigrads(1,1,rlond(igout),1.,-180.,180.,jjm, &
+     &   rlatd(igout),-90.,90.,1.,llm,pplay(igout,:),1.,   &
+     &   ptimestep,str10,'therm ')
+#endif
+
+
+
+      endif
+
+      fm=0. ; entr=0. ; detr=0.
+
+      icount=icount+1
+
+!IM 090508 beg
+!print*,'====================================================================='
+!print*,'====================================================================='
+!print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount
+!print*,'====================================================================='
+!print*,'====================================================================='
+!IM 090508 end
+
+      if (prt_level.ge.1) print*,'thermcell_main V4'
+
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+!
+!Initialisation
+!
+     if (prt_level.ge.10)write(lunout,*)                                &
+    &     'WARNING thermcell_main f0=max(f0,1.e-2)'
+     do ig=1,klon
+         f0(ig)=max(f0(ig),1.e-2)
+     enddo
+
+!-----------------------------------------------------------------------
+! Calcul de T,q,ql a partir de Tl et qT dans l environnement
+!   --------------------------------------------------------------------
+!
+      CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+       
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
+
+!------------------------------------------------------------------------
+!                       --------------------
+!
+!
+!                       + + + + + + + + + + +
+!
+!
+!  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+!  wh,wt,wo ...
+!
+!                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+!
+!
+!                       --------------------   zlev(1)
+!                       \\\\\\\\\\\\\\\\\\\\
+!
+!
+
+!-----------------------------------------------------------------------
+!   Calcul des altitudes des couches
+!-----------------------------------------------------------------------
+
+      do l=2,nlay
+         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
+      enddo
+         zlev(:,1)=0.
+         zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
+      do l=1,nlay
+         zlay(:,l)=pphi(:,l)/RG
+      enddo
+!calcul de l epaisseur des couches
+      do l=1,nlay
+         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
+      enddo
+
+!     print*,'2 OK convect8'
+!-----------------------------------------------------------------------
+!   Calcul des densites
+!-----------------------------------------------------------------------
+
+      do l=1,nlay
+         rho(:,l)=pplay(:,l)/(zpspsk(:,l)*RD*ztv(:,l))
+      enddo
+
+!IM
+     if (prt_level.ge.10)write(lunout,*)                                &
+    &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
+      rhobarz(:,1)=rho(:,1)
+
+      do l=2,nlay
+         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
+      enddo
+
+!calcul de la masse
+      do l=1,nlay
+         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
+      enddo
+
+      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
+
+!------------------------------------------------------------------
+!
+!             /|\
+!    --------  |  F_k+1 -------   
+!                              ----> D_k
+!             /|\              <---- E_k , A_k
+!    --------  |  F_k --------- 
+!                              ----> D_k-1
+!                              <---- E_k-1 , A_k-1
+!
+!
+!
+!
+!
+!    ---------------------------
+!
+!    ----- F_lmax+1=0 ----------         \
+!            lmax     (zmax)              |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------          |
+!                                         |  E
+!    ---------------------------          |  D
+!                                         |
+!    ---------------------------          |
+!                                         |
+!    ---------------------------  \       |
+!            lalim                 |      |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!                                  | A    |
+!    ---------------------------   |      |
+!                                  |      |
+!    ---------------------------   |      |
+!    lmin  (=1 pour le moment)     |      |
+!    ----- F_lmin=0 ------------  /      /
+!
+!    ---------------------------
+!    //////////////////////////
+!
+!
+!=============================================================================
+!  Calculs initiaux ne faisant pas intervenir les changements de phase
+!=============================================================================
+
+!------------------------------------------------------------------
+!  1. alim_star est le profil vertical de l'alimentation à la base du
+!     panache thermique, calculé à partir de la flotabilité de l'air sec
+!  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
+!------------------------------------------------------------------
+!
+      entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
+      CALL thermcellV0_init(ngrid,nlay,ztv,zlay,zlev,  &
+     &                    lalim,lmin,alim_star,alim_star_tot,lev_out)
+
+call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin  ')
+call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ')
+
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_init'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 1'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star thetav'
+         write(lunout1,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) &
+     &   ,ztv(igout,l),l=1,lalim(igout)+4)
+      endif
+
+!v1d      do ig=1,klon
+!v1d     if (alim_star(ig,1).gt.1.e-10) then
+!v1d     therm=.true.
+!v1d     endif
+!v1d      enddo
+!-----------------------------------------------------------------------------
+!  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
+!     panache sec conservatif (e=d=0) alimente selon alim_star 
+!     Il s'agit d'un calcul de type CAPE
+!     zmax_sec est utilisé pour déterminer la géométrie du thermique.
+!------------------------------------------------------------------------------
+!
+      CALL thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+     &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
+
+call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
+call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 1b'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) &
+     &    ,l=1,lalim(igout)+4)
+      endif
+
+
+
+!---------------------------------------------------------------------------------
+!calcul du melange et des variables dans le thermique
+!--------------------------------------------------------------------------------
+!
+      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
+!IM 140508   CALL thermcell_plume(ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+      CALL thermcellV0_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
+     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,zw_est,zqsatth,lmix,lmix_bis,linter &
+     &            ,lev_out,lunout1,igout)
+      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
+
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 2'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
+     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
+      endif
+
+!-------------------------------------------------------------------------------
+! Calcul des caracteristiques du thermique:zmax,zmix,wmax
+!-------------------------------------------------------------------------------
+!
+      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
+     &           zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
+
+
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
+
+!-------------------------------------------------------------------------------
+! Fermeture,determination de f
+!-------------------------------------------------------------------------------
+!
+!avant closure: on redéfinit lalim, alim_star_tot et alim_star
+!       do ig=1,klon
+!       do l=2,lalim(ig)
+!       alim_star(ig,l)=entr_star(ig,l)
+!       entr_star(ig,l)=0.
+!       enddo
+!       enddo
+
+      CALL thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
+
+      if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure'
+
+      if (tau_thermals>1.) then
+         lambda=exp(-ptimestep/tau_thermals)
+         f0=(1.-lambda)*f+lambda*f0
+      else
+         f0=f
+      endif
+
+! Test valable seulement en 1D mais pas genant
+      if (.not. (f0(1).ge.0.) ) then
+        abort_message = 'Dans thermcell_main f0(1).lt.0 '
+        CALL abort_gcm (modname,abort_message,1)
+      endif
+
+!-------------------------------------------------------------------------------
+!deduction des flux
+!-------------------------------------------------------------------------------
+
+      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
+     &       lalim,lmax,alim_star,  &
+     &       entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr,  &
+     &       detr,zqla,lev_out,lunout1,igout)
+!IM 060508    &       detr,zqla,zmax,lev_out,lunout,igout)
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
+      call testV0_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
+
+!------------------------------------------------------------------
+!   On ne prend pas directement les profils issus des calculs precedents
+!   mais on s'autorise genereusement une relaxation vers ceci avec
+!   une constante de temps tau_thermals (typiquement 1800s).
+!------------------------------------------------------------------
+
+      if (tau_thermals>1.) then
+         lambda=exp(-ptimestep/tau_thermals)
+         fm0=(1.-lambda)*fm+lambda*fm0
+         entr0=(1.-lambda)*entr+lambda*entr0
+!        detr0=(1.-lambda)*detr+lambda*detr0
+      else
+         fm0=fm
+         entr0=entr
+         detr0=detr
+      endif
+
+!c------------------------------------------------------------------
+!   calcul du transport vertical
+!------------------------------------------------------------------
+
+      call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse,  &
+     &                    zthl,zdthladj,zta,lev_out)
+      call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse,  &
+     &                   po,pdoadj,zoa,lev_out)
+
+!------------------------------------------------------------------
+! Calcul de la fraction de l'ascendance
+!------------------------------------------------------------------
+      do ig=1,klon
+         fraca(ig,1)=0.
+         fraca(ig,nlay+1)=0.
+      enddo
+      do l=2,nlay
+         do ig=1,klon
+            if (zw2(ig,l).gt.1.e-10) then
+            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
+            else
+            fraca(ig,l)=0.
+            endif
+         enddo
+      enddo
+     
+!------------------------------------------------------------------
+!  calcul du transport vertical du moment horizontal
+!------------------------------------------------------------------
+
+!IM 090508  
+      if (1.eq.1) then
+!IM 070508 vers. _dq       
+!     if (1.eq.0) then
+
+
+! Calcul du transport de V tenant compte d'echange par gradient
+! de pression horizontal avec l'environnement
+
+         call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,fraca,zmax  &
+     &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
+!IM 050508    &    ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out)
+      else
+
+! calcul purement conservatif pour le transport de V
+         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,zu,pduadj,zua,lev_out)
+         call thermcell_dq(ngrid,nlay,ptimestep,fm0,entr0,masse  &
+     &    ,zv,pdvadj,zva,lev_out)
+      endif
+
+!     print*,'13 OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+           pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l)  
+         enddo
+      enddo
+
+      if (prt_level.ge.1) print*,'14 OK convect8'
+!------------------------------------------------------------------
+!   Calculs de diagnostiques pour les sorties
+!------------------------------------------------------------------
+!calcul de fraca pour les sorties
+      
+      if (sorties) then
+      if (prt_level.ge.1) print*,'14a OK convect8'
+! calcul du niveau de condensation
+! initialisation
+      do ig=1,ngrid
+         nivcon(ig)=0
+         zcon(ig)=0.
+      enddo 
+!nouveau calcul
+      do ig=1,ngrid
+      CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
+      pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
+      enddo
+!IM   do k=1,nlay
+      do k=1,nlay-1
+         do ig=1,ngrid
+         if ((pcon(ig).le.pplay(ig,k))  &
+     &      .and.(pcon(ig).gt.pplay(ig,k+1))) then
+            zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100.
+         endif
+         enddo
+      enddo
+!IM
+      do ig=1,ngrid
+        if (pcon(ig).le.pplay(ig,nlay)) then 
+           zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
+           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
+           CALL abort_gcm (modname,abort_message,1)
+        endif
+      enddo
+      if (prt_level.ge.1) print*,'14b OK convect8'
+      do k=nlay,1,-1
+         do ig=1,ngrid
+            if (zqla(ig,k).gt.1e-10) then
+               nivcon(ig)=k
+               zcon(ig)=zlev(ig,k)
+            endif
+         enddo
+      enddo
+      if (prt_level.ge.1) print*,'14c OK convect8'
+!calcul des moments
+!initialisation
+      do l=1,nlay
+         do ig=1,ngrid
+            q2(ig,l)=0.
+            wth2(ig,l)=0.
+            wth3(ig,l)=0.
+            ratqscth(ig,l)=0.
+            ratqsdiff(ig,l)=0.
+         enddo
+      enddo      
+      if (prt_level.ge.1) print*,'14d OK convect8'
+      if (prt_level.ge.10)write(lunout,*)                                &
+    &     'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=fraca(ig,l)
+            zf2=zf/(1.-zf)
+!
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
+            if(zw2(ig,l).gt.1.e-10) then
+             wth2(ig,l)=zf2*(zw2(ig,l))**2
+            else
+             wth2(ig,l)=0.
+            endif
+!           print*,'wth2=',wth2(ig,l)
+            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
+     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
+            q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+!test: on calcul q2/po=ratqsc
+            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
+         enddo
+      enddo
+
+      if (prt_level.ge.10) then
+          print*,'14e OK convect8 ig,l,zf,zf2',ig,l,zf,zf2
+          ig=igout
+          do l=1,nlay
+             print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
+          enddo
+          do l=1,nlay
+             print*,'14g OK convect8 ig,l,po',ig,l,po(ig,l)
+          enddo
+      endif
+
+      do ig=1,ngrid
+      alp_int(ig)=0.
+      ale_int(ig)=0.
+      n_int(ig)=0
+      enddo
+!
+      do l=1,nlay
+      do ig=1,ngrid
+       if(l.LE.lmax(ig)) THEN
+        alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)
+        ale_int(ig)=ale_int(ig)+0.5*zw2(ig,l)**2
+        n_int(ig)=n_int(ig)+1
+       endif
+      enddo
+      enddo
+!      print*,'avant calcul ale et alp' 
+!calcul de ALE et ALP pour la convection
+      do ig=1,ngrid
+!      Alp_bl(ig)=0.5*rhobarz(ig,lmix_bis(ig))*wth3(ig,lmix(ig))
+!          Alp_bl(ig)=0.5*rhobarz(ig,nivcon(ig))*wth3(ig,nivcon(ig))
+!      Alp_bl(ig)=0.5*rhobarz(ig,lmix(ig))*wth3(ig,lmix(ig)) 
+!     &           *0.1
+!valeur integree de alp_bl * 0.5:
+       if (n_int(ig).gt.0) then
+       Alp_bl(ig)=0.5*alp_int(ig)/n_int(ig)
+!       if (Alp_bl(ig).lt.0.) then
+!       Alp_bl(ig)=0.
+       endif
+!       endif
+!         write(18,*),'rhobarz,wth3,Alp',rhobarz(ig,nivcon(ig)),
+!     s               wth3(ig,nivcon(ig)),Alp_bl(ig)
+!            write(18,*),'ALP_BL',Alp_bl(ig),lmix(ig)
+!      Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2
+!      if (nivcon(ig).eq.1) then
+!       Ale_bl(ig)=0.
+!       else
+!valeur max de ale_bl:
+       Ale_bl(ig)=0.5*zw2(ig,lmix(ig))**2 
+!     & /2.
+!     & *0.1
+!        Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2 
+!       if (n_int(ig).gt.0) then
+!       Ale_bl(ig)=ale_int(ig)/n_int(ig)
+!        Ale_bl(ig)=4.
+!       endif
+!       endif
+!            Ale_bl(ig)=0.5*wth2(ig,lmix_bis(ig))
+!          Ale_bl(ig)=wth2(ig,nivcon(ig))
+!          write(19,*),'wth2,ALE_BL',wth2(ig,nivcon(ig)),Ale_bl(ig)
+      enddo
+!test:calcul de la ponderation des couches pour KE
+!initialisations
+!      print*,'ponderation'
+      do ig=1,ngrid
+           fm_tot(ig)=0.
+      enddo
+       do ig=1,ngrid
+        do k=1,klev
+           wght_th(ig,k)=1.
+        enddo
+       enddo
+       do ig=1,ngrid
+!         lalim_conv(ig)=lmix_bis(ig)
+!la hauteur de la couche alim_conv = hauteur couche alim_therm
+         lalim_conv(ig)=lalim(ig)
+!         zentr(ig)=zlev(ig,lalim(ig))
+      enddo
+      do ig=1,ngrid
+        do k=1,lalim_conv(ig)
+           fm_tot(ig)=fm_tot(ig)+fm(ig,k)
+        enddo
+      enddo
+      do ig=1,ngrid
+        do k=1,lalim_conv(ig)
+           if (fm_tot(ig).gt.1.e-10) then
+!           wght_th(ig,k)=fm(ig,k)/fm_tot(ig)
+           endif
+!on pondere chaque couche par a*
+             if (alim_star(ig,k).gt.1.e-10) then
+             wght_th(ig,k)=alim_star(ig,k)
+             else
+             wght_th(ig,k)=1.
+             endif
+        enddo
+      enddo
+!      print*,'apres wght_th'
+!test pour prolonger la convection
+      do ig=1,ngrid
+!v1d  if ((alim_star(ig,1).lt.1.e-10).and.(therm)) then
+      if ((alim_star(ig,1).lt.1.e-10)) then
+      lalim_conv(ig)=1
+      wght_th(ig,1)=1.
+!      print*,'lalim_conv ok',lalim_conv(ig),wght_th(ig,1)
+      endif
+      enddo
+
+!calcul du ratqscdiff
+      if (prt_level.ge.1) print*,'14e OK convect8'
+      var=0.
+      vardiff=0.
+      ratqsdiff(:,:)=0.
+      do ig=1,ngrid
+         do l=1,lalim(ig)
+            var=var+alim_star(ig,l)*zqta(ig,l)*1000.
+         enddo
+      enddo
+      if (prt_level.ge.1) print*,'14f OK convect8'
+      do ig=1,ngrid
+          do l=1,lalim(ig)
+          zf=fraca(ig,l)
+          zf2=zf/(1.-zf)
+          vardiff=vardiff+alim_star(ig,l)  &
+     &           *(zqta(ig,l)*1000.-var)**2
+!         ratqsdiff=ratqsdiff+alim_star(ig,l)*
+!     s          (zqta(ig,l)*1000.-po(ig,l)*1000.)**2
+          enddo
+      enddo
+      if (prt_level.ge.1) print*,'14g OK convect8'
+      do l=1,nlay
+         do ig=1,ngrid
+            ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
+!           write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
+         enddo
+      enddo 
+!--------------------------------------------------------------------    
+!
+!ecriture des fichiers sortie
+!     print*,'15 OK convect8'
+
+      if (prt_level.ge.1) print*,'thermcell_main sorties 3D'
+#ifdef wrgrads_thermcell
+#include "thermcell_out3d.h"
+#endif
+
+      endif
+
+      if (prt_level.ge.1) print*,'thermcell_main FIN  OK'
+
+!     if(icount.eq.501) stop'au pas 301 dans thermcell_main'
+      return
+      end
+
+!-----------------------------------------------------------------------------
+
+      subroutine testV0_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
+      IMPLICIT NONE
+#include "iniprint.h"
+
+      integer i, k, klon,klev
+      real pplev(klon,klev+1),pplay(klon,klev)
+      real ztv(klon,klev)
+      real po(klon,klev)
+      real ztva(klon,klev)
+      real zqla(klon,klev)
+      real f_star(klon,klev)
+      real zw2(klon,klev)
+      integer long(klon)
+      real seuil
+      character*21 comment
+
+      if (prt_level.ge.1) THEN
+       print*,'WARNING !!! TEST ',comment
+      endif
+      return
+
+!  test sur la hauteur des thermiques ...
+         do i=1,klon
+!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
+           if (prt_level.ge.10) then
+               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
+               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
+               do k=1,klev
+                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
+               enddo
+           endif
+         enddo
+
+
+      return
+      end
+
+!==============================================================================
+      SUBROUTINE thermcellV0_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
+
+!-------------------------------------------------------------------------
+!thermcell_closure: fermeture, determination de f
+!-------------------------------------------------------------------------
+      IMPLICIT NONE
+
+#include "iniprint.h"
+#include "thermcell.h"
+      INTEGER ngrid,nlay
+      INTEGER ig,k       
+      REAL r_aspect,ptimestep
+      integer lev_out                           ! niveau pour les print
+
+      INTEGER lalim(ngrid)
+      REAL alim_star(ngrid,nlay)
+      REAL alim_star_tot(ngrid)
+      REAL rho(ngrid,nlay)
+      REAL zlev(ngrid,nlay)
+      REAL zmax(ngrid),zmax_sec(ngrid)
+      REAL wmax(ngrid),wmax_sec(ngrid)
+      real zdenom
+
+      REAL alim_star2(ngrid)
+
+      REAL f(ngrid)
+
+      character (len=20) :: modname='thermcellV0_main'
+      character (len=80) :: abort_message
+
+      do ig=1,ngrid
+         alim_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (alim_star(ig,1).LT.1.e-10) then
+            f(ig)=0.
+         else   
+             do k=1,lalim(ig)
+                alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
+     &                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+             zdenom=max(500.,zmax(ig))*r_aspect*alim_star2(ig)
+             if (zdenom<1.e-14) then
+                print*,'ig=',ig
+                print*,'alim_star2',alim_star2(ig)
+                print*,'zmax',zmax(ig)
+                print*,'r_aspect',r_aspect
+                print*,'zdenom',zdenom
+                print*,'alim_star',alim_star(ig,:)
+                print*,'zmax_sec',zmax_sec(ig)
+                print*,'wmax_sec',wmax_sec(ig)
+                abort_message = 'zdenom<1.e-14'
+                CALL abort_gcm (modname,abort_message,1)
+             endif
+             if ((zmax_sec(ig).gt.1.e-10).and.(iflag_thermals_ed.eq.0)) then 
+             f(ig)=wmax_sec(ig)*alim_star_tot(ig)/(max(500.,zmax_sec(ig))*r_aspect  &
+     &             *alim_star2(ig))
+!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
+!    &                     zmax_sec(ig))*wmax_sec(ig))
+             if(prt_level.GE.10) write(lunout,*)'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig)
+             else
+             f(ig)=wmax(ig)*alim_star_tot(ig)/zdenom
+!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
+!     &                     zmax(ig))*wmax(ig))
+             if(prt_level.GE.10) print*,'closure moist',f(ig),wmax(ig),alim_star_tot(ig),zmax(ig)
+             endif
+         endif
+!         f0(ig)=f(ig)
+      enddo
+      if (prt_level.ge.1) print*,'apres fermeture'
+
+!
+      return
+      end
+!==============================================================================
+      SUBROUTINE thermcellV0_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
+     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,w_est,zqsatth,lmix,lmix_bis,linter &
+     &           ,lev_out,lunout1,igout)
+
+!--------------------------------------------------------------------------
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+!--------------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "iniprint.h"
+#include "thermcell.h"
+
+      INTEGER itap
+      INTEGER lunout1,igout
+      INTEGER ngrid,klev
+      REAL ptimestep
+      REAL ztv(ngrid,klev)
+      REAL zthl(ngrid,klev)
+      REAL po(ngrid,klev)
+      REAL zl(ngrid,klev)
+      REAL rhobarz(ngrid,klev)
+      REAL zlev(ngrid,klev+1)
+      REAL pplev(ngrid,klev+1)
+      REAL pphi(ngrid,klev)
+      REAL zpspsk(ngrid,klev)
+      REAL alim_star(ngrid,klev)
+      REAL zmax_sec(ngrid)
+      REAL f0(ngrid)
+      REAL l_mix
+      REAL r_aspect
+      INTEGER lalim(ngrid)
+      integer lev_out                           ! niveau pour les print
+      real zcon2(ngrid)
+    
+      real alim_star_tot(ngrid)
+
+      REAL ztva(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zqla(ngrid,klev)
+      REAL zqla0(ngrid,klev)
+      REAL zqta(ngrid,klev)
+      REAL zha(ngrid,klev)
+
+      REAL detr_star(ngrid,klev)
+      REAL coefc
+      REAL detr_stara(ngrid,klev)
+      REAL detr_starb(ngrid,klev)
+      REAL detr_starc(ngrid,klev)
+      REAL detr_star0(ngrid,klev)
+      REAL detr_star1(ngrid,klev)
+      REAL detr_star2(ngrid,klev)
+
+      REAL entr_star(ngrid,klev)
+      REAL entr_star1(ngrid,klev)
+      REAL entr_star2(ngrid,klev)
+      REAL detr(ngrid,klev)
+      REAL entr(ngrid,klev)
+
+      REAL zw2(ngrid,klev+1)
+      REAL w_est(ngrid,klev+1)
+      REAL f_star(ngrid,klev+1)
+      REAL wa_moy(ngrid,klev+1)
+
+      REAL ztva_est(ngrid,klev)
+      REAL zqla_est(ngrid,klev)
+      REAL zqsatth(ngrid,klev)
+      REAL zta_est(ngrid,klev)
+
+      REAL linter(ngrid)
+      INTEGER lmix(ngrid)
+      INTEGER lmix_bis(ngrid)
+      REAL    wmaxa(ngrid)
+
+      INTEGER ig,l,k
+
+      real zcor,zdelta,zcvm5,qlbef
+      real Tbef,qsatbef
+      real dqsat_dT,DT,num,denom
+      REAL REPS,RLvCp,DDT0
+      PARAMETER (DDT0=.01)
+      logical Zsat
+      REAL fact_gamma,fact_epsilon
+      REAL c2(ngrid,klev)
+
+      Zsat=.false.
+! Initialisation
+      RLvCp = RLVTT/RCPD
+     
+      if (iflag_thermals_ed==0) then
+         fact_gamma=1.
+         fact_epsilon=1.
+      else if (iflag_thermals_ed==1)  then
+         fact_gamma=1.
+         fact_epsilon=1.
+      else if (iflag_thermals_ed==2)  then
+         fact_gamma=1.
+         fact_epsilon=2.
+      endif
+
+      do l=1,klev
+         do ig=1,ngrid
+            zqla_est(ig,l)=0.
+            ztva_est(ig,l)=ztva(ig,l)
+            zqsatth(ig,l)=0.
+         enddo
+      enddo
+
+!CR: attention test couche alim
+!     do l=2,klev
+!     do ig=1,ngrid
+!        alim_star(ig,l)=0.
+!     enddo
+!     enddo
+!AM:initialisations du thermique
+      do k=1,klev
+         do ig=1,ngrid
+            ztva(ig,k)=ztv(ig,k)
+            ztla(ig,k)=zthl(ig,k)
+            zqla(ig,k)=0.
+            zqta(ig,k)=po(ig,k)
+!
+            ztva(ig,k) = ztla(ig,k)*zpspsk(ig,k)+RLvCp*zqla(ig,k)
+            ztva(ig,k) = ztva(ig,k)/zpspsk(ig,k)
+            zha(ig,k) = ztva(ig,k)
+!
+         enddo
+      enddo 
+      do k=1,klev
+        do ig=1,ngrid
+           detr_star(ig,k)=0.
+           entr_star(ig,k)=0.
+
+           detr_stara(ig,k)=0.
+           detr_starb(ig,k)=0.
+           detr_starc(ig,k)=0.
+           detr_star0(ig,k)=0.
+           zqla0(ig,k)=0.
+           detr_star1(ig,k)=0.
+           detr_star2(ig,k)=0.
+           entr_star1(ig,k)=0.
+           entr_star2(ig,k)=0.
+
+           detr(ig,k)=0.
+           entr(ig,k)=0.
+        enddo
+      enddo
+      if (prt_level.ge.1) print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            w_est(ig,k)=0.
+            f_star(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+      if (prt_level.ge.1) print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmix(ig)=1
+         lmix_bis(ig)=2
+         wmaxa(ig)=0.
+      enddo
+
+!-----------------------------------------------------------------------------------
+!boucle de calcul de la vitesse verticale dans le thermique
+!-----------------------------------------------------------------------------------
+      do l=1,klev-1
+         do ig=1,ngrid
+
+
+
+! Calcul dans la premiere couche active du thermique (ce qu'on teste
+! en disant que la couche est instable et que w2 en bas de la couche
+! est nulle.
+
+            if (ztv(ig,l).gt.ztv(ig,l+1)  &
+     &         .and.alim_star(ig,l).gt.1.e-10  &
+     &         .and.zw2(ig,l).lt.1e-10) then
+
+
+! Le panache va prendre au debut les caracteristiques de l'air contenu
+! dans cette couche.
+               ztla(ig,l)=zthl(ig,l) 
+               zqta(ig,l)=po(ig,l)
+               zqla(ig,l)=zl(ig,l)
+               f_star(ig,l+1)=alim_star(ig,l)
+
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
+     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
+     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               w_est(ig,l+1)=zw2(ig,l+1)
+!
+
+
+            else if ((zw2(ig,l).ge.1e-10).and.  &
+     &         (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then
+!estimation du detrainement a partir de la geometrie du pas precedent
+!tests sur la definition du detr
+!calcul de detr_star et entr_star
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH le test miraculeux de Catherine ? Le bout du tunel ?
+!               w_est(ig,3)=zw2(ig,2)*  &
+!    &                   ((f_star(ig,2))**2)  &
+!    &                   /(f_star(ig,2)+alim_star(ig,2))**2+  &
+!    &                   2.*RG*(ztva(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+!    &                   *(zlev(ig,3)-zlev(ig,2))
+!     if (l.gt.2) then
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+! Premier calcul de la vitesse verticale a partir de la temperature
+! potentielle virtuelle
+
+! FH CESTQUOI CA ????
+#define int1d2
+!#undef int1d2
+#ifdef int1d2
+      if (l.ge.2) then
+#else
+      if (l.gt.2) then
+#endif
+
+      if (1.eq.1) then
+          w_est(ig,3)=zw2(ig,2)* &
+     &      ((f_star(ig,2))**2) &
+     &      /(f_star(ig,2)+alim_star(ig,2))**2+ &
+     &      2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) &
+!     &      *1./3. &
+     &      *(zlev(ig,3)-zlev(ig,2))
+       endif
+
+
+!---------------------------------------------------------------------------
+!calcul de l entrainement et du detrainement lateral
+!---------------------------------------------------------------------------
+!
+!test:estimation de ztva_new_est sans entrainement
+
+               Tbef=ztla(ig,l-1)*zpspsk(ig,l)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
+               qsatbef=MIN(0.5,qsatbef)
+               zcor=1./(1.-retv*qsatbef)
+               qsatbef=qsatbef*zcor
+               Zsat = (max(0.,zqta(ig,l-1)-qsatbef) .gt. 1.e-10)
+               if (Zsat) then
+               qlbef=max(0.,zqta(ig,l-1)-qsatbef)
+               DT = 0.5*RLvCp*qlbef
+               do while (abs(DT).gt.DDT0)
+                 Tbef=Tbef+DT
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
+                 qsatbef=MIN(0.5,qsatbef)
+                 zcor=1./(1.-retv*qsatbef)
+                 qsatbef=qsatbef*zcor
+                 qlbef=zqta(ig,l-1)-qsatbef
+
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef)
+                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
+                 num=-Tbef+ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 DT=num/denom
+               enddo
+                 zqla_est(ig,l) = max(0.,zqta(ig,l-1)-qsatbef) 
+               endif
+        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
+     &      -zqla_est(ig,l))-zqla_est(ig,l))
+
+             w_est(ig,l+1)=zw2(ig,l)*  &
+     &                   ((f_star(ig,l))**2)  &
+     &                   /(f_star(ig,l)+alim_star(ig,l))**2+  &
+     &                   2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+!     &                   *1./3. &
+     &                   *(zlev(ig,l+1)-zlev(ig,l))
+             if (w_est(ig,l+1).lt.0.) then
+                w_est(ig,l+1)=zw2(ig,l)
+             endif
+!
+!calcul du detrainement
+!=======================
+
+!CR:on vire les modifs
+         if (iflag_thermals_ed==0) then
+
+! Modifications du calcul du detrainement.
+! Dans la version de la these de Catherine, on passe brusquement
+! de la version seche a la version nuageuse pour le detrainement
+! ce qui peut occasioner des oscillations.
+! dans la nouvelle version, on commence par calculer un detrainement sec.
+! Puis un autre en cas de nuages.
+! Puis on combine les deux lineairement en fonction de la quantite d'eau.
+
+#define int1d3
+!#undef int1d3
+#define RIO_TH
+#ifdef RIO_TH
+!1. Cas non nuageux
+! 1.1 on est sous le zmax_sec et w croit
+          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
+     &       (zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
+#ifdef int1d3
+     &       (zqla_est(ig,l).lt.1.e-10)) then 
+#else
+     &       (zqla(ig,l-1).lt.1.e-10)) then 
+#endif
+             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
+     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
+     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
+     &       /(r_aspect*zmax_sec(ig)))
+             detr_stara(ig,l)=detr_star(ig,l)
+
+       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l',ig,l
+
+! 1.2 on est sous le zmax_sec et w decroit
+          else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
+#ifdef int1d3
+     &            (zqla_est(ig,l).lt.1.e-10)) then
+#else
+     &            (zqla(ig,l-1).lt.1.e-10)) then
+#endif
+             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
+     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
+     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
+     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
+     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
+     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
+     &       *((zmax_sec(ig)-zlev(ig,l))/  &
+     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
+             detr_starb(ig,l)=detr_star(ig,l)
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l',ig,l
+
+          else
+
+! 1.3 dans les autres cas
+             detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
+     &                      *(zlev(ig,l+1)-zlev(ig,l))
+             detr_starc(ig,l)=detr_star(ig,l)
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 3 n: ig, l',ig, l
+             
+          endif
+
+#else
+
+! 1.1 on est sous le zmax_sec et w croit
+          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
+     &       (zlev(ig,l+1).lt.zmax_sec(ig)) ) then
+             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
+     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
+     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
+     &       /(r_aspect*zmax_sec(ig)))
+
+       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
+
+! 1.2 on est sous le zmax_sec et w decroit
+          else if ((zlev(ig,l+1).lt.zmax_sec(ig)) ) then
+             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
+     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
+     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
+     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
+     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
+     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
+     &       *((zmax_sec(ig)-zlev(ig,l))/  &
+     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
+       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
+
+          else
+             detr_star=0.
+          endif
+
+! 1.3 dans les autres cas
+          detr_starc(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
+     &                      *(zlev(ig,l+1)-zlev(ig,l))
+
+          coefc=min(zqla(ig,l-1)/1.e-3,1.)
+          if (zlev(ig,l+1).ge.zmax_sec(ig)) coefc=1.
+          coefc=1.
+! il semble qu'il soit important de baser le calcul sur
+! zqla_est(ig,l-1) plutot que sur zqla_est(ig,l)
+          detr_star(ig,l)=detr_starc(ig,l)*coefc+detr_star(ig,l)*(1.-coefc)
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l', ig, l
+
+#endif
+
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 444: ig, l', ig, l
+!IM 730508 beg
+!        if(itap.GE.7200) THEN
+!         print*,'th_plume ig,l,itap,zqla_est=',ig,l,itap,zqla_est(ig,l)
+!        endif
+!IM 730508 end
+         
+         zqla0(ig,l)=zqla_est(ig,l)
+         detr_star0(ig,l)=detr_star(ig,l)
+!IM 060508 beg
+!         if(detr_star(ig,l).GT.1.) THEN
+!          print*,'th_plumeBEF ig l detr_star detr_starc coefc',ig,l,detr_star(ig,l) &
+!   &      ,detr_starc(ig,l),coefc
+!         endif
+!IM 060508 end
+!IM 160508 beg
+!IM 160508       IF (f0(ig).NE.0.) THEN
+           detr_star(ig,l)=detr_star(ig,l)/f0(ig)
+!IM 160508       ELSE IF(detr_star(ig,l).EQ.0.) THEN
+!IM 160508        print*,'WARNING1  : th_plume f0=0, detr_star=0: ig, l, itap',ig,l,itap
+!IM 160508       ELSE
+!IM 160508        print*,'WARNING2  : th_plume f0=0, ig, l, itap, detr_star',ig,l,itap,detr_star(ig,l)
+!IM 160508       ENDIF
+!IM 160508 end
+!IM 060508 beg
+!        if(detr_star(ig,l).GT.1.) THEN
+!         print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), &
+!   &     REAL(1)/f0(ig)
+!        endif
+!IM 060508 end
+        if (prt_level.ge.20) print*,'coucou calcul detr 445: ig, l', ig, l
+!
+!calcul de entr_star
+
+! #undef test2
+! #ifdef test2
+! La version test2 destabilise beaucoup le modele.
+! Il semble donc que ca aide d'avoir un entrainement important sous
+! le nuage.
+!         if (zqla_est(ig,l-1).ge.1.e-10.and.l.gt.lalim(ig)) then
+!          entr_star(ig,l)=0.4*detr_star(ig,l)
+!         else
+!          entr_star(ig,l)=0.
+!         endif
+! #else
+!
+! Deplacement du calcul de entr_star pour eviter d'avoir aussi
+! entr_star > fstar.
+! Redeplacer suite a la transformation du cas detr>f
+! FH
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 446: ig, l', ig, l
+#define int1d
+!FH 070508 #define int1d4
+!#undef int1d4
+! L'option int1d4 correspond au choix dans le cas ou le detrainement
+! devient trop grand.
+
+#ifdef int1d
+
+#ifdef int1d4
+#else
+       detr_star(ig,l)=min(detr_star(ig,l),f_star(ig,l))
+!FH 070508 plus
+       detr_star(ig,l)=min(detr_star(ig,l),1.)
+#endif
+
+       entr_star(ig,l)=max(0.4*detr_star(ig,l)-alim_star(ig,l),0.)
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 447: ig, l', ig, l
+#ifdef int1d4
+! Si le detrainement excede le flux en bas + l'entrainement, le thermique
+! doit disparaitre.
+       if (detr_star(ig,l)>f_star(ig,l)+entr_star(ig,l)) then
+          detr_star(ig,l)=f_star(ig,l)+entr_star(ig,l)
+          f_star(ig,l+1)=0.
+          linter(ig)=l+1
+          zw2(ig,l+1)=-1.e-10
+       endif
+#endif
+
+
+#else
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 448: ig, l', ig, l
+        if(l.gt.lalim(ig)) then
+         entr_star(ig,l)=0.4*detr_star(ig,l)
+        else
+
+! FH :
+! Cette ligne doit permettre de garantir qu'on a toujours un flux = 1
+! en haut de la couche d'alimentation.
+! A remettre en questoin a la premiere occasion mais ca peut aider a 
+! ecrire un code robuste.
+! Que ce soit avec ca ou avec l'ancienne facon de faire (e* = 0 mais
+! d* non nul) on a une discontinuité de e* ou d* en haut de la couche
+! d'alimentation, ce qui n'est pas forcement heureux.
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 449: ig, l', ig, l
+#undef pre_int1c
+#ifdef pre_int1c
+         entr_star(ig,l)=max(detr_star(ig,l)-alim_star(ig,l),0.)
+         detr_star(ig,l)=entr_star(ig,l)
+#else
+         entr_star(ig,l)=0.
+#endif
+
+        endif
+
+#endif
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 440: ig, l', ig, l
+        entr_star1(ig,l)=entr_star(ig,l)
+        detr_star1(ig,l)=detr_star(ig,l)
+!
+
+#ifdef int1d
+#else
+        if (detr_star(ig,l).gt.f_star(ig,l)) then
+
+!  Ce test est là entre autres parce qu'on passe par des valeurs
+!  delirantes de detr_star.
+!  ca vaut sans doute le coup de verifier pourquoi.
+
+           detr_star(ig,l)=f_star(ig,l)
+#ifdef pre_int1c
+           if (l.gt.lalim(ig)+1) then
+               entr_star(ig,l)=0.
+               alim_star(ig,l)=0.
+! FH ajout pour forcer a stoper le thermique juste sous le sommet
+! de la couche (voir calcul de finter)
+               zw2(ig,l+1)=-1.e-10
+               linter(ig)=l+1
+            else
+               entr_star(ig,l)=0.4*detr_star(ig,l)
+            endif
+#else
+           entr_star(ig,l)=0.4*detr_star(ig,l)
+#endif
+        endif
+#endif
+
+      else !l > 2
+         detr_star(ig,l)=0.
+         entr_star(ig,l)=0.
+      endif
+
+        entr_star2(ig,l)=entr_star(ig,l)
+        detr_star2(ig,l)=detr_star(ig,l)
+        if (prt_level.ge.20) print*,'coucou calcul detr 450: ig, l', ig, l
+
+       endif  ! iflag_thermals_ed==0
+
+!CR:nvlle def de entr_star et detr_star
+      if (iflag_thermals_ed>=1) then
+!      if (l.lt.lalim(ig)) then
+!      if (l.lt.2) then 
+!        entr_star(ig,l)=0.
+!        detr_star(ig,l)=0.
+!      else
+!      if (0.001.gt.(RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))/(2.*w_est(ig,l+1)))) then 
+!         entr_star(ig,l)=0.001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+!      else
+!         entr_star(ig,l)=  &
+!     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
+!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))
+
+ 
+         entr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &          
+     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
+     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)   &
+     &                *(zlev(ig,l+1)-zlev(ig,l))) &
+     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+
+        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
+            alim_star_tot(ig)=alim_star_tot(ig)+entr_star(ig,l)
+            lalim(ig)=lmix_bis(ig)
+            if(prt_level.GE.10) print*,'alim_star_tot',alim_star_tot(ig),entr_star(ig,l)
+        endif
+
+        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
+!        c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
+         c2(ig,l)=0.001
+         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
+     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
+     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
+     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
+     &                *(zlev(ig,l+1)-zlev(ig,l)))                    &
+     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+
+       else
+!         c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
+          c2(ig,l)=0.003
+
+         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
+     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
+     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
+     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
+     &                *(zlev(ig,l+1)-zlev(ig,l))) &
+     &                +0.0002*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+       endif
+         
+           
+!        detr_star(ig,l)=detr_star(ig,l)*3.
+!        if (l.lt.lalim(ig)) then
+!          entr_star(ig,l)=0.
+!        endif
+!        if (l.lt.2) then
+!          entr_star(ig,l)=0.
+!          detr_star(ig,l)=0.
+!        endif
+
+
+!      endif 
+!      else if ((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10) then
+!      entr_star(ig,l)=MAX(0.,0.8*f_star(ig,l)/(2.*w_est(ig,l+1))        &
+!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))
+!      detr_star(ig,l)=0.002*f_star(ig,l)                         &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))
+!      else
+!      entr_star(ig,l)=0.001*f_star(ig,l)                         &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))
+!      detr_star(ig,l)=MAX(0.,-0.2*f_star(ig,l)/(2.*w_est(ig,l+1))       &
+!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))       &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))                      &
+!     &                +0.002*f_star(ig,l)                             &
+!     &                *(zlev(ig,l+1)-zlev(ig,l))
+!      endif
+
+      endif   ! iflag_thermals_ed==1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH inutile si on conserve comme on l'a fait plus haut entr=detr
+! dans la couche d'alimentation
+!pas d entrainement dans la couche alim
+!      if ((l.le.lalim(ig))) then
+!           entr_star(ig,l)=0.
+!      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!prise en compte du detrainement et de l entrainement dans le calcul du flux
+
+      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
+     &              -detr_star(ig,l)
+
+!test sur le signe de f_star
+        if (prt_level.ge.20) print*,'coucou calcul detr 451: ig, l', ig, l
+       if (f_star(ig,l+1).gt.1.e-10) then 
+!----------------------------------------------------------------------------
+!calcul de la vitesse verticale en melangeant Tl et qt du thermique
+!---------------------------------------------------------------------------
+!
+       Zsat=.false.
+       ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+!
+       zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+!  
+               Tbef=ztla(ig,l)*zpspsk(ig,l)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)               
+               qsatbef=MIN(0.5,qsatbef)
+               zcor=1./(1.-retv*qsatbef)
+               qsatbef=qsatbef*zcor
+               Zsat = (max(0.,zqta(ig,l)-qsatbef) .gt. 1.e-10)
+               if (Zsat) then
+               qlbef=max(0.,zqta(ig,l)-qsatbef)
+               DT = 0.5*RLvCp*qlbef
+               do while (abs(DT).gt.DDT0)
+                 Tbef=Tbef+DT
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
+                 qsatbef=MIN(0.5,qsatbef)
+                 zcor=1./(1.-retv*qsatbef)
+                 qsatbef=qsatbef*zcor
+                 qlbef=zqta(ig,l)-qsatbef
+
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef)
+                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
+                 num=-Tbef+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 DT=num/denom
+              enddo
+                 zqla(ig,l) = max(0.,qlbef) 
+              endif
+!    
+        if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l
+! on ecrit de maniere conservative (sat ou non)
+!          T = Tl +Lv/Cp ql
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
+     &              -zqla(ig,l))-zqla(ig,l))
+
+!on ecrit zqsat 
+           zqsatth(ig,l)=qsatbef  
+!calcul de vitesse
+           zw2(ig,l+1)=zw2(ig,l)*  &
+     &                 ((f_star(ig,l))**2)  &
+!  Tests de Catherine
+!     &                 /(f_star(ig,l+1)+detr_star(ig,l))**2+             &
+     &      /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-fact_epsilon))**2+ &
+     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+     &                 *fact_gamma &
+     &                 *(zlev(ig,l+1)-zlev(ig,l))
+!prise en compte des forces de pression que qd flottabilité<0
+!              zw2(ig,l+1)=zw2(ig,l)*  &
+!     &            1./(1.+2.*entr_star(ig,l)/f_star(ig,l)) + &        
+!     &                 (f_star(ig,l))**2 &
+!     &                 /(f_star(ig,l)+entr_star(ig,l))**2+ &
+!     &                 (f_star(ig,l)-2.*entr_star(ig,l))**2/(f_star(ig,l)+2.*entr_star(ig,l))**2+  &        
+!     &                 /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-2.))**2+ &
+!     &                 /(f_star(ig,l)**2+2.*2.*detr_star(ig,l)*f_star(ig,l)+2.*entr_star(ig,l)*f_star(ig,l))+ &
+!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+!     &                 *1./3. &
+!     &                 *(zlev(ig,l+1)-zlev(ig,l))
+          
+!        write(30,*),l+1,zw2(ig,l+1)-zw2(ig,l), &
+!     &              -2.*entr_star(ig,l)/f_star(ig,l)*zw2(ig,l), &
+!     &               2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+
+ 
+!             zw2(ig,l+1)=zw2(ig,l)*  &
+!     &                 (2.-2.*entr_star(ig,l)/f_star(ig,l)) &  
+!     &                 -zw2(ig,l-1)+  &        
+!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+!     &                 *1./3. &
+!     &                 *(zlev(ig,l+1)-zlev(ig,l))             
+
+            endif
+        endif
+        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
+!
+!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
+
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+                print*,'On tombe sur le cas particulier de thermcell_plume'
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+            endif
+
+!        if ((zw2(ig,l).gt.0.).and. (zw2(ig,l+1).le.0.)) then
+        if (zw2(ig,l+1).lt.0.) then 
+           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+           zw2(ig,l+1)=0.
+        endif
+
+           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
+
+        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+!on rajoute le calcul de lmix_bis
+            if (zqla(ig,l).lt.1.e-10) then
+               lmix_bis(ig)=l+1
+            endif
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+        enddo
+      enddo
+
+!on remplace a* par e* ds premiere couche
+!      if (iflag_thermals_ed.ge.1) then
+!       do ig=1,ngrid
+!       do l=2,klev
+!          if (l.lt.lalim(ig)) then
+!             alim_star(ig,l)=entr_star(ig,l)
+!          endif
+!       enddo
+!       enddo
+!       do ig=1,ngrid
+!          lalim(ig)=lmix_bis(ig)
+!       enddo
+!      endif
+       if (iflag_thermals_ed.ge.1) then
+          do ig=1,ngrid
+             do l=2,lalim(ig)
+                alim_star(ig,l)=entr_star(ig,l)
+                entr_star(ig,l)=0.
+             enddo
+           enddo
+       endif
+        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+
+!     print*,'thermcell_plume OK'
+
+      return 
+      end
+!==============================================================================
+       SUBROUTINE thermcellV0_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
+     &                            lalim,lmin,zmax,wmax,lev_out)
+
+!--------------------------------------------------------------------------
+!thermcell_dry: calcul de zmax et wmax du thermique sec
+!--------------------------------------------------------------------------
+       IMPLICIT NONE
+#include "YOMCST.h"       
+#include "iniprint.h"
+       INTEGER l,ig
+
+       INTEGER ngrid,nlay
+       REAL zlev(ngrid,nlay+1)
+       REAL pphi(ngrid,nlay)
+       REAl ztv(ngrid,nlay)
+       REAL alim_star(ngrid,nlay)
+       INTEGER lalim(ngrid)
+      integer lev_out                           ! niveau pour les print
+
+       REAL zmax(ngrid)
+       REAL wmax(ngrid)
+
+!variables locales
+       REAL zw2(ngrid,nlay+1)
+       REAL f_star(ngrid,nlay+1)
+       REAL ztva(ngrid,nlay+1)
+       REAL wmaxa(ngrid)
+       REAL wa_moy(ngrid,nlay+1)
+       REAL linter(ngrid),zlevinter(ngrid)
+       INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
+
+!initialisations
+       do ig=1,ngrid
+          do l=1,nlay+1
+             zw2(ig,l)=0.
+             wa_moy(ig,l)=0.
+          enddo
+       enddo
+       do ig=1,ngrid
+          do l=1,nlay
+             ztva(ig,l)=ztv(ig,l)
+          enddo
+       enddo
+       do ig=1,ngrid
+          wmax(ig)=0.
+          wmaxa(ig)=0.
+       enddo
+!calcul de la vitesse a partir de la CAPE en melangeant thetav
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! A eliminer
+! Ce if complique etait fait pour reperer la premiere couche instable
+! Ici, c'est lmin.
+!
+!       do l=1,nlay-2
+!         do ig=1,ngrid
+!            if (ztv(ig,l).gt.ztv(ig,l+1)  &
+!     &         .and.alim_star(ig,l).gt.1.e-10  &
+!     &         .and.zw2(ig,l).lt.1e-10) then
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+! Calcul des F^*, integrale verticale de E^*
+       f_star(:,1)=0.
+       do l=1,nlay
+          f_star(:,l+1)=f_star(:,l)+alim_star(:,l)
+       enddo
+
+! niveau (reel) auquel zw2 s'annule FH :n'etait pas initialise
+       linter(:)=0.
+
+! couche la plus haute concernee par le thermique. 
+       lmax(:)=1
+
+! Le niveau linter est une variable continue qui se trouve dans la couche
+! lmax
+
+       do l=1,nlay-2
+         do ig=1,ngrid
+            if (l.eq.lmin(ig).and.lalim(ig).gt.1) then
+
+!------------------------------------------------------------------------
+!  Calcul de la vitesse en haut de la premiere couche instable.
+!  Premiere couche du panache thermique
+!------------------------------------------------------------------------
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
+     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
+     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+
+!------------------------------------------------------------------------
+! Tant que la vitesse en bas de la couche et la somme du flux de masse
+! et de l'entrainement (c'est a dire le flux de masse en haut) sont
+! positifs, on calcul
+! 1. le flux de masse en haut  f_star(ig,l+1)
+! 2. la temperature potentielle virtuelle dans la couche ztva(ig,l)
+! 3. la vitesse au carré en haut zw2(ig,l+1)
+!------------------------------------------------------------------------
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!  A eliminer : dans cette version, si zw2 est > 0 on a un therique.
+!  et donc, au dessus, f_star(ig,l+1) est forcement suffisamment 
+!  grand puisque on n'a pas de detrainement.
+!  f_star est une fonction croissante.
+!  c'est donc vraiment sur zw2 uniquement qu'il faut faire le test.
+!           else if ((zw2(ig,l).ge.1e-10).and.  &
+!    &               (f_star(ig,l)+alim_star(ig,l).gt.1.e-10)) then
+!              f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+            else if (zw2(ig,l).ge.1e-10) then
+
+               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+alim_star(ig,l)  &
+     &                    *ztv(ig,l))/f_star(ig,l+1)
+               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+  &
+     &                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+     &                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+! determination de zmax continu par interpolation lineaire
+!------------------------------------------------------------------------
+
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               print*,'On tombe sur le cas particulier de thermcell_dry'
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+                lmax(ig)=l
+            endif
+
+            if (zw2(ig,l+1).lt.0.) then
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmax(ig)=l
+            endif
+
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+               lmix(ig)=l+1
+               wmaxa(ig)=wa_moy(ig,l+1)
+            endif
+         enddo
+      enddo
+       if (prt_level.ge.1) print*,'fin calcul zw2'
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! A eliminer :
+! Ce calcul de lmax est fait en meme temps que celui de linter, plus haut
+! Calcul de la couche correspondant a la hauteur du thermique
+!      do ig=1,ngrid
+!         lmax(ig)=lalim(ig)
+!      enddo
+!      do ig=1,ngrid
+!         do l=nlay,lalim(ig)+1,-1
+!            if (zw2(ig,l).le.1.e-10) then
+!               lmax(ig)=l-1
+!            endif
+!         enddo
+!      enddo
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!    
+! Determination de zw2 max
+      do ig=1,ngrid
+         wmax(ig)=0.
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+                zw2(ig,l)=sqrt(zw2(ig,l))
+                wmax(ig)=max(wmax(ig),zw2(ig,l))
+            else
+                 zw2(ig,l)=0.
+            endif
+          enddo
+      enddo
+
+!   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=0.
+         zlevinter(ig)=zlev(ig,1)
+      enddo
+      do  ig=1,ngrid
+! calcul de zlevinter
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH A eliminer
+! Simplification
+!          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
+!     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
+!     &    -zlev(ig,lmax(ig)))
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+          zlevinter(ig)=zlev(ig,lmax(ig)) + &
+     &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
+           zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+! Verification que lalim<=lmax
+      do ig=1,ngrid
+         if(lalim(ig)>lmax(ig)) then
+           if ( prt_level > 1 ) THEN
+            print*,'WARNING thermcell_dry ig=',ig,'  lalim=',lalim(ig),'  lmax(ig)=',lmax(ig)
+           endif
+           lmax(ig)=lalim(ig)
+         endif
+      enddo
+      
+      RETURN
+      END
+!==============================================================================
+      SUBROUTINE thermcellV0_init(ngrid,nlay,ztv,zlay,zlev,  &
+     &                  lalim,lmin,alim_star,alim_star_tot,lev_out)
+
+!----------------------------------------------------------------------
+!thermcell_init: calcul du profil d alimentation du thermique
+!----------------------------------------------------------------------
+      IMPLICIT NONE
+#include "iniprint.h"
+#include "thermcell.h"
+
+      INTEGER l,ig
+!arguments d entree
+      INTEGER ngrid,nlay
+      REAL ztv(ngrid,nlay)
+      REAL zlay(ngrid,nlay)
+      REAL zlev(ngrid,nlay+1)
+!arguments de sortie
+      INTEGER lalim(ngrid)
+      INTEGER lmin(ngrid)
+      REAL alim_star(ngrid,nlay)
+      REAL alim_star_tot(ngrid)
+      integer lev_out                           ! niveau pour les print
+      
+      REAL zzalim(ngrid)
+!CR: ponderation entrainement des couches instables
+!def des alim_star tels que alim=f*alim_star      
+
+      do l=1,nlay
+         do ig=1,ngrid 
+            alim_star(ig,l)=0.
+         enddo
+      enddo
+! determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lalim(ig)=1
+      enddo
+
+      if (iflag_thermals_ed.ge.1) then
+!si la premiÃ¨re couche est instable, on declenche un thermique
+         do ig=1,ngrid
+            if (ztv(ig,1).gt.ztv(ig,2)) then
+               lmin(ig)=1
+               lalim(ig)=2
+               alim_star(ig,1)=1.
+               alim_star_tot(ig)=alim_star(ig,1)
+               if(prt_level.GE.10) print*,'init',alim_star(ig,1),alim_star_tot(ig)
+            else
+                lmin(ig)=1
+                lalim(ig)=1
+                alim_star(ig,1)=0.
+                alim_star_tot(ig)=0. 
+            endif
+         enddo
+ 
+         else
+!else iflag_thermals_ed=0 ancienne def de l alim 
+
+!on ne considere que les premieres couches instables
+      do l=nlay-2,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
+     &          ztv(ig,l+1).le.ztv(ig,l+2)) then
+               lalim(ig)=l+1
+            endif
+          enddo
+      enddo
+
+! determination du lmin: couche d ou provient le thermique
+
+      do ig=1,ngrid
+! FH initialisation de lmin a nlay plutot que 1.
+!        lmin(ig)=nlay
+         lmin(ig)=1
+      enddo
+      do l=nlay,2,-1
+         do ig=1,ngrid
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+!
+      zzalim(:)=0.
+      do l=1,nlay-1
+         do ig=1,ngrid 
+             if (l<lalim(ig)) then
+                zzalim(ig)=zzalim(ig)+zlay(ig,l)*(ztv(ig,l)-ztv(ig,l+1))
+             endif
+          enddo
+      enddo
+      do ig=1,ngrid
+          if (lalim(ig)>1) then
+             zzalim(ig)=zlay(ig,1)+zzalim(ig)/(ztv(ig,1)-ztv(ig,lalim(ig)))
+          else
+             zzalim(ig)=zlay(ig,1)
+          endif
+      enddo
+
+      if(prt_level.GE.10) print*,'ZZALIM LALIM ',zzalim,lalim,zlay(1,lalim(1))
+
+! definition de l'entrainement des couches
+      if (1.eq.1) then
+      do l=1,nlay-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
+     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
+!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
+             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+            endif
+         enddo
+      enddo
+      else
+      do l=1,nlay-1
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
+     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
+             alim_star(ig,l)=max(3.*zzalim(ig)-zlay(ig,l),0.) &
+     &        *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+         enddo
+      enddo
+      endif
+      
+! pas de thermique si couche 1 stable
+      do ig=1,ngrid
+!CRnouveau test
+        if (alim_star(ig,1).lt.1.e-10) then 
+            do l=1,nlay
+                alim_star(ig,l)=0.
+            enddo
+            lmin(ig)=1
+         endif
+      enddo 
+! calcul de l alimentation totale
+      do ig=1,ngrid
+         alim_star_tot(ig)=0.
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+         enddo
+      enddo
+!
+! Calcul entrainement normalise
+      do l=1,nlay 
+         do ig=1,ngrid 
+            if (alim_star_tot(ig).gt.1.e-10) then
+               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+            endif
+         enddo
+      enddo
+       
+!on remet alim_star_tot a 1
+      do ig=1,ngrid 
+         alim_star_tot(ig)=1.
+      enddo
+
+      endif
+!endif iflag_thermals_ed
+      return 
+      end  
+!==============================================================================
Index: /LMDZ4/trunk/libf/phylmd/thermcell_closure.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_closure.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_closure.F90	(revision 1403)
@@ -1,7 +1,17 @@
+!
+! $Header$
+!
       SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
+     &   zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out)
 
 !-------------------------------------------------------------------------
 !thermcell_closure: fermeture, determination de f
+!
+! Modification 7 septembre 2009
+! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis
+! coherent avec l'integrale au numerateur.
+! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec
+! l'idee etant que le choix se fasse a l'appel de thermcell_closure
+! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if
 !-------------------------------------------------------------------------
       IMPLICIT NONE
@@ -9,63 +19,64 @@
 #include "iniprint.h"
 #include "thermcell.h"
-      INTEGER ngrid,nlay
-      INTEGER ig,k       
-      REAL r_aspect,ptimestep
-      integer lev_out                           ! niveau pour les print
+INTEGER ngrid,nlay
+INTEGER ig,k       
+REAL r_aspect,ptimestep
+integer lev_out                           ! niveau pour les print
 
-      INTEGER lalim(ngrid)
-      REAL alim_star(ngrid,nlay)
-      REAL alim_star_tot(ngrid)
-      REAL rho(ngrid,nlay)
-      REAL zlev(ngrid,nlay)
-      REAL zmax(ngrid),zmax_sec(ngrid)
-      REAL wmax(ngrid),wmax_sec(ngrid)
-      real zdenom
+INTEGER lalim(ngrid)
+REAL alim_star(ngrid,nlay)
+REAL f_star(ngrid,nlay+1)
+REAL rho(ngrid,nlay)
+REAL zlev(ngrid,nlay)
+REAL zmax(ngrid)
+REAL wmax(ngrid)
+REAL zdenom(ngrid)
+REAL alim_star2(ngrid)
+REAL f(ngrid)
 
-      REAL alim_star2(ngrid)
+REAL alim_star_tot(ngrid)
+INTEGER llmax
 
-      REAL f(ngrid)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!print*,'THERMCELL CLOSURE 26E'
 
-      do ig=1,ngrid
-         alim_star2(ig)=0.
-      enddo
-      do ig=1,ngrid
-         if (alim_star(ig,1).LT.1.e-10) then
-            f(ig)=0.
-         else   
-             do k=1,lalim(ig)
-                alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
-     &                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
-             enddo
-             zdenom=max(500.,zmax(ig))*r_aspect*alim_star2(ig)
-             if (zdenom<1.e-14) then
-                print*,'ig=',ig
-                print*,'alim_star2',alim_star2(ig)
-                print*,'zmax',zmax(ig)
-                print*,'r_aspect',r_aspect
-                print*,'zdenom',zdenom
-                print*,'alim_star',alim_star(ig,:)
-                print*,'zmax_sec',zmax_sec(ig)
-                print*,'wmax_sec',wmax_sec(ig)
-                stop
-             endif
-             if ((zmax_sec(ig).gt.1.e-10).and.(iflag_thermals_ed.eq.0)) then 
-             f(ig)=wmax_sec(ig)*alim_star_tot(ig)/(max(500.,zmax_sec(ig))*r_aspect  &
-     &             *alim_star2(ig))
-!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
-!    &                     zmax_sec(ig))*wmax_sec(ig))
-             if(prt_level.GE.10) write(lunout,*)'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig)
-             else
-             f(ig)=wmax(ig)*alim_star_tot(ig)/zdenom
-!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
-!     &                     zmax(ig))*wmax(ig))
-             if(prt_level.GE.10) print*,'closure moist',f(ig),wmax(ig),alim_star_tot(ig),zmax(ig)
-             endif
-         endif
-!         f0(ig)=f(ig)
-      enddo
-      if (prt_level.ge.1) print*,'apres fermeture'
+alim_star2(:)=0.
+alim_star_tot(:)=0.
+f(:)=0.
 
-!
+! Indice vertical max (max de lalim) atteint par les thermiques sur le domaine
+llmax=1
+do ig=1,ngrid
+   if (lalim(ig)>llmax) llmax=lalim(ig)
+enddo
+
+
+! Calcul des integrales sur la verticale de alim_star et de
+!   alim_star^2/(rho dz)
+do k=1,llmax-1
+   do ig=1,ngrid
+      if (k<lalim(ig)) then
+         alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2  &
+&                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+         alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k)
+      endif
+   enddo
+enddo
+
+
+do ig=1,ngrid
+   if (alim_star2(ig)>1.e-10) then
+      f(ig)=wmax(ig)*alim_star_tot(ig)/  &
+&     (max(500.,zmax(ig))*r_aspect*alim_star2(ig))
+   endif
+enddo
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! TESTS POUR UNE NOUVELLE FERMETURE DANS LAQUELLE ALIM_STAR NE SERAIT
+! PAS NORMALISE
+!           f(ig)=f(ig)*f_star(ig,2)/(f_star(ig,lalim(ig)))
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
       return
       end
Index: /LMDZ4/trunk/libf/phylmd/thermcell_condens.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_condens.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_condens.F90	(revision 1403)
@@ -0,0 +1,81 @@
+subroutine thermcell_condens(klon,active,zpspsk,pplev,ztla,zqta,zqla)
+implicit none
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+
+!====================================================================
+! DECLARATIONS
+!====================================================================
+
+! Arguments
+INTEGER klon
+REAL zpspsk(klon),pplev(klon)
+REAL ztla(klon),zqta(klon),zqla(klon)
+LOGICAL active(klon)
+
+! Variables locales
+INTEGER ig,iter
+REAL Tbef(klon),DT(klon)
+REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
+logical Zsat
+REAL RLvCp
+REAL, SAVE :: DDT0=.01
+LOGICAL afaire(klon),tout_converge
+
+!====================================================================
+! INITIALISATIONS
+!====================================================================
+
+RLvCp = RLVTT/RCPD
+tout_converge=.false.
+afaire(:)=.false.
+DT(:)=0.
+
+
+!====================================================================
+! Routine a vectoriser en copiant active dans converge et en mettant
+! la boucle sur les iterations a l'exterieur est en mettant
+! converge= false des que la convergence est atteinte.
+!====================================================================
+
+do ig=1,klon
+   if (active(ig)) then
+               Tbef(ig)=ztla(ig)*zpspsk(ig)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+               qsatbef=MIN(0.5,qsatbef)
+               zcor=1./(1.-retv*qsatbef)
+               qsatbef=qsatbef*zcor
+               qlbef=max(0.,zqta(ig)-qsatbef)
+               DT(ig) = 0.5*RLvCp*qlbef
+     endif
+enddo
+
+do iter=1,10
+    afaire(:)=abs(DT(:)).gt.DDT0
+    do ig=1,klon
+               if (afaire(ig)) then
+                 Tbef(ig)=Tbef(ig)+DT(ig)
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+                 qsatbef=MIN(0.5,qsatbef)
+                 zcor=1./(1.-retv*qsatbef)
+                 qsatbef=qsatbef*zcor
+                 qlbef=zqta(ig)-qsatbef
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef)
+                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
+                 num=-Tbef(ig)+ztla(ig)*zpspsk(ig)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 zqla(ig) = max(0.,zqta(ig)-qsatbef) 
+                 DT(ig)=num/denom
+               endif
+    enddo
+enddo
+
+return
+end
Index: /LMDZ4/trunk/libf/phylmd/thermcell_dq.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_dq.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_dq.F90	(revision 1403)
@@ -31,4 +31,6 @@
       real ztimestep
       integer niter,iter
+      CHARACTER (LEN=20) :: modname='thermcell_dq'
+      CHARACTER (LEN=80) :: abort_message
 
 
@@ -42,5 +44,6 @@
             if (entr(ig,k).gt.zzm) then
                print*,'entr dt > m ',entr(ig,k)*ptimestep,masse(ig,k)
-               stop
+               abort_message = ''
+               CALL abort_gcm (modname,abort_message,1)
             endif
          enddo
Index: /LMDZ4/trunk/libf/phylmd/thermcell_dry.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_dry.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_dry.F90	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
        SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
      &                            lalim,lmin,zmax,wmax,lev_out)
@@ -4,5 +7,12 @@
 !--------------------------------------------------------------------------
 !thermcell_dry: calcul de zmax et wmax du thermique sec
+! Calcul de la vitesse maximum et de la hauteur maximum pour un panache
+! ascendant avec une fonction d'alimentation alim_star et sans changement 
+! de phase.
+! Le calcul pourrait etre sans doute simplifier.
+! La temperature potentielle virtuelle dans la panache ascendant est
+! la temperature potentielle virtuelle pondÃ©rÃ©e par alim_star.
 !--------------------------------------------------------------------------
+
        IMPLICIT NONE
 #include "YOMCST.h"       
@@ -29,4 +39,6 @@
        REAL linter(ngrid),zlevinter(ngrid)
        INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid)
+      CHARACTER (LEN=20) :: modname='thermcell_dry'
+      CHARACTER (LEN=80) :: abort_message
 
 !initialisations
@@ -47,16 +59,4 @@
        enddo
 !calcul de la vitesse a partir de la CAPE en melangeant thetav
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! A eliminer
-! Ce if complique etait fait pour reperer la premiere couche instable
-! Ici, c'est lmin.
-!
-!       do l=1,nlay-2
-!         do ig=1,ngrid
-!            if (ztv(ig,l).gt.ztv(ig,l+1)  &
-!     &         .and.alim_star(ig,l).gt.1.e-10  &
-!     &         .and.zw2(ig,l).lt.1e-10) then
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 
@@ -84,4 +84,5 @@
 !  Premiere couche du panache thermique
 !------------------------------------------------------------------------
+
                zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
      &                     *(zlev(ig,l+1)-zlev(ig,l))  &
@@ -96,15 +97,4 @@
 ! 3. la vitesse au carré en haut zw2(ig,l+1)
 !------------------------------------------------------------------------
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!  A eliminer : dans cette version, si zw2 est > 0 on a un therique.
-!  et donc, au dessus, f_star(ig,l+1) est forcement suffisamment 
-!  grand puisque on n'a pas de detrainement.
-!  f_star est une fonction croissante.
-!  c'est donc vraiment sur zw2 uniquement qu'il faut faire le test.
-!           else if ((zw2(ig,l).ge.1e-10).and.  &
-!    &               (f_star(ig,l)+alim_star(ig,l).gt.1.e-10)) then
-!              f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
             else if (zw2(ig,l).ge.1e-10) then
@@ -145,21 +135,4 @@
        if (prt_level.ge.1) print*,'fin calcul zw2'
 !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! A eliminer :
-! Ce calcul de lmax est fait en meme temps que celui de linter, plus haut
-! Calcul de la couche correspondant a la hauteur du thermique
-!      do ig=1,ngrid
-!         lmax(ig)=lalim(ig)
-!      enddo
-!      do ig=1,ngrid
-!         do l=nlay,lalim(ig)+1,-1
-!            if (zw2(ig,l).le.1.e-10) then
-!               lmax(ig)=l-1
-!            endif
-!         enddo
-!      enddo
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-!    
 ! Determination de zw2 max
       do ig=1,ngrid
@@ -185,13 +158,4 @@
       do  ig=1,ngrid
 ! calcul de zlevinter
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH A eliminer
-! Simplification
-!          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*  &
-!     &    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)  &
-!     &    -zlev(ig,lmax(ig)))
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
           zlevinter(ig)=zlev(ig,lmax(ig)) + &
      &    (linter(ig)-lmax(ig))*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
@@ -199,14 +163,4 @@
       enddo
 
-! Verification que lalim<=lmax
-      do ig=1,ngrid
-         if(lalim(ig)>lmax(ig)) then
-           if ( prt_level > 1 ) THEN
-            print*,'WARNING thermcell_dry ig=',ig,'  lalim=',lalim(ig),'  lmax(ig)=',lmax(ig)
-           endif
-           lmax(ig)=lalim(ig)
-         endif
-      enddo
-      
       RETURN
       END
Index: /LMDZ4/trunk/libf/phylmd/thermcell_dtke.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_dtke.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_dtke.F90	(revision 1403)
@@ -0,0 +1,123 @@
+      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
+     &           rg,pplev,tke)
+      implicit none
+
+#include "iniprint.h"
+!=======================================================================
+!
+!   Calcul du transport verticale dans la couche limite en presence
+!   de "thermiques" explicitement representes
+!   calcul du dq/dt une fois qu'on connait les ascendances
+!
+!=======================================================================
+
+      integer ngrid,nlay,nsrf
+
+      real ptimestep
+      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
+      real entr0(ngrid,nlay),rg
+      real tke(ngrid,nlay,nsrf)
+      real detr0(ngrid,nlay)
+
+
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      integer lev_out                           ! niveau pour les print
+
+      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
+
+      real zzm
+
+      integer ig,k
+      integer isrf
+
+
+      lev_out=0
+
+
+      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
+
+!   calcul du detrainement
+      do k=1,nlay
+         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
+         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
+      enddo
+
+
+! Decalage vertical des entrainements et detrainements.
+      masse(:,1)=0.5*masse0(:,1)
+      entr(:,1)=0.5*entr0(:,1)
+      detr(:,1)=0.5*detr0(:,1)
+      fm(:,1)=0.
+      do k=1,nlay-1
+         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
+         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
+         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
+         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
+      enddo
+      fm(:,nlay+1)=0.
+
+!   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+
+
+do isrf=1,nsrf
+
+   q(:,:)=tke(:,:,isrf)
+
+    if (1==1) then
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
+     &         1.e-5*masse(ig,k)) then
+         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
+     &         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+            if (qa(ig,k).lt.0.) then
+!               print*,'qa<0!!!'
+            endif
+            if (q(ig,k).lt.0.) then
+!               print*,'q<0!!!'
+            endif
+         enddo
+      enddo
+
+! Calcul du flux subsident
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+            if (wqd(ig,k).lt.0.) then
+!               print*,'wqd<0!!!'
+            endif
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+     
+
+! Calcul des tendances
+      do k=1,nlay
+         do ig=1,ngrid
+            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
+     &               -wqd(ig,k)+wqd(ig,k+1))  &
+     &               *ptimestep/masse(ig,k)
+         enddo
+      enddo
+
+ endif
+
+   tke(:,:,isrf)=q(:,:)
+
+enddo
+
+      return
+      end
Index: /LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90	(revision 1403)
@@ -10,4 +10,6 @@
 !   de "thermiques" explicitement representes
 !   calcul du dq/dt une fois qu'on connait les ascendances
+!
+! Vectorisation, FH : 2010/03/08
 !
 !=======================================================================
@@ -31,12 +33,20 @@
       real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
       real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
-      real gamma0,gamma(ngrid,nlay+1)
+      real gamma0(ngrid,nlay+1),gamma(ngrid,nlay+1)
       real ue(ngrid,nlay),ve(ngrid,nlay)
-      real dua,dva
+      LOGICAL ltherm(ngrid,nlay)
+      real dua(ngrid,nlay),dva(ngrid,nlay)
       integer iter
 
-      integer ig,k
+      integer ig,k,nlarga0
+
+!-------------------------------------------------------------------------
 
 !   calcul du detrainement
+!---------------------------
+
+      print*,'THERMCELL DV2 OPTIMISE 3'
+
+      nlarga0=0.
 
       do k=1,nlay
@@ -59,42 +69,53 @@
       do k=2,nlay
          do ig=1,ngrid
-            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
-     &         1.e-5*masse(ig,k)) then
-!   On itère sur la valeur du coeff de freinage.
-!              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
-!IM 060508 beg
-!             if(0.5*(fraca(ig,k+1)+fraca(ig,k)).LT.0.) THEN
-!              print*,'th_dv2 ig k fraca(:,k) fraca(:k+1)', &
-!    &         ig,k,fraca(ig,k),fraca(ig,k+1)
-!             endif
-!             if(larga(ig).EQ.0.) THEN
-!              print*,'th_dv2 ig larga=0.',ig
-!             endif
-              if(larga(ig).GT.0.) THEN
-!IM 060508 end
-               gamma0=masse(ig,k)  &
+            ltherm(ig,k)=(fm(ig,k+1)+detr(ig,k))*ptimestep > 1.e-5*masse(ig,k)
+            if(ltherm(ig,k).and.larga(ig)>0.) then
+               gamma0(ig,k)=masse(ig,k)  &
      &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
      &         *0.5/larga(ig)  &
      &         *1.
-!IM 060508 beg
-              else 
-               if(prt_level.GE.10) print*,'WARNING cas ELSE on initialise gamma0=0.'
-               gamma0=0.
-              endif !(larga(ig).GT.0.) THEN
-!IM 060508 end
-!    s         *0.5
-!              gamma0=0.
-               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+            else
+               gamma0(ig,k)=0.
+            endif
+            if (ltherm(ig,k).and.larga(ig)<=0.) nlarga0=nlarga0+1
+         enddo
+      enddo
+
+      gamma(:,:)=0.
+
+      do k=2,nlay
+
+         do ig=1,ngrid
+            if (ltherm(ig,k)) then
+               dua(ig,k)=ua(ig,k-1)-u(ig,k-1)
+               dva(ig,k)=va(ig,k-1)-v(ig,k-1)
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               ue(ig,k)=u(ig,k)
+               ve(ig,k)=v(ig,k)
+            endif
+         enddo
+
+
+! Debut des iterations
+!----------------------
+do iter=1,5
+         do ig=1,ngrid
+! Pour memoire : calcul prenant en compte la fraction reelle
+!              zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+!              zf2=1./(1.-zf)
+! Calcul avec fraction infiniement petite
                zf=0.
-               zf2=1./(1.-zf)
-!   la première fois on multiplie le coefficient de freinage
-!   par le module du vent dans la couche en dessous.
-               dua=ua(ig,k-1)-u(ig,k-1)
-               dva=va(ig,k-1)-v(ig,k-1)
-               do iter=1,5
+               zf2=1.
+
+!  la première fois on multiplie le coefficient de freinage
+!  par le module du vent dans la couche en dessous.
+!  Mais pourquoi donc ???
+               if (ltherm(ig,k)) then
 !   On choisit une relaxation lineaire.
-                  gamma(ig,k)=gamma0
+!                 gamma(ig,k)=gamma0(ig,k)
 !   On choisit une relaxation quadratique.
-                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  gamma(ig,k)=gamma0(ig,k)*sqrt(dua(ig,k)**2+dva(ig,k)**2)
                   ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
      &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
@@ -105,20 +126,20 @@
      &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
      &                 +gamma(ig,k))
-!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
-                  dua=ua(ig,k)-u(ig,k)
-                  dva=va(ig,k)-v(ig,k)
+!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua(ig,k),dva(ig,k)
+                  dua(ig,k)=ua(ig,k)-u(ig,k)
+                  dva(ig,k)=va(ig,k)-v(ig,k)
                   ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
                   ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
-               enddo
-            else
-               ua(ig,k)=u(ig,k)
-               va(ig,k)=v(ig,k)
-               ue(ig,k)=u(ig,k)
-               ve(ig,k)=v(ig,k)
-               gamma(ig,k)=0.
-            endif
+               endif
          enddo
-      enddo
+! Fin des iterations
+!--------------------
+enddo
 
+      enddo ! k=2,nlay
+
+
+! Calcul du flux vertical de moment dans l'environnement.
+!---------------------------------------------------------
       do k=2,nlay
          do ig=1,ngrid
@@ -134,11 +155,8 @@
       enddo
 
+! calcul des tendances.
+!-----------------------
       do k=1,nlay
          do ig=1,ngrid
-!IM
-         if(prt_level.GE.10) print*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
-     &   entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
-     &   masse(ig,k)
-!
             du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
      &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
@@ -152,4 +170,24 @@
       enddo
 
+
+! Sorties eventuelles.
+!----------------------
+
+   if(prt_level.GE.10) then
+      do k=1,nlay
+         do ig=1,ngrid
+           print*,'th_dv2 ig k gamma entr detr ua ue va ve wud wvd masse',ig,k,gamma(ig,k), &
+     &   entr(ig,k),detr(ig,k),ua(ig,k),ue(ig,k),va(ig,k),ve(ig,k),wud(ig,k),wvd(ig,k),wud(ig,k+1),wvd(ig,k+1), &
+     &   masse(ig,k)
+         enddo
+      enddo
+   endif
+!
+     if (nlarga0>0) then
+          print*,'WARNING !!!!!! DANS THERMCELL_DV2 '
+          print*,nlarga0,' points pour lesquels laraga=0. dans un thermique'
+          print*,'Il faudrait decortiquer ces points'
+     endif
+
       return
       end
Index: /LMDZ4/trunk/libf/phylmd/thermcell_env.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_env.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_env.F90	(revision 1403)
@@ -1,4 +1,4 @@
       SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
-     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
+     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
 
 !--------------------------------------------------------------
@@ -31,23 +31,21 @@
       REAL zu(ngrid,nlay)
       REAL zv(ngrid,nlay)
-      REAL zqsat(ngrid,nlay)
+      REAL pqsat(ngrid,nlay)
 
-      INTEGER ig,l,ll
+      INTEGER ig,ll
 
-      real zcor,zdelta,zcvm5,qlbef
-      real Tbef,qsatbef
-      real dqsat_dT,DT,num,denom
-      REAL RLvCp,DDT0
-      PARAMETER (DDT0=.01)
-      LOGICAL Zsat
+      real dqsat_dT
+      real RLvCp
 
-      Zsat=.false.
-      RLvCp = RLVTT/RCPD
+logical mask(ngrid,nlay)
 
-!
-! Pr Tprec=Tl calcul de qsat 
-! Si qsat>qT T=Tl, q=qT
-! Sinon DDT=(-Tprec+Tl+RLVCP (qT-qsat(T')) / (1+RLVCP dqsat/dt) 
-! On cherche DDT < DDT0
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! Initialisations :
+!------------------
+
+mask(:,:)=.true.
+RLvCp = RLVTT/RCPD
+
 !
 ! calcul des caracteristiques de l environnement
@@ -57,82 +55,43 @@
             zl(ig,ll)=0.
             zh(ig,ll)=pt(ig,ll)
-            zqsat(ig,ll)=0.
          EndDO
        EndDO
 !
 !
-!recherche de saturation dans l environnement
-       DO ll=1,nlay
-! les points insatures sont definitifs
-         DO ig=1,ngrid
-            Tbef=pt(ig,ll)
-            zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-            qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,ll)
-            qsatbef=MIN(0.5,qsatbef)
-            zcor=1./(1.-retv*qsatbef)
-            qsatbef=qsatbef*zcor
-            Zsat = (max(0.,po(ig,ll)-qsatbef) .gt. 1.e-10)
-            if (Zsat) then
-            qlbef=max(0.,po(ig,ll)-qsatbef)
-! si sature: ql est surestime, d'ou la sous-relax
-            DT = 0.5*RLvCp*qlbef
-! on pourra enchainer 2 ou 3 calculs sans Do while
-            do while (abs(DT).gt.DDT0)
-! il faut verifier si c,a conserve quand on repasse en insature ...
-              Tbef=Tbef+DT
-              zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-              qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,ll)
-              qsatbef=MIN(0.5,qsatbef)
-              zcor=1./(1.-retv*qsatbef)
-              qsatbef=qsatbef*zcor
-! on veut le signe de qlbef
-              qlbef=po(ig,ll)-qsatbef
-!          dqsat_dT
-              zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-              zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-              zcor=1./(1.-retv*qsatbef)
-              dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
-              num=-Tbef+pt(ig,ll)+RLvCp*qlbef
-              denom=1.+RLvCp*dqsat_dT
-              if (denom.lt.1.e-10) then
-                  print*,'pb denom'
-              endif
-              DT=num/denom
-            enddo
-! on ecrit de maniere conservative (sat ou non)
-            zl(ig,ll) = max(0.,qlbef)
-!          T = Tl +Lv/Cp ql
-            zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)
-            zo(ig,ll) = po(ig,ll)-zl(ig,ll)
-           endif
-!on ecrit zqsat 
-            zqsat(ig,ll)=qsatbef     
-         EndDO
-       EndDO
+! Condensation :
+!---------------
+! Calcul de l'humidite a saturation et de la condensation
+
+call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
+DO ll=1,nlay
+   DO ig=1,ngrid
+      zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
+      zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
+      zo(ig,ll) = po(ig,ll)-zl(ig,ll)
+   ENDDO
+ENDDO
 !
 !
 !-----------------------------------------------------------------------
-!   incrementation eventuelle de tendances precedentes:
-!   ---------------------------------------------------
 
       if (prt_level.ge.1) print*,'0 OK convect8'
 
-      DO 1010 l=1,nlay
-         DO 1015 ig=1,ngrid
-             zpspsk(ig,l)=(pplay(ig,l)/100000.)**RKAPPA
-             zu(ig,l)=pu(ig,l)
-             zv(ig,l)=pv(ig,l)
+      DO ll=1,nlay
+         DO ig=1,ngrid
+             zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
+             zu(ig,ll)=pu(ig,ll)
+             zv(ig,ll)=pv(ig,ll)
 !attention zh est maintenant le profil de T et plus le profil de theta !
+! Quelle horreur ! A eviter.
 !
 !   T-> Theta
-            ztv(ig,l)=zh(ig,l)/zpspsk(ig,l)
+            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
 !Theta_v
-            ztv(ig,l)=ztv(ig,l)*(1.+RETV*(zo(ig,l))  &
-     &           -zl(ig,l))
+            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
 !Thetal
-            zthl(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
 !            
-1015     CONTINUE
-1010  CONTINUE
+         ENDDO
+      ENDDO
  
       RETURN
Index: /LMDZ4/trunk/libf/phylmd/thermcell_flux.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_flux.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_flux.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 
@@ -51,4 +51,7 @@
 !$OMP THREADPRIVATE(fomass_max,alphamax)
 
+      character (len=20) :: modname='thermcell_flux'
+      character (len=80) :: abort_message
+
       fomass_max=0.5
       alphamax=0.7
@@ -92,5 +95,4 @@
                     print*,'alim_star(ig,l)',alim_star(ig,l)
                     print*,'detr_star(ig,l)',detr_star(ig,l)
-!                   stop
                endif
             else
@@ -100,5 +102,6 @@
                     print*,'alim_star(ig,l)',alim_star(ig,l)
                     print*,'detr_star(ig,l)',detr_star(ig,l)
-                    stop
+                    abort_message = ''
+                    CALL abort_gcm (modname,abort_message,1)
                endif
             endif
@@ -264,5 +267,6 @@
             if (entr(ig,l)<0.) then
                print*,'N1 ig,l,entr',ig,l,entr(ig,l)
-               stop 'entr negatif'
+               abort_message = 'entr negatif'
+               CALL abort_gcm (modname,abort_message,1)
             endif
             if (detr(ig,l).gt.fm(ig,l)) then
@@ -292,5 +296,6 @@
                print*,'entr(ig,l)',entr(ig,l)
                print*,'fm(ig,l)',fm(ig,l)
-               stop 'probleme dans thermcell flux'
+               abort_message = 'probleme dans thermcell flux'
+               CALL abort_gcm (modname,abort_message,1)
             endif
          enddo
@@ -319,5 +324,6 @@
                print*,'detr(ig,l)',detr(ig,l)
                print*,'fm(ig,l)',fm(ig,l)
-               stop 'probleme dans thermcell flux'
+               abort_message = 'probleme dans thermcell flux'
+               CALL abort_gcm (modname,abort_message,1)
             endif
         enddo
@@ -420,5 +426,6 @@
                          print*,'fm(ig,l+1)',fm(ig,l+1)
                          print*,'fm(ig,l)',fm(ig,l)
-                         stop 'probleme dans thermcell_flux'
+                         abort_message = 'probleme dans thermcell_flux'
+                         CALL abort_gcm (modname,abort_message,1)
                       endif
                       entr(ig,l+1)=entr(ig,l+1)-ddd
@@ -478,4 +485,7 @@
       character*3 descr
 
+      character (len=20) :: modname='thermcell_flux'
+      character (len=80) :: abort_message
+
       lm=lmax(igout)+5
       if(lm.gt.klev) lm=klev
@@ -500,5 +510,6 @@
           print*,'detr(igout,l)',detr(igout,l)
           print*,'fm(igout,l)',fm(igout,l)
-          stop
+          abort_message = ''
+          CALL abort_gcm (modname,abort_message,1)
           endif
       enddo
Index: /LMDZ4/trunk/libf/phylmd/thermcell_flux2.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_flux2.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_flux2.F90	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE thermcell_flux2(ngrid,klev,ptimestep,masse, &
      &       lalim,lmax,alim_star,  &
@@ -38,5 +41,5 @@
       REAL zfm
 
-      integer igout
+      integer igout,lout
       integer lev_out
       integer lunout1
@@ -46,4 +49,9 @@
       REAL fomass_max,alphamax
       save fomass_max,alphamax
+
+      logical check_debug,labort_gcm
+
+      character (len=20) :: modname='thermcell_flux2'
+      character (len=80) :: abort_message
 
       fomass_max=0.5
@@ -78,6 +86,10 @@
 ! Verification de la nullite des entrainement et detrainement au dessus
 ! de lmax(ig)
-!-------------------------------------------------------------------------
-
+! Active uniquement si check_debug=.true. ou prt_level>=10
+!-------------------------------------------------------------------------
+
+      check_debug=.false..or.prt_level>=10
+
+      if (check_debug) then
       do l=1,klev
          do ig=1,ngrid
@@ -88,5 +100,4 @@
                     print*,'alim_star(ig,l)',alim_star(ig,l)
                     print*,'detr_star(ig,l)',detr_star(ig,l)
-!                   stop
                endif
             else
@@ -96,9 +107,12 @@
                     print*,'alim_star(ig,l)',alim_star(ig,l)
                     print*,'detr_star(ig,l)',detr_star(ig,l)
-                    stop
+                    abort_message = ''
+                    labort_gcm=.true.
+                    CALL abort_gcm (modname,abort_message,1)
                endif
             endif
          enddo
       enddo
+      endif
 
 !-------------------------------------------------------------------------
@@ -253,9 +267,23 @@
 
 !     do l=1,klev
+
+
+
+         labort_gcm=.false.
          do ig=1,ngrid
             if (entr(ig,l)<0.) then
-               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
-               stop 'entr negatif'
-            endif
+               labort_gcm=.true.
+               igout=ig
+               lout=l
+            endif
+         enddo
+
+         if (labort_gcm) then
+            print*,'N1 ig,l,entr',igout,lout,entr(igout,lout)
+            abort_message = 'entr negatif'
+            CALL abort_gcm (modname,abort_message,1)
+         endif
+
+         do ig=1,ngrid
             if (detr(ig,l).gt.fm(ig,l)) then
                ncorecfm6=ncorecfm6+1
@@ -280,12 +308,23 @@
                entr(ig,l)=0.
             endif
-
+         enddo
+
+         labort_gcm=.false.
+         do ig=1,ngrid
             if (entr(ig,l).lt.0.) then
-               print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
-               print*,'entr(ig,l)',entr(ig,l)
-               print*,'fm(ig,l)',fm(ig,l)
-               stop 'probleme dans thermcell flux'
-            endif
-         enddo
+               labort_gcm=.true.
+               igout=ig
+            endif
+         enddo
+         if (labort_gcm) then
+            ig=igout
+            print*,'ig,l,lmax(ig)',ig,l,lmax(ig)
+            print*,'entr(ig,l)',entr(ig,l)
+            print*,'fm(ig,l)',fm(ig,l)
+            abort_message = 'probleme dans thermcell flux'
+            CALL abort_gcm (modname,abort_message,1)
+         endif
+
+
 !     enddo
       endif
@@ -305,14 +344,23 @@
                detr(ig,l)=detr(ig,l)+fm(ig,l+1)
                fm(ig,l+1)=0.
-!              print*,'fm2<0',l+1,lmax(ig)
                ncorecfm2=ncorecfm2+1
             endif
+         enddo
+
+         labort_gcm=.false.
+         do ig=1,ngrid
             if (detr(ig,l).lt.0.) then
+               labort_gcm=.true.
+               igout=ig
+            endif
+        enddo
+        if (labort_gcm) then
+               ig=igout
                print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig)
                print*,'detr(ig,l)',detr(ig,l)
                print*,'fm(ig,l)',fm(ig,l)
-               stop 'probleme dans thermcell flux'
-            endif
-        enddo
+               abort_message = 'probleme dans thermcell flux'
+               CALL abort_gcm (modname,abort_message,1)
+        endif
 !    enddo
 
@@ -379,4 +427,5 @@
 
       if (1.eq.1) then
+      labort_gcm=.false.
       do l=1,klev-1
          do ig=1,ngrid
@@ -399,4 +448,20 @@
                    else
                       if(l.ge.lmax(ig).and.0.eq.1) then
+                         igout=ig
+                         lout=l
+                         labort_gcm=.true.
+                      endif
+                      entr(ig,l+1)=entr(ig,l+1)-ddd
+                      detr(ig,l)=0.
+                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
+                      detr(ig,l)=0.
+                   endif
+                endif
+            endif
+         enddo
+      enddo
+      if (labort_gcm) then
+                         ig=igout
+                         l=lout
                          print*,'ig,l',ig,l
                          print*,'eee0',eee0
@@ -413,15 +478,7 @@
                          print*,'fm(ig,l+1)',fm(ig,l+1)
                          print*,'fm(ig,l)',fm(ig,l)
-                         stop 'probleme dans thermcell_flux'
-                      endif
-                      entr(ig,l+1)=entr(ig,l+1)-ddd
-                      detr(ig,l)=0.
-                      fm(ig,l+1)=fm(ig,l)+entr(ig,l)
-                      detr(ig,l)=0.
-                   endif
-                endif
-            endif
-         enddo
-      enddo
+                         abort_message = 'probleme dans thermcell_flux'
+                         CALL abort_gcm (modname,abort_message,1)
+      endif
       endif
 !                  
Index: /LMDZ4/trunk/libf/phylmd/thermcell_height.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_height.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_height.F90	(revision 1403)
@@ -40,4 +40,14 @@
          enddo
       enddo
+
+! On traite le cas particulier qu'il faudrait éviter ou le thermique
+! atteind le haut du modele ...
+      do ig=1,ngrid
+      if ( zw2(ig,nlay) > 1.e-10 ) then
+          print*,'WARNING !!!!! W2 thermiques non nul derniere couche '
+          lmax(ig)=nlay
+      endif
+      enddo
+
 ! pas de thermique si couche 1 stable
       do ig=1,ngrid
Index: /LMDZ4/trunk/libf/phylmd/thermcell_init.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_init.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_init.F90	(revision 1403)
@@ -1,2 +1,5 @@
+!
+! $Header$
+!
       SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlay,zlev,  &
      &                  lalim,lmin,alim_star,alim_star_tot,lev_out)
@@ -26,137 +29,31 @@
 !def des alim_star tels que alim=f*alim_star      
 
-      do l=1,nlay
-         do ig=1,ngrid 
-            alim_star(ig,l)=0.
-         enddo
-      enddo
-! determination de la longueur de la couche d entrainement
-      do ig=1,ngrid
-         lalim(ig)=1
-      enddo
 
-      if (iflag_thermals_ed.ge.1) then
-!si la première couche est instable, on declenche un thermique
+      write(lunout,*)'THERM INIT V20C '
+
+      alim_star_tot(:)=0.
+      alim_star(:,:)=0.
+      lmin(:)=1
+      lalim(:)=1
+
+      do l=1,nlay-1
          do ig=1,ngrid
-            if (ztv(ig,1).gt.ztv(ig,2)) then
-               lmin(ig)=1
-               lalim(ig)=2
-               alim_star(ig,1)=1.
-               alim_star_tot(ig)=alim_star(ig,1)
-               if(prt_level.GE.10) print*,'init',alim_star(ig,1),alim_star_tot(ig)
-            else
-                lmin(ig)=1
-                lalim(ig)=1
-                alim_star(ig,1)=0.
-                alim_star_tot(ig)=0. 
-            endif
-         enddo
- 
-         else
-!else iflag_thermals_ed=0 ancienne def de l alim 
-
-!on ne considere que les premieres couches instables
-      do l=nlay-2,1,-1
-         do ig=1,ngrid
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          ztv(ig,l+1).le.ztv(ig,l+2)) then
-               lalim(ig)=l+1
-            endif
-          enddo
-      enddo
-
-! determination du lmin: couche d ou provient le thermique
-
-      do ig=1,ngrid
-! FH initialisation de lmin a nlay plutot que 1.
-!        lmin(ig)=nlay
-         lmin(ig)=1
-      enddo
-      do l=nlay,2,-1
-         do ig=1,ngrid
-            if (ztv(ig,l-1).gt.ztv(ig,l)) then
-               lmin(ig)=l-1
+            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
+               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+               lalim(:)=l+1
+               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
             endif
          enddo
       enddo
-!
-      zzalim(:)=0.
-      do l=1,nlay-1
+      do l=1,nlay
          do ig=1,ngrid 
-             if (l<lalim(ig)) then
-                zzalim(ig)=zzalim(ig)+zlay(ig,l)*(ztv(ig,l)-ztv(ig,l+1))
-             endif
-          enddo
-      enddo
-      do ig=1,ngrid
-          if (lalim(ig)>1) then
-             zzalim(ig)=zlay(ig,1)+zzalim(ig)/(ztv(ig,1)-ztv(ig,lalim(ig)))
-          else
-             zzalim(ig)=zlay(ig,1)
-          endif
-      enddo
-
-      if(prt_level.GE.10) print*,'ZZALIM LALIM ',zzalim,lalim,zlay(1,lalim(1))
-
-! definition de l'entrainement des couches
-      if (1.eq.1) then
-      do l=1,nlay-1
-         do ig=1,ngrid 
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
-!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
-             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
-     &                       *sqrt(zlev(ig,l+1)) 
-            endif
-         enddo
-      enddo
-      else
-      do l=1,nlay-1
-         do ig=1,ngrid
-            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
-     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
-             alim_star(ig,l)=max(3.*zzalim(ig)-zlay(ig,l),0.) &
-     &        *(zlev(ig,l+1)-zlev(ig,l))
-            endif
-         enddo
-      enddo
-      endif
-      
-! pas de thermique si couche 1 stable
-      do ig=1,ngrid
-!CRnouveau test
-        if (alim_star(ig,1).lt.1.e-10) then 
-            do l=1,nlay
-                alim_star(ig,l)=0.
-            enddo
-            lmin(ig)=1
-         endif
-      enddo 
-! calcul de l alimentation totale
-      do ig=1,ngrid
-         alim_star_tot(ig)=0.
-      enddo
-      do l=1,nlay
-         do ig=1,ngrid
-            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
-         enddo
-      enddo
-!
-! Calcul entrainement normalise
-      do l=1,nlay 
-         do ig=1,ngrid 
-            if (alim_star_tot(ig).gt.1.e-10) then
+            if (alim_star_tot(ig) > 1.e-10 ) then
                alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
             endif
          enddo
       enddo
-       
-!on remet alim_star_tot a 1
-      do ig=1,ngrid 
-         alim_star_tot(ig)=1.
-      enddo
+      alim_star_tot(:)=1.
 
-      endif
-!endif iflag_thermals_ed
-      return 
+      return
       end  
Index: /LMDZ4/trunk/libf/phylmd/thermcell_main.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_main.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_main.F90	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep  &
@@ -8,7 +8,8 @@
      &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
      &                  ,ratqscth,ratqsdiff,zqsatth  &
-     &                  ,r_aspect,l_mix,tau_thermals &
+     &                  ,r_aspect,l_mix,tau_thermals,iflag_thermals_ed &
      &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
-     &                  ,zmax0, f0,zw2,fraca)
+     &                  ,zmax0, f0,zw2,fraca,ztv &
+     &                  ,zpspsk,ztla,zthl)
 
       USE dimphy
@@ -22,11 +23,11 @@
 !   de "thermiques" explicitement representes avec processus nuageux
 !
-!   Réécriture à partir d'un listing papier à Habas, le 14/02/00
-!
-!   le thermique est supposé homogène et dissipé par mélange avec
-!   son environnement. la longueur l_mix contrôle l'efficacité du
-!   mélange
-!
-!   Le calcul du transport des différentes espèces se fait en prenant
+!   Reecriture a partir d'un listing papier a Habas, le 14/02/00
+!
+!   le thermique est suppose homogene et dissipe par melange avec
+!   son environnement. la longueur l_mix controle l'efficacite du
+!   melange
+!
+!   Le calcul du transport des differentes especes se fait en prenant
 !   en compte:
 !     1. un flux de masse montant
@@ -55,4 +56,5 @@
       INTEGER ngrid,nlay,w2di
       real tau_thermals
+      integer iflag_thermals_ed
       real ptimestep,l_mix,r_aspect
       REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
@@ -85,5 +87,5 @@
       real linter(klon)
       real zmix(klon)
-      real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1)
+      real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1),ztva_est(klon,klev)
 !      real fraca(klon,klev)
 
@@ -115,4 +117,7 @@
 ! FH probleme de dimensionnement avec l'allocation dynamique
 !     common/comtherm/thetath2,wth2
+      real wq(klon,klev)
+      real wthl(klon,klev)
+      real wthv(klon,klev)
     
       real ratqscth(klon,klev)
@@ -126,4 +131,5 @@
 
       real wmax(klon)
+      real wmax_tmp(klon)
       real wmax_sec(klon)
       real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev)
@@ -142,6 +148,7 @@
       real f_star(klon,klev+1),entr_star(klon,klev)
       real detr_star(klon,klev)
-      real alim_star_tot(klon),alim_star2(klon)
+      real alim_star_tot(klon)
       real alim_star(klon,klev)
+      real alim_star_clos(klon,klev)
       real f(klon), f0(klon)
 !FH/IM     save f0
@@ -149,4 +156,5 @@
       logical debut
        real seuil
+      real csc(klon,klev)
 
 !
@@ -166,4 +174,7 @@
       character*10 str10
 
+      character (len=20) :: modname='thermcell_main'
+      character (len=80) :: abort_message
+
       EXTERNAL SCOPY
 !
@@ -182,5 +193,4 @@
 
 
-! #define wrgrads_thermcell
 #undef wrgrads_thermcell
 #ifdef wrgrads_thermcell
@@ -200,4 +210,5 @@
       fm=0. ; entr=0. ; detr=0.
 
+
       icount=icount+1
 
@@ -220,18 +231,5 @@
       ENDIF
 !
-!Initialisation
-!
-!    IF (1.eq.0) THEN
-!     do ig=1,klon      
-!FH/IM 130308     if ((debut).or.((.not.debut).and.(f0(ig).lt.1.e-10))) then
-!     if ((.not.debut).and.(f0(ig).lt.1.e-10)) then
-!           f0(ig)=1.e-5
-!           zmax0(ig)=40.
-!v1d        therm=.false.
-!     endif
-!     enddo 
-!    ENDIF !(1.eq.0) THEN
-     if (prt_level.ge.10)write(lunout,*)                                &
-    &     'WARNING thermcell_main f0=max(f0,1.e-2)'
+!     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
      do ig=1,klon
       if (prt_level.ge.20) then
@@ -239,4 +237,5 @@
       endif
          f0(ig)=max(f0(ig),1.e-2)
+         zmax0(ig)=max(zmax0(ig),40.)
 !IMmarche pas ?!       if (f0(ig)<1.e-2) f0(ig)=1.e-2
      enddo
@@ -364,41 +363,93 @@
 
 !------------------------------------------------------------------
-!  1. alim_star est le profil vertical de l'alimentation à la base du
-!     panache thermique, calculé à partir de la flotabilité de l'air sec
+!  1. alim_star est le profil vertical de l'alimentation a la base du
+!     panache thermique, calcule a partir de la flotabilite de l'air sec
 !  2. lmin et lalim sont les indices inferieurs et superieurs de alim_star
 !------------------------------------------------------------------
 !
       entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0.
-      CALL thermcell_init(ngrid,nlay,ztv,zlay,zlev,  &
-     &                    lalim,lmin,alim_star,alim_star_tot,lev_out)
-
-call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin  ')
-call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ')
-
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_init'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 1'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star thetav'
-         write(lunout1,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) &
-     &   ,ztv(igout,l),l=1,lalim(igout)+4)
-      endif
-
-!v1d      do ig=1,klon
-!v1d     if (alim_star(ig,1).gt.1.e-10) then
-!v1d     therm=.true.
-!v1d     endif
-!v1d      enddo
+      lmin=1
+
 !-----------------------------------------------------------------------------
 !  3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un
 !     panache sec conservatif (e=d=0) alimente selon alim_star 
 !     Il s'agit d'un calcul de type CAPE
-!     zmax_sec est utilisé pour déterminer la géométrie du thermique.
+!     zmax_sec est utilise pour determiner la geometrie du thermique.
 !------------------------------------------------------------------------------
-!
+!---------------------------------------------------------------------------------
+!calcul du melange et des variables dans le thermique
+!--------------------------------------------------------------------------------
+!
+      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
+!IM 140508   CALL thermcell_plume(ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+
+! Gestion temporaire de plusieurs appels à thermcell_plume au travers
+! de la variable iflag_thermals
+
+!      print*,'THERM thermcell_main iflag_thermals_ed=',iflag_thermals_ed
+      if (iflag_thermals_ed<=9) then
+!         print*,'THERM NOUVELLE/NOUVELLE Arnaud'
+         CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
+     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+     &    ,lev_out,lunout1,igout)
+
+      elseif (iflag_thermals_ed>9) then
+!        print*,'THERM RIO et al 2010, version d Arnaud'
+         CALL thermcellV1_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
+     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &    ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+     &    ,lev_out,lunout1,igout)
+
+      endif
+
+      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
+
+      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
+      if (prt_level.ge.10) then
+         write(lunout1,*) 'Dans thermcell_main 2'
+         write(lunout1,*) 'lmin ',lmin(igout)
+         write(lunout1,*) 'lalim ',lalim(igout)
+         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
+         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
+     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
+      endif
+
+!-------------------------------------------------------------------------------
+! Calcul des caracteristiques du thermique:zmax,zmix,wmax
+!-------------------------------------------------------------------------------
+!
+      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
+     &           zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
+! Attention, w2 est transforme en sa racine carree dans cette routine
+! Le probleme vient du fait que linter et lmix sont souvent égaux à 1.
+      wmax_tmp=0.
+      do  l=1,nlay
+         wmax_tmp(:)=max(wmax_tmp(:),zw2(:,l))
+      enddo
+!     print*,"ZMAX ",lalim,lmin,linter,lmix,lmax,zmax,zmax0,zmix,wmax
+
+
+
+      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
+      call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
+
+      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
+
+!-------------------------------------------------------------------------------
+! Fermeture,determination de f
+!-------------------------------------------------------------------------------
+!
+!
+!!      write(lunout,*)'THERM NOUVEAU XXXXX'
       CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
-     &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
+    &                      lalim,lmin,zmax_sec,wmax_sec,lev_out)
 
 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
@@ -417,59 +468,20 @@
 
 
-!---------------------------------------------------------------------------------
-!calcul du melange et des variables dans le thermique
-!--------------------------------------------------------------------------------
-!
-      if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out
-!IM 140508   CALL thermcell_plume(ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-      CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
-     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,zw_est,zqsatth,lmix,lmix_bis,linter &
-     &            ,lev_out,lunout1,igout)
-      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
-
-      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
-      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
-      if (prt_level.ge.10) then
-         write(lunout1,*) 'Dans thermcell_main 2'
-         write(lunout1,*) 'lmin ',lmin(igout)
-         write(lunout1,*) 'lalim ',lalim(igout)
-         write(lunout1,*) ' ig l alim_star entr_star detr_star f_star '
-         write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) &
-     &    ,f_star(igout,l+1),l=1,nint(linter(igout))+5)
-      endif
-
-!-------------------------------------------------------------------------------
-! Calcul des caracteristiques du thermique:zmax,zmix,wmax
-!-------------------------------------------------------------------------------
-!
-      CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2,  &
-     &           zlev,lmax,zmax,zmax0,zmix,wmax,lev_out)
-
-
-      call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
-      call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
-      call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
-      call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
-
-      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
-
-!-------------------------------------------------------------------------------
-! Fermeture,determination de f
-!-------------------------------------------------------------------------------
-!
-!avant closure: on redéfinit lalim, alim_star_tot et alim_star
-!       do ig=1,klon
-!       do l=2,lalim(ig)
-!       alim_star(ig,l)=entr_star(ig,l)
-!       entr_star(ig,l)=0.
-!       enddo
-!       enddo
-
+
+! Choix de la fonction d'alimentation utilisee pour la fermeture.
+! Apparemment sans importance
+      alim_star_clos(:,:)=alim_star(:,:)
+      alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:)
+
+! Appel avec la version seche
       CALL thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
-     &   zlev,lalim,alim_star,alim_star_tot,zmax_sec,wmax_sec,zmax,wmax,f,lev_out)
+     &   zlev,lalim,alim_star_clos,f_star,zmax_sec,wmax_sec,f,lev_out)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Appel avec les zmax et wmax tenant compte de la condensation
+! Semble moins bien marcher
+!     CALL thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
+!    &   zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
       if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure'
@@ -484,5 +496,6 @@
 ! Test valable seulement en 1D mais pas genant
       if (.not. (f0(1).ge.0.) ) then
-           stop 'Dans thermcell_main'
+              abort_message = '.not. (f0(1).ge.0.)'
+              CALL abort_gcm (modname,abort_message,1)
       endif
 
@@ -511,5 +524,5 @@
          fm0=(1.-lambda)*fm+lambda*fm0
          entr0=(1.-lambda)*entr+lambda*entr0
-!        detr0=(1.-lambda)*detr+lambda*detr0
+         detr0=(1.-lambda)*detr+lambda*detr0
       else
          fm0=fm
@@ -560,5 +573,5 @@
      &    ,fraca,zmax  &
      &    ,zu,zv,pduadj,pdvadj,zua,zva,lev_out)
-!IM 050508    &    ,zu,zv,pduadj,pdvadj,zua,zva,igout,lev_out)
+
       else
 
@@ -596,5 +609,6 @@
       pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
       enddo
-      do k=1,nlay
+!IM   do k=1,nlay
+      do k=1,nlay-1
          do ig=1,ngrid
          if ((pcon(ig).le.pplay(ig,k))  &
@@ -603,4 +617,12 @@
          endif
          enddo
+      enddo
+!IM
+      do ig=1,ngrid
+        if (pcon(ig).le.pplay(ig,nlay)) then 
+           zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100.
+           abort_message = 'thermcellV0_main: les thermiques vont trop haut '
+           CALL abort_gcm (modname,abort_message,1)
+        endif
       enddo
       if (prt_level.ge.1) print*,'14b OK convect8'
@@ -636,5 +658,5 @@
 !
       if (prt_level.ge.10) print*,'14f OK convect8 ig,l,zha zh zpspsk ',ig,l,zha(ig,l),zh(ig,l),zpspsk(ig,l)
-            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l)/zpspsk(ig,l))**2
+            thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2
             if(zw2(ig,l).gt.1.e-10) then
              wth2(ig,l)=zf2*(zw2(ig,l))**2
@@ -651,56 +673,33 @@
          enddo
       enddo
-!calcul de ale_bl et alp_bl
-!pour le calcul d'une valeur intégrée entre la surface et lmax
-      do ig=1,ngrid
-      alp_int(ig)=0.
-      ale_int(ig)=0.
-      n_int(ig)=0
-      enddo
-!
-      do l=1,nlay
-      do ig=1,ngrid
-       if(l.LE.lmax(ig)) THEN
-        alp_int(ig)=alp_int(ig)+0.5*rhobarz(ig,l)*wth3(ig,l)
-        ale_int(ig)=ale_int(ig)+0.5*zw2(ig,l)**2
-        n_int(ig)=n_int(ig)+1
-       endif
-      enddo
-      enddo
+!calcul des flux: q, thetal et thetav
+      do l=1,nlay
+         do ig=1,ngrid
+      wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.)
+      wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l))
+      wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l))
+         enddo
+      enddo
+!
 !      print*,'avant calcul ale et alp' 
 !calcul de ALE et ALP pour la convection
-      do ig=1,ngrid
-!      Alp_bl(ig)=0.5*rhobarz(ig,lmix_bis(ig))*wth3(ig,lmix(ig))
-!          Alp_bl(ig)=0.5*rhobarz(ig,nivcon(ig))*wth3(ig,nivcon(ig))
-!      Alp_bl(ig)=0.5*rhobarz(ig,lmix(ig))*wth3(ig,lmix(ig)) 
-!     &           *0.1
-!valeur integree de alp_bl * 0.5:
-       if (n_int(ig).gt.0) then
-       Alp_bl(ig)=0.5*alp_int(ig)/n_int(ig)
-!       if (Alp_bl(ig).lt.0.) then
-!       Alp_bl(ig)=0.
-       endif
-!       endif
-!         write(18,*),'rhobarz,wth3,Alp',rhobarz(ig,nivcon(ig)),
-!     s               wth3(ig,nivcon(ig)),Alp_bl(ig)
-!            write(18,*),'ALP_BL',Alp_bl(ig),lmix(ig)
-!      Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2
-!      if (nivcon(ig).eq.1) then
-!       Ale_bl(ig)=0.
-!       else
-!valeur max de ale_bl:
-       Ale_bl(ig)=0.5*zw2(ig,lmix(ig))**2 
-!     & /2.
-!     & *0.1
-!        Ale_bl(ig)=0.5*zw2(ig,lmix_bis(ig))**2 
-!       if (n_int(ig).gt.0) then
-!       Ale_bl(ig)=ale_int(ig)/n_int(ig)
-!        Ale_bl(ig)=4.
-!       endif
-!       endif
-!            Ale_bl(ig)=0.5*wth2(ig,lmix_bis(ig))
-!          Ale_bl(ig)=wth2(ig,nivcon(ig))
-!          write(19,*),'wth2,ALE_BL',wth2(ig,nivcon(ig)),Ale_bl(ig)
-      enddo
+      Alp_bl(:)=0.
+      Ale_bl(:)=0.
+!          print*,'ALE,ALP ,l,zw2(ig,l),Ale_bl(ig),Alp_bl(ig)'
+      do l=1,nlay
+      do ig=1,ngrid
+           Alp_bl(ig)=max(Alp_bl(ig),0.5*rhobarz(ig,l)*wth3(ig,l) )
+           Ale_bl(ig)=max(Ale_bl(ig),0.5*zw2(ig,l)**2)
+!          print*,'ALE,ALP',l,zw2(ig,l),Ale_bl(ig),Alp_bl(ig)
+      enddo
+      enddo
+
+!     print*,'AAAAAAA ',Alp_bl,Ale_bl,lmix
+
+
+! TEST. IL FAUT REECRIRE LES ALE et ALP
+!     Ale_bl(:)=0.5*wmax(:)*wmax(:)
+!     Alp_bl(:)=0.1*wmax(:)*wmax(:)*wmax(:)
+
 !test:calcul de la ponderation des couches pour KE
 !initialisations
@@ -782,6 +781,6 @@
 !     print*,'15 OK convect8'
 
+#ifdef wrgrads_thermcell
       if (prt_level.ge.1) print*,'thermcell_main sorties 3D'
-#ifdef wrgrads_thermcell
 #include "thermcell_out3d.h"
 #endif
@@ -791,5 +790,4 @@
       if (prt_level.ge.1) print*,'thermcell_main FIN  OK'
 
-!     if(icount.eq.501) stop'au pas 301 dans thermcell_main'
       return
       end
@@ -827,5 +825,4 @@
                   write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
                enddo
-!              stop
            endif
          enddo
Index: /LMDZ4/trunk/libf/phylmd/thermcell_old.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_old.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_old.F	(revision 1403)
@@ -112,4 +112,7 @@
       character (len=10) :: str10
 
+      character (len=20) :: modname='thermcell2002'
+      character (len=80) :: abort_message
+
       LOGICAL vtest(klon),down
 
@@ -336,5 +339,5 @@
             if(w2di.eq.2) then
                entr(ig,k)=entr(ig,k)+
-     s         ptimestep*(zzz-entr(ig,k))/float(tho)
+     s         ptimestep*(zzz-entr(ig,k))/REAL(tho)
             else
                entr(ig,k)=zzz
@@ -379,5 +382,4 @@
 c     print*,'ig,l+1,ztv(ig,l+1)'
 c     print*, ig,l+1,ztv(ig,l+1)
-c        stop'dans thermiques'
 c     endif
                zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
@@ -395,5 +397,4 @@
 c     print*,'Tv ',(ztv(ig,ll),ll=1,klev)
 c     print*,'Entr ',(entr(ig,ll),ll=1,klev)
-c        stop'dans thermiques'
 c     endif
                ztva(ig,l)=(fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l))
@@ -517,6 +518,7 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1) then
-               stop'fracd trop petit'
-            else
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1) 
+           else
 c    vitesse descendante "diagnostique"
                wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
@@ -588,6 +590,6 @@
 
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/REAL(tho)
       else
          fm0=fm
@@ -1000,4 +1002,7 @@
       character*2 str2
       character*10 str10
+
+      character (len=20) :: modname='thermcell_cld'
+      character (len=80) :: abort_message
 
       LOGICAL vtest(klon),down
@@ -1855,5 +1860,6 @@
        if (l.eq.klev) then
           print*,'THERMCELL PB ig=',ig,'   l=',l
-          stop
+          abort_message = 'THERMCELL PB'
+          CALL abort_gcm (modname,abort_message,1)
        endif
 !       if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and.
@@ -2164,5 +2170,6 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1.and.(test(ig).eq.1)) then
-               stop'fracd trop petit'
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1)
             else
 c    vitesse descendante "diagnostique"
@@ -2262,6 +2269,6 @@
 
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(alim+entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(alim+entr-entr0)/REAL(tho)
       else
          fm0=fm
@@ -2747,4 +2754,7 @@
       character*10 str10
 
+      character (len=20) :: modname='thermcell_eau'
+      character (len=80) :: abort_message
+
       LOGICAL vtest(klon),down
       LOGICAL Zsat(klon)
@@ -3410,5 +3420,6 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1) then
-               stop'fracd trop petit'
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1)
             else
 c    vitesse descendante "diagnostique"
@@ -3481,6 +3492,6 @@
 
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/REAL(tho)
       else
          fm0=fm
@@ -3848,4 +3859,7 @@
       character*10 str10
 
+      character (len=20) :: modname='thermcell'
+      character (len=80) :: abort_message
+
       LOGICAL vtest(klon),down
 
@@ -4394,5 +4408,6 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1) then
-               stop'fracd trop petit'
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1)
             else
 c    vitesse descendante "diagnostique"
@@ -4477,6 +4492,6 @@
 cRC
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/REAL(tho)
       else
          fm0=fm
@@ -5257,4 +5272,7 @@
       character*10 str10
 
+      character (len=20) :: modname='thermcell_sec'
+      character (len=80) :: abort_message
+
       LOGICAL vtest(klon),down
 
@@ -5822,5 +5840,6 @@
          do ig=1,ngrid
             if(fracd(ig,l).lt.0.1) then
-               stop'fracd trop petit'
+              abort_message = 'fracd trop petit'
+              CALL abort_gcm (modname,abort_message,1)
             else
 c    vitesse descendante "diagnostique"
@@ -5905,6 +5924,6 @@
 cRC
       if (w2di.eq.1) then
-         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
-         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+         fm0=fm0+ptimestep*(fm-fm0)/REAL(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/REAL(tho)
       else
          fm0=fm
Index: /LMDZ4/trunk/libf/phylmd/thermcell_out3d.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_out3d.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_out3d.h	(revision 1403)
@@ -27,4 +27,9 @@
          call wrgradsfi(1,nlay,q2(igout,1:klev),'q2       ','q2       ')
 !
+!
+         call wrgradsfi(1,nlay,wthl(igout,1:klev),'wthl       ','wthl       ')
+         call wrgradsfi(1,nlay,wthv(igout,1:klev),'wthv       ','wthv       ')
+         call wrgradsfi(1,nlay,wq(igout,1:klev),'wq       ','wq       ')
+         
          call wrgradsfi(1,nlay,ztva(igout,1:klev),'ztva      ','ztva      ')
          call wrgradsfi(1,nlay,ztv(igout,1:klev),'ztv       ','ztv       ')
@@ -53,5 +58,4 @@
       call wrgradsfi(1,1,f(igout),'f      ','f      ')
       call wrgradsfi(1,1,alim_star_tot(igout),'a_s_t      ','a_s_t      ')
-      call wrgradsfi(1,1,alim_star2(igout),'a_2      ','a_2      ')
       call wrgradsfi(1,1,zmax(igout),'zmax      ','zmax      ')
       call wrgradsfi(1,1,zmax_sec(igout),'z_sec      ','z_sec      ')
Index: /LMDZ4/trunk/libf/phylmd/thermcell_plume.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_plume.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_plume.F90	(revision 1403)
@@ -1,6 +1,9 @@
+!
+! $Id$
+!
       SUBROUTINE thermcell_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
-     &           zlev,pplev,pphi,zpspsk,l_mix,r_aspect,alim_star,alim_star_tot,  &
-     &           lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva,  &
-     &           ztla,zqla,zqta,zha,zw2,w_est,zqsatth,lmix,lmix_bis,linter &
+     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+     &           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+     &           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
      &           ,lev_out,lunout1,igout)
 
@@ -31,8 +34,5 @@
       REAL zpspsk(ngrid,klev)
       REAL alim_star(ngrid,klev)
-      REAL zmax_sec(ngrid)
       REAL f0(ngrid)
-      REAL l_mix
-      REAL r_aspect
       INTEGER lalim(ngrid)
       integer lev_out                           ! niveau pour les print
@@ -44,5 +44,4 @@
       REAL ztla(ngrid,klev)
       REAL zqla(ngrid,klev)
-      REAL zqla0(ngrid,klev)
       REAL zqta(ngrid,klev)
       REAL zha(ngrid,klev)
@@ -50,16 +49,9 @@
       REAL detr_star(ngrid,klev)
       REAL coefc
-      REAL detr_stara(ngrid,klev)
-      REAL detr_starb(ngrid,klev)
-      REAL detr_starc(ngrid,klev)
-      REAL detr_star0(ngrid,klev)
-      REAL detr_star1(ngrid,klev)
-      REAL detr_star2(ngrid,klev)
-
       REAL entr_star(ngrid,klev)
-      REAL entr_star1(ngrid,klev)
-      REAL entr_star2(ngrid,klev)
       REAL detr(ngrid,klev)
       REAL entr(ngrid,klev)
+
+      REAL csc(ngrid,klev)
 
       REAL zw2(ngrid,klev+1)
@@ -72,4 +64,7 @@
       REAL zqsatth(ngrid,klev)
       REAL zta_est(ngrid,klev)
+      REAL zdw2
+      REAL zw2modif
+      REAL zeps
 
       REAL linter(ngrid)
@@ -80,4 +75,5 @@
       INTEGER ig,l,k
 
+      real zdz,zfact,zbuoy,zalpha,zdrag
       real zcor,zdelta,zcvm5,qlbef
       real Tbef,qsatbef
@@ -86,135 +82,128 @@
       PARAMETER (DDT0=.01)
       logical Zsat
-      REAL fact_gamma,fact_epsilon
+      LOGICAL active(ngrid),activetmp(ngrid)
+      REAL fact_gamma,fact_epsilon,fact_gamma2
       REAL c2(ngrid,klev)
-
+      REAL a1,m
+
+      REAL zw2fact,expa
       Zsat=.false.
 ! Initialisation
       RLvCp = RLVTT/RCPD
      
-      if (iflag_thermals_ed==0) then
-         fact_gamma=1.
-         fact_epsilon=1.
-      else if (iflag_thermals_ed==1)  then
-         fact_gamma=1.
-         fact_epsilon=1.
-      else if (iflag_thermals_ed==2)  then
-         fact_gamma=1.
-         fact_epsilon=2.
-      endif
-
-      do l=1,klev
+      
+         fact_epsilon=0.002
+         a1=2./3.
+         fact_gamma=0.9
+         zfact=fact_gamma/(1+fact_gamma)
+         fact_gamma2=zfact
+         expa=0.
+      
+
+! Initialisations des variables reeles
+if (1==1) then
+      ztva(:,:)=ztv(:,:)
+      ztva_est(:,:)=ztva(:,:)
+      ztla(:,:)=zthl(:,:)
+      zqta(:,:)=po(:,:)
+      zha(:,:) = ztva(:,:)
+else
+      ztva(:,:)=0.
+      ztva_est(:,:)=0.
+      ztla(:,:)=0.
+      zqta(:,:)=0.
+      zha(:,:) =0.
+endif
+
+      zqla_est(:,:)=0.
+      zqsatth(:,:)=0.
+      zqla(:,:)=0.
+      detr_star(:,:)=0.
+      entr_star(:,:)=0.
+      alim_star(:,:)=0.
+      alim_star_tot(:)=0.
+      csc(:,:)=0.
+      detr(:,:)=0.
+      entr(:,:)=0.
+      zw2(:,:)=0.
+      w_est(:,:)=0.
+      f_star(:,:)=0.
+      wa_moy(:,:)=0.
+      linter(:)=1.
+      linter(:)=1.
+
+! Initialisation des variables entieres
+      lmix(:)=1
+      lmix_bis(:)=2
+      wmaxa(:)=0.
+      lalim(:)=1
+
+!-------------------------------------------------------------------------
+! On ne considere comme actif que les colonnes dont les deux premieres
+! couches sont instables.
+!-------------------------------------------------------------------------
+      active(:)=ztv(:,1)>ztv(:,2)
+
+!-------------------------------------------------------------------------
+! Definition de l'alimentation a l'origine dans thermcell_init
+!-------------------------------------------------------------------------
+      do l=1,klev-1
          do ig=1,ngrid
-            zqla_est(ig,l)=0.
-            ztva_est(ig,l)=ztva(ig,l)
-            zqsatth(ig,l)=0.
+            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
+               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+               lalim(:)=l+1
+               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+            endif
          enddo
       enddo
-
-!CR: attention test couche alim
-!     do l=2,klev
-!     do ig=1,ngrid
-!        alim_star(ig,l)=0.
-!     enddo
-!     enddo
-!AM:initialisations du thermique
-      do k=1,klev
-         do ig=1,ngrid
-            ztva(ig,k)=ztv(ig,k)
-            ztla(ig,k)=zthl(ig,k)
-            zqla(ig,k)=0.
-            zqta(ig,k)=po(ig,k)
-!
-            ztva(ig,k) = ztla(ig,k)*zpspsk(ig,k)+RLvCp*zqla(ig,k)
-            ztva(ig,k) = ztva(ig,k)/zpspsk(ig,k)
-            zha(ig,k) = ztva(ig,k)
-!
-         enddo
-      enddo 
-      do k=1,klev
-        do ig=1,ngrid
-           detr_star(ig,k)=0.
-           entr_star(ig,k)=0.
-
-           detr_stara(ig,k)=0.
-           detr_starb(ig,k)=0.
-           detr_starc(ig,k)=0.
-           detr_star0(ig,k)=0.
-           zqla0(ig,k)=0.
-           detr_star1(ig,k)=0.
-           detr_star2(ig,k)=0.
-           entr_star1(ig,k)=0.
-           entr_star2(ig,k)=0.
-
-           detr(ig,k)=0.
-           entr(ig,k)=0.
-        enddo
-      enddo
-      if (prt_level.ge.1) print*,'7 OK convect8'
-      do k=1,klev+1
-         do ig=1,ngrid
-            zw2(ig,k)=0.
-            w_est(ig,k)=0.
-            f_star(ig,k)=0.
-            wa_moy(ig,k)=0.
+      do l=1,klev
+         do ig=1,ngrid 
+            if (alim_star_tot(ig) > 1.e-10 ) then
+               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+            endif
          enddo
       enddo
-
-      if (prt_level.ge.1) print*,'8 OK convect8'
-      do ig=1,ngrid
-         linter(ig)=1.
-         lmix(ig)=1
-         lmix_bis(ig)=2
-         wmaxa(ig)=0.
-      enddo
-
-!-----------------------------------------------------------------------------------
-!boucle de calcul de la vitesse verticale dans le thermique
-!-----------------------------------------------------------------------------------
-      do l=1,klev-1
-         do ig=1,ngrid
-
-
-
-! Calcul dans la premiere couche active du thermique (ce qu'on teste
-! en disant que la couche est instable et que w2 en bas de la couche
-! est nulle.
-
-            if (ztv(ig,l).gt.ztv(ig,l+1)  &
-     &         .and.alim_star(ig,l).gt.1.e-10  &
-     &         .and.zw2(ig,l).lt.1e-10) then
-
-
+      alim_star_tot(:)=1.
+
+
+!------------------------------------------------------------------------------
+! Calcul dans la premiere couche
+! On decide dans cette version que le thermique n'est actif que si la premiere
+! couche est instable.
+! Pourrait etre change si on veut que le thermiques puisse se dÃ©clencher
+! dans une couche l>1
+!------------------------------------------------------------------------------
+do ig=1,ngrid
 ! Le panache va prendre au debut les caracteristiques de l'air contenu
 ! dans cette couche.
-               ztla(ig,l)=zthl(ig,l) 
-               zqta(ig,l)=po(ig,l)
-               zqla(ig,l)=zl(ig,l)
-               f_star(ig,l+1)=alim_star(ig,l)
-
-               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)  &
-     &                     *(zlev(ig,l+1)-zlev(ig,l))  &
-     &                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
-               w_est(ig,l+1)=zw2(ig,l+1)
+    if (active(ig)) then
+    ztla(ig,1)=zthl(ig,1) 
+    zqta(ig,1)=po(ig,1)
+    zqla(ig,1)=zl(ig,1)
+!cr: attention, prise en compte de f*(1)=1
+    f_star(ig,2)=alim_star(ig,1)
+    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+&                     *(zlev(ig,2)-zlev(ig,1))  &
+&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
+    w_est(ig,2)=zw2(ig,2)
+    endif
+enddo
 !
 
-
-            else if ((zw2(ig,l).ge.1e-10).and.  &
-     &         (f_star(ig,l)+alim_star(ig,l)).gt.1.e-10) then
-!estimation du detrainement a partir de la geometrie du pas precedent
-!tests sur la definition du detr
-!calcul de detr_star et entr_star
-
-
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH le test miraculeux de Catherine ? Le bout du tunel ?
-!               w_est(ig,3)=zw2(ig,2)*  &
-!    &                   ((f_star(ig,2))**2)  &
-!    &                   /(f_star(ig,2)+alim_star(ig,2))**2+  &
-!    &                   2.*RG*(ztva(ig,1)-ztv(ig,2))/ztv(ig,2)  &
-!    &                   *(zlev(ig,3)-zlev(ig,2))
-!     if (l.gt.2) then
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!==============================================================================
+!boucle de calcul de la vitesse verticale dans le thermique
+!==============================================================================
+do l=2,klev-1
+!==============================================================================
+
+
+! On decide si le thermique est encore actif ou non
+! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
+    do ig=1,ngrid
+       active(ig)=active(ig) &
+&                 .and. zw2(ig,l)>1.e-10 &
+&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
+    enddo
 
 
@@ -222,477 +211,136 @@
 ! Premier calcul de la vitesse verticale a partir de la temperature
 ! potentielle virtuelle
-
-! FH CESTQUOI CA ????
-#define int1d2
-!#undef int1d2
-#ifdef int1d2
-      if (l.ge.2) then
-#else
-      if (l.gt.2) then
-#endif
-
-      if (1.eq.1) then
-          w_est(ig,3)=zw2(ig,2)* &
-     &      ((f_star(ig,2))**2) &
-     &      /(f_star(ig,2)+alim_star(ig,2))**2+ &
-     &      2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) &
-!     &      *1./3. &
-     &      *(zlev(ig,3)-zlev(ig,2))
-       endif
-
-
-!---------------------------------------------------------------------------
-!calcul de l entrainement et du detrainement lateral
-!---------------------------------------------------------------------------
-!
-!test:estimation de ztva_new_est sans entrainement
-
-               Tbef=ztla(ig,l-1)*zpspsk(ig,l)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               Zsat = (max(0.,zqta(ig,l-1)-qsatbef) .gt. 1.e-10)
-               if (Zsat) then
-               qlbef=max(0.,zqta(ig,l-1)-qsatbef)
-               DT = 0.5*RLvCp*qlbef
-               do while (abs(DT).gt.DDT0)
-                 Tbef=Tbef+DT
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig,l-1)-qsatbef
-
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef+ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 DT=num/denom
-               enddo
-                 zqla_est(ig,l) = max(0.,zqta(ig,l-1)-qsatbef) 
-               endif
+!     if (1.eq.1) then
+!         w_est(ig,3)=zw2(ig,2)* &
+!    &      ((f_star(ig,2))**2) &
+!    &      /(f_star(ig,2)+alim_star(ig,2))**2+ &
+!    &      2.*RG*(ztva(ig,2)-ztv(ig,2))/ztv(ig,2) &
+!    &      *(zlev(ig,3)-zlev(ig,2))
+!      endif
+
+
+!---------------------------------------------------------------------------
+! calcul des proprietes thermodynamiques et de la vitesse de la couche l
+! sans tenir compte du detrainement et de l'entrainement dans cette
+! couche
+! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
+! avant) a l'alimentation pour avoir un calcul plus propre
+!---------------------------------------------------------------------------
+
+     call thermcell_condens(ngrid,active, &
+&          zpspsk(:,l),pplev(:,l),ztla(:,l-1),zqta(:,l-1),zqla_est(:,l))
+
+    do ig=1,ngrid
+        if(active(ig)) then
         ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
         ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
-        zta_est(ig,l)=ztva_est(ig,l)
         ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
      &      -zqla_est(ig,l))-zqla_est(ig,l))
 
+         if (1.eq.0) then 
+!calcul de w_est sans prendre en compte le drag 
              w_est(ig,l+1)=zw2(ig,l)*  &
      &                   ((f_star(ig,l))**2)  &
      &                   /(f_star(ig,l)+alim_star(ig,l))**2+  &
      &                   2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                   *1./3. &
      &                   *(zlev(ig,l+1)-zlev(ig,l))
+         else
+
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+           zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l))/rhobarz(ig,l)
+           zbuoy=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdrag=fact_epsilon/(zalpha**expa)
+           zw2fact=zbuoy/zdrag*a1
+           w_est(ig,l+1)=(w_est(ig,l)-zw2fact)*exp(-2.*zdrag/(1+fact_gamma)*zdz) &
+      &    +zw2fact
+
+         endif
+
              if (w_est(ig,l+1).lt.0.) then
                 w_est(ig,l+1)=zw2(ig,l)
              endif
-!
-!calcul du detrainement
-!=======================
-
-!CR:on vire les modifs
-         if (iflag_thermals_ed==0) then
-
-! Modifications du calcul du detrainement.
-! Dans la version de la these de Catherine, on passe brusquement
-! de la version seche a la version nuageuse pour le detrainement
-! ce qui peut occasioner des oscillations.
-! dans la nouvelle version, on commence par calculer un detrainement sec.
-! Puis un autre en cas de nuages.
-! Puis on combine les deux lineairement en fonction de la quantite d'eau.
-
-#define int1d3
-!#undef int1d3
-#define RIO_TH
-#ifdef RIO_TH
-!1. Cas non nuageux
-! 1.1 on est sous le zmax_sec et w croit
-          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
-     &       (zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
-#ifdef int1d3
-     &       (zqla_est(ig,l).lt.1.e-10)) then 
-#else
-     &       (zqla(ig,l-1).lt.1.e-10)) then 
-#endif
-             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
-     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
-     &       /(r_aspect*zmax_sec(ig)))
-             detr_stara(ig,l)=detr_star(ig,l)
-
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l',ig,l
-
-! 1.2 on est sous le zmax_sec et w decroit
-          else if ((zlev(ig,l+1).lt.zmax_sec(ig)).and.  &
-#ifdef int1d3
-     &            (zqla_est(ig,l).lt.1.e-10)) then
-#else
-     &            (zqla(ig,l-1).lt.1.e-10)) then
-#endif
-             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
-     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
-     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
-     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
-     &       *((zmax_sec(ig)-zlev(ig,l))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
-             detr_starb(ig,l)=detr_star(ig,l)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l',ig,l
-
-          else
-
-! 1.3 dans les autres cas
-             detr_star(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
-     &                      *(zlev(ig,l+1)-zlev(ig,l))
-             detr_starc(ig,l)=detr_star(ig,l)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 3 n: ig, l',ig, l
-             
-          endif
-
-#else
-
-! 1.1 on est sous le zmax_sec et w croit
-          if ((w_est(ig,l+1).gt.w_est(ig,l)).and.  &
-     &       (zlev(ig,l+1).lt.zmax_sec(ig)) ) then
-             detr_star(ig,l)=MAX(0.,(rhobarz(ig,l+1)  &
-     &       *sqrt(w_est(ig,l+1))*sqrt(l_mix*zlev(ig,l+1))  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))*sqrt(l_mix*zlev(ig,l)))  &
-     &       /(r_aspect*zmax_sec(ig)))
-
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
-
-! 1.2 on est sous le zmax_sec et w decroit
-          else if ((zlev(ig,l+1).lt.zmax_sec(ig)) ) then
-             detr_star(ig,l)=-f0(ig)*f_star(ig,lmix(ig))  &
-     &       /(rhobarz(ig,lmix(ig))*wmaxa(ig))*  &
-     &       (rhobarz(ig,l+1)*sqrt(w_est(ig,l+1))  &
-     &       *((zmax_sec(ig)-zlev(ig,l+1))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.  &
-     &       -rhobarz(ig,l)*sqrt(w_est(ig,l))  &
-     &       *((zmax_sec(ig)-zlev(ig,l))/  &
-     &       ((zmax_sec(ig)-zlev(ig,lmix(ig)))))**2.)
-       if (prt_level.ge.20) print*,'coucou calcul detr 1: ig, l', ig, l
-
-          else
-             detr_star=0.
-          endif
-
-! 1.3 dans les autres cas
-          detr_starc(ig,l)=0.002*f0(ig)*f_star(ig,l)  &
-     &                      *(zlev(ig,l+1)-zlev(ig,l))
-
-          coefc=min(zqla(ig,l-1)/1.e-3,1.)
-          if (zlev(ig,l+1).ge.zmax_sec(ig)) coefc=1.
-          coefc=1.
-! il semble qu'il soit important de baser le calcul sur
-! zqla_est(ig,l-1) plutot que sur zqla_est(ig,l)
-          detr_star(ig,l)=detr_starc(ig,l)*coefc+detr_star(ig,l)*(1.-coefc)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 2: ig, l', ig, l
-
-#endif
-
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 444: ig, l', ig, l
-!IM 730508 beg
-!        if(itap.GE.7200) THEN
-!         print*,'th_plume ig,l,itap,zqla_est=',ig,l,itap,zqla_est(ig,l)
+       endif
+    enddo
+
+!-------------------------------------------------
+!calcul des taux d'entrainement et de detrainement
+!-------------------------------------------------
+
+     do ig=1,ngrid
+        if (active(ig)) then
+          zdz=zlev(ig,l+1)-zlev(ig,l)
+          zbuoy=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+ 
+! estimation de la fraction couverte par les thermiques
+          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l))/rhobarz(ig,l)
+
+!calcul de la soumission papier 
+! Calcul  du taux d'entrainement entr_star (epsilon)
+           entr_star(ig,l)=f_star(ig,l)*zdz * (  zfact * MAX(0.,  &     
+     &     a1*zbuoy/w_est(ig,l+1) &
+     &     - fact_epsilon/zalpha**expa  ) &
+     &     +0. )
+           
+!calcul du taux de detrainment (delta)
+!           detr_star(ig,l)=f_star(ig,l)*zdz * (                           &
+!     &      MAX(1.e-3, &
+!     &      -fact_gamma2*a1*zbuoy/w_est(ig,l+1)        &
+!     &      +0.01*(max(zqta(ig,l-1)-po(ig,l),0.)/(po(ig,l))/(w_est(ig,l+1)))**0.5    &    
+!     &     +0. ))
+
+          m=0.5
+
+          detr_star(ig,l)=1.*f_star(ig,l)*zdz *                    &
+    &     MAX(5.e-4,-fact_gamma2*a1*(1./w_est(ig,l+1))*((1.-(1.-m)/(1.+70*zqta(ig,l-1)))*zbuoy        &
+    &     -40*(1.-m)*(max(zqta(ig,l-1)-po(ig,l),0.))/(1.+70*zqta(ig,l-1)) )   )
+
+!           detr_star(ig,l)=f_star(ig,l)*zdz * (                           &
+!     &      MAX(0.0, &
+!     &      -fact_gamma2*a1*zbuoy/w_est(ig,l+1)        &
+!     &      +20*(max(zqta(ig,l-1)-po(ig,l),0.))**1*(zalpha/w_est(ig,l+1))**0.5    &    
+!     &     +0. ))
+
+
+! En dessous de lalim, on prend le max de alim_star et entr_star pour
+! alim_star et 0 sinon
+        if (l.lt.lalim(ig)) then
+          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
+          entr_star(ig,l)=0.
+        endif
+
+!attention test
+!        if (detr_star(ig,l).gt.(f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l))) then       
+!            detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)
 !        endif
-!IM 730508 end
-         
-         zqla0(ig,l)=zqla_est(ig,l)
-         detr_star0(ig,l)=detr_star(ig,l)
-!IM 060508 beg
-!         if(detr_star(ig,l).GT.1.) THEN
-!          print*,'th_plumeBEF ig l detr_star detr_starc coefc',ig,l,detr_star(ig,l) &
-!   &      ,detr_starc(ig,l),coefc
-!         endif
-!IM 060508 end
-!IM 160508 beg
-!IM 160508       IF (f0(ig).NE.0.) THEN
-           detr_star(ig,l)=detr_star(ig,l)/f0(ig)
-!IM 160508       ELSE IF(detr_star(ig,l).EQ.0.) THEN
-!IM 160508        print*,'WARNING1  : th_plume f0=0, detr_star=0: ig, l, itap',ig,l,itap
-!IM 160508       ELSE
-!IM 160508        print*,'WARNING2  : th_plume f0=0, ig, l, itap, detr_star',ig,l,itap,detr_star(ig,l)
-!IM 160508       ENDIF
-!IM 160508 end
-!IM 060508 beg
-!        if(detr_star(ig,l).GT.1.) THEN
-!         print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), &
-!   &     float(1)/f0(ig)
-!        endif
-!IM 060508 end
-        if (prt_level.ge.20) print*,'coucou calcul detr 445: ig, l', ig, l
-!
-!calcul de entr_star
-
-! #undef test2
-! #ifdef test2
-! La version test2 destabilise beaucoup le modele.
-! Il semble donc que ca aide d'avoir un entrainement important sous
-! le nuage.
-!         if (zqla_est(ig,l-1).ge.1.e-10.and.l.gt.lalim(ig)) then
-!          entr_star(ig,l)=0.4*detr_star(ig,l)
-!         else
-!          entr_star(ig,l)=0.
-!         endif
-! #else
-!
-! Deplacement du calcul de entr_star pour eviter d'avoir aussi
-! entr_star > fstar.
-! Redeplacer suite a la transformation du cas detr>f
-! FH
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 446: ig, l', ig, l
-#define int1d
-!FH 070508 #define int1d4
-!#undef int1d4
-! L'option int1d4 correspond au choix dans le cas ou le detrainement
-! devient trop grand.
-
-#ifdef int1d
-
-#ifdef int1d4
-#else
-       detr_star(ig,l)=min(detr_star(ig,l),f_star(ig,l))
-!FH 070508 plus
-       detr_star(ig,l)=min(detr_star(ig,l),1.)
-#endif
-
-       entr_star(ig,l)=max(0.4*detr_star(ig,l)-alim_star(ig,l),0.)
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 447: ig, l', ig, l
-#ifdef int1d4
-! Si le detrainement excede le flux en bas + l'entrainement, le thermique
-! doit disparaitre.
-       if (detr_star(ig,l)>f_star(ig,l)+entr_star(ig,l)) then
-          detr_star(ig,l)=f_star(ig,l)+entr_star(ig,l)
-          f_star(ig,l+1)=0.
-          linter(ig)=l+1
-          zw2(ig,l+1)=-1.e-10
-       endif
-#endif
-
-
-#else
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 448: ig, l', ig, l
-        if(l.gt.lalim(ig)) then
-         entr_star(ig,l)=0.4*detr_star(ig,l)
-        else
-
-! FH :
-! Cette ligne doit permettre de garantir qu'on a toujours un flux = 1
-! en haut de la couche d'alimentation.
-! A remettre en questoin a la premiere occasion mais ca peut aider a 
-! ecrire un code robuste.
-! Que ce soit avec ca ou avec l'ancienne facon de faire (e* = 0 mais
-! d* non nul) on a une discontinuité de e* ou d* en haut de la couche
-! d'alimentation, ce qui n'est pas forcement heureux.
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 449: ig, l', ig, l
-#undef pre_int1c
-#ifdef pre_int1c
-         entr_star(ig,l)=max(detr_star(ig,l)-alim_star(ig,l),0.)
-         detr_star(ig,l)=entr_star(ig,l)
-#else
-         entr_star(ig,l)=0.
-#endif
-
-        endif
-
-#endif
-
-        if (prt_level.ge.20) print*,'coucou calcul detr 440: ig, l', ig, l
-        entr_star1(ig,l)=entr_star(ig,l)
-        detr_star1(ig,l)=detr_star(ig,l)
-!
-
-#ifdef int1d
-#else
-        if (detr_star(ig,l).gt.f_star(ig,l)) then
-
-!  Ce test est là entre autres parce qu'on passe par des valeurs
-!  delirantes de detr_star.
-!  ca vaut sans doute le coup de verifier pourquoi.
-
-           detr_star(ig,l)=f_star(ig,l)
-#ifdef pre_int1c
-           if (l.gt.lalim(ig)+1) then
-               entr_star(ig,l)=0.
-               alim_star(ig,l)=0.
-! FH ajout pour forcer a stoper le thermique juste sous le sommet
-! de la couche (voir calcul de finter)
-               zw2(ig,l+1)=-1.e-10
-               linter(ig)=l+1
-            else
-               entr_star(ig,l)=0.4*detr_star(ig,l)
-            endif
-#else
-           entr_star(ig,l)=0.4*detr_star(ig,l)
-#endif
-        endif
-#endif
-
-      else !l > 2
-         detr_star(ig,l)=0.
-         entr_star(ig,l)=0.
-      endif
-
-        entr_star2(ig,l)=entr_star(ig,l)
-        detr_star2(ig,l)=detr_star(ig,l)
-        if (prt_level.ge.20) print*,'coucou calcul detr 450: ig, l', ig, l
-
-       endif  ! iflag_thermals_ed==0
-
-!CR:nvlle def de entr_star et detr_star
-      if (iflag_thermals_ed>=1) then
-!      if (l.lt.lalim(ig)) then
-!      if (l.lt.2) then 
-!        entr_star(ig,l)=0.
-!        detr_star(ig,l)=0.
-!      else
-!      if (0.001.gt.(RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))/(2.*w_est(ig,l+1)))) then 
-!         entr_star(ig,l)=0.001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-!      else
-!         entr_star(ig,l)=  &
-!     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-
- 
-         entr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &          
-     &                f_star(ig,l)/(2.*w_est(ig,l+1))        &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)   &
-     &                *(zlev(ig,l+1)-zlev(ig,l))) &
-     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
-        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
-            alim_star_tot(ig)=alim_star_tot(ig)+entr_star(ig,l)
-            lalim(ig)=lmix_bis(ig)
-            if(prt_level.GE.10) print*,'alim_star_tot',alim_star_tot(ig),entr_star(ig,l)
-        endif
-
-        if (((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10).and.(l.le.lmix_bis(ig))) then
-!        c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
-         c2(ig,l)=0.001
-         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
-     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
-     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
-     &                *(zlev(ig,l+1)-zlev(ig,l)))                    &
-     &                +0.0001*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
-       else
-!         c2(ig,l)=2500000.*zqla_est(ig,l)/(1004.*zta_est(ig,l))
-          c2(ig,l)=0.003
-
-         detr_star(ig,l)=MAX(0.*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)),  &
-     &                c2(ig,l)*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l)) &
-     &                -f_star(ig,l)/(2.*w_est(ig,l+1))       &
-     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)       &
-     &                *(zlev(ig,l+1)-zlev(ig,l))) &
-     &                +0.0002*f_star(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-       endif
-         
-           
-!        detr_star(ig,l)=detr_star(ig,l)*3.
-!        if (l.lt.lalim(ig)) then
-!          entr_star(ig,l)=0.
-!        endif
-!        if (l.lt.2) then
-!          entr_star(ig,l)=0.
-!          detr_star(ig,l)=0.
-!        endif
-
-
-!      endif 
-!      else if ((ztva_est(ig,l)-ztv(ig,l)).gt.1.e-10) then
-!      entr_star(ig,l)=MAX(0.,0.8*f_star(ig,l)/(2.*w_est(ig,l+1))        &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))   &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      detr_star(ig,l)=0.002*f_star(ig,l)                         &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      else
-!      entr_star(ig,l)=0.001*f_star(ig,l)                         &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      detr_star(ig,l)=MAX(0.,-0.2*f_star(ig,l)/(2.*w_est(ig,l+1))       &
-!     &                *RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l))       &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))                      &
-!     &                +0.002*f_star(ig,l)                             &
-!     &                *(zlev(ig,l+1)-zlev(ig,l))
-!      endif
-
-      endif   ! iflag_thermals_ed==1
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! FH inutile si on conserve comme on l'a fait plus haut entr=detr
-! dans la couche d'alimentation
-!pas d entrainement dans la couche alim
-!      if ((l.le.lalim(ig))) then
-!           entr_star(ig,l)=0.
-!      endif
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!prise en compte du detrainement et de l entrainement dans le calcul du flux
-
+! Calcul du flux montant normalise
       f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
      &              -detr_star(ig,l)
 
-!test sur le signe de f_star
-        if (prt_level.ge.20) print*,'coucou calcul detr 451: ig, l', ig, l
-       if (f_star(ig,l+1).gt.1.e-10) then 
+      endif
+   enddo
+
 !----------------------------------------------------------------------------
 !calcul de la vitesse verticale en melangeant Tl et qt du thermique
 !---------------------------------------------------------------------------
-!
-       Zsat=.false.
-       ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
+   do ig=1,ngrid
+       if (activetmp(ig)) then 
+           Zsat=.false.
+           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
      &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
      &            /(f_star(ig,l+1)+detr_star(ig,l))
-!
-       zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
      &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
      &            /(f_star(ig,l+1)+detr_star(ig,l))
-!  
-               Tbef=ztla(ig,l)*zpspsk(ig,l)
-               zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-               qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)               
-               qsatbef=MIN(0.5,qsatbef)
-               zcor=1./(1.-retv*qsatbef)
-               qsatbef=qsatbef*zcor
-               Zsat = (max(0.,zqta(ig,l)-qsatbef) .gt. 1.e-10)
-               if (Zsat) then
-               qlbef=max(0.,zqta(ig,l)-qsatbef)
-               DT = 0.5*RLvCp*qlbef
-               do while (abs(DT).gt.DDT0)
-                 Tbef=Tbef+DT
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 qsatbef= R2ES * FOEEW(Tbef,zdelta)/pplev(ig,l)
-                 qsatbef=MIN(0.5,qsatbef)
-                 zcor=1./(1.-retv*qsatbef)
-                 qsatbef=qsatbef*zcor
-                 qlbef=zqta(ig,l)-qsatbef
-
-                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
-                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
-                 zcor=1./(1.-retv*qsatbef)
-                 dqsat_dT=FOEDE(Tbef,zdelta,zcvm5,qsatbef,zcor)
-                 num=-Tbef+ztla(ig,l)*zpspsk(ig,l)+RLvCp*qlbef
-                 denom=1.+RLvCp*dqsat_dT
-                 DT=num/denom
-              enddo
-                 zqla(ig,l) = max(0.,qlbef) 
-              endif
-!    
+
+        endif
+    enddo
+
+   call thermcell_condens(ngrid,activetmp,zpspsk(:,l),pplev(:,l),ztla(:,l),zqta(:,l),zqla(:,l))
+
+
+   do ig=1,ngrid
+      if (activetmp(ig)) then
         if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l
 ! on ecrit de maniere conservative (sat ou non)
@@ -707,43 +355,42 @@
 !on ecrit zqsat 
            zqsatth(ig,l)=qsatbef  
-!calcul de vitesse
-           zw2(ig,l+1)=zw2(ig,l)*  &
-     &                 ((f_star(ig,l))**2)  &
-!  Tests de Catherine
-!     &                 /(f_star(ig,l+1)+detr_star(ig,l))**2+             &
-     &      /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-fact_epsilon))**2+ &
-     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-     &                 *fact_gamma &
-     &                 *(zlev(ig,l+1)-zlev(ig,l))
-!prise en compte des forces de pression que qd flottabilité<0
-!              zw2(ig,l+1)=zw2(ig,l)*  &
-!     &            1./(1.+2.*entr_star(ig,l)/f_star(ig,l)) + &        
-!     &                 (f_star(ig,l))**2 &
-!     &                 /(f_star(ig,l)+entr_star(ig,l))**2+ &
-!     &                 (f_star(ig,l)-2.*entr_star(ig,l))**2/(f_star(ig,l)+2.*entr_star(ig,l))**2+  &        
-!     &                 /(f_star(ig,l+1)+detr_star(ig,l)-entr_star(ig,l)*(1.-2.))**2+ &
-!     &                 /(f_star(ig,l)**2+2.*2.*detr_star(ig,l)*f_star(ig,l)+2.*entr_star(ig,l)*f_star(ig,l))+ &
-!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                 *1./3. &
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!          zw2(ig,l+1)=&
+!     &                 zw2(ig,l)*(1-fact_epsilon/(1.+fact_gamma)*2.*(zlev(ig,l+1)-zlev(ig,l))) &
+!     &                 +2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
+!     &                 *1./(1.+fact_gamma) &
 !     &                 *(zlev(ig,l+1)-zlev(ig,l))
-          
-!        write(30,*),l+1,zw2(ig,l+1)-zw2(ig,l), &
-!     &              -2.*entr_star(ig,l)/f_star(ig,l)*zw2(ig,l), &
-!     &               2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
-
- 
-!             zw2(ig,l+1)=zw2(ig,l)*  &
-!     &                 (2.-2.*entr_star(ig,l)/f_star(ig,l)) &  
-!     &                 -zw2(ig,l-1)+  &        
-!     &                 2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)  &
-!     &                 *1./3. &
-!     &                 *(zlev(ig,l+1)-zlev(ig,l))             
-
-            endif
-        endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! La meme en plus modulaire :
+           zbuoy=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+
+
+           zeps=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+
+if (1==0) then
+           zw2modif=zw2(ig,l)*(1-fact_epsilon/(1.+fact_gamma)*2.*zdz)
+           zdw2=2.*zbuoy/(1.+fact_gamma)*zdz
+           zw2(ig,l+1)=zw2modif+zdw2
+else
+           zdrag=fact_epsilon/(zalpha**expa)
+           zw2fact=zbuoy/zdrag*a1
+           zw2(ig,l+1)=(zw2(ig,l)-zw2fact)*exp(-2.*zdrag/(1+fact_gamma)*zdz) &
+      &    +zw2fact
+
+
+endif
+
+      endif
+   enddo
+
         if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
 !
+!---------------------------------------------------------------------------
 !initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
-
+!---------------------------------------------------------------------------
+
+   do ig=1,ngrid
             if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
 !               stop'On tombe sur le cas particulier de thermcell_dry'
@@ -753,5 +400,4 @@
             endif
 
-!        if ((zw2(ig,l).gt.0.).and. (zw2(ig,l+1).le.0.)) then
         if (zw2(ig,l+1).lt.0.) then 
            linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
@@ -771,32 +417,431 @@
             wmaxa(ig)=wa_moy(ig,l+1)
         endif
-        enddo
+   enddo
+
+!=========================================================================
+! FIN DE LA BOUCLE VERTICALE
       enddo
-
-!on remplace a* par e* ds premiere couche
-!      if (iflag_thermals_ed.ge.1) then
-!       do ig=1,ngrid
-!       do l=2,klev
-!          if (l.lt.lalim(ig)) then
-!             alim_star(ig,l)=entr_star(ig,l)
-!          endif
-!       enddo
-!       enddo
-!       do ig=1,ngrid
-!          lalim(ig)=lmix_bis(ig)
-!       enddo
-!      endif
-       if (iflag_thermals_ed.ge.1) then
-          do ig=1,ngrid
-             do l=2,lalim(ig)
-                alim_star(ig,l)=entr_star(ig,l)
-                entr_star(ig,l)=0.
-             enddo
-           enddo
-       endif
+!=========================================================================
+
+!on recalcule alim_star_tot
+       do ig=1,ngrid
+          alim_star_tot(ig)=0.
+       enddo
+       do ig=1,ngrid
+          do l=1,lalim(ig)-1
+          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+          enddo
+       enddo
+       
+
         if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
 
-!     print*,'thermcell_plume OK'
 
       return 
       end
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ SUBROUTINE thermcellV1_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz,  &
+&           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
+&           lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
+&           ztla,zqla,zqta,zha,zw2,w_est,ztva_est,zqsatth,lmix,lmix_bis,linter &
+&           ,lev_out,lunout1,igout)
+
+!--------------------------------------------------------------------------
+!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
+! Version conforme a l'article de Rio et al. 2010.
+! Code ecrit par Catherine Rio, Arnaud Jam et Frederic Hourdin
+!--------------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+#include "iniprint.h"
+#include "thermcell.h"
+
+      INTEGER itap
+      INTEGER lunout1,igout
+      INTEGER ngrid,klev
+      REAL ptimestep
+      REAL ztv(ngrid,klev)
+      REAL zthl(ngrid,klev)
+      REAL po(ngrid,klev)
+      REAL zl(ngrid,klev)
+      REAL rhobarz(ngrid,klev)
+      REAL zlev(ngrid,klev+1)
+      REAL pplev(ngrid,klev+1)
+      REAL pphi(ngrid,klev)
+      REAL zpspsk(ngrid,klev)
+      REAL alim_star(ngrid,klev)
+      REAL f0(ngrid)
+      INTEGER lalim(ngrid)
+      integer lev_out                           ! niveau pour les print
+    
+      real alim_star_tot(ngrid)
+
+      REAL ztva(ngrid,klev)
+      REAL ztla(ngrid,klev)
+      REAL zqla(ngrid,klev)
+      REAL zqta(ngrid,klev)
+      REAL zha(ngrid,klev)
+
+      REAL detr_star(ngrid,klev)
+      REAL coefc
+      REAL entr_star(ngrid,klev)
+      REAL detr(ngrid,klev)
+      REAL entr(ngrid,klev)
+
+      REAL csc(ngrid,klev)
+
+      REAL zw2(ngrid,klev+1)
+      REAL w_est(ngrid,klev+1)
+      REAL f_star(ngrid,klev+1)
+      REAL wa_moy(ngrid,klev+1)
+
+      REAL ztva_est(ngrid,klev)
+      REAL zqla_est(ngrid,klev)
+      REAL zqsatth(ngrid,klev)
+      REAL zta_est(ngrid,klev)
+      REAL ztemp(ngrid),zqsat(ngrid)
+      REAL zdw2
+      REAL zw2modif
+      REAL zw2fact
+      REAL zeps(ngrid,klev)
+
+      REAL linter(ngrid)
+      INTEGER lmix(ngrid)
+      INTEGER lmix_bis(ngrid)
+      REAL    wmaxa(ngrid)
+
+      INTEGER ig,l,k
+
+      real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m
+      real zbuoybis
+      real zcor,zdelta,zcvm5,qlbef,zdz2
+      real betalpha,zbetalpha
+      real eps, afact
+      REAL REPS,RLvCp,DDT0
+      PARAMETER (DDT0=.01)
+      logical Zsat
+      LOGICAL active(ngrid),activetmp(ngrid)
+      REAL fact_gamma,fact_epsilon,fact_gamma2,fact_epsilon2
+      REAL c2(ngrid,klev)
+      Zsat=.false.
+! Initialisation
+
+      RLvCp = RLVTT/RCPD
+      fact_epsilon=0.002
+      betalpha=0.9 
+      afact=2./3.            
+
+      zbetalpha=betalpha/(1.+betalpha)
+
+
+! Initialisations des variables reeles
+if (1==0) then
+      ztva(:,:)=ztv(:,:)
+      ztva_est(:,:)=ztva(:,:)
+      ztla(:,:)=zthl(:,:)
+      zqta(:,:)=po(:,:)
+      zha(:,:) = ztva(:,:)
+else
+      ztva(:,:)=0.
+      ztva_est(:,:)=0.
+      ztla(:,:)=0.
+      zqta(:,:)=0.
+      zha(:,:) =0.
+endif
+
+      zqla_est(:,:)=0.
+      zqsatth(:,:)=0.
+      zqla(:,:)=0.
+      detr_star(:,:)=0.
+      entr_star(:,:)=0.
+      alim_star(:,:)=0.
+      alim_star_tot(:)=0.
+      csc(:,:)=0.
+      detr(:,:)=0.
+      entr(:,:)=0.
+      zw2(:,:)=0.
+      zbuoy(:,:)=0.
+      gamma(:,:)=0.
+      zeps(:,:)=0.
+      w_est(:,:)=0.
+      f_star(:,:)=0.
+      wa_moy(:,:)=0.
+      linter(:)=1.
+!     linter(:)=1.
+! Initialisation des variables entieres
+      lmix(:)=1
+      lmix_bis(:)=2
+      wmaxa(:)=0.
+      lalim(:)=1
+
+
+!-------------------------------------------------------------------------
+! On ne considere comme actif que les colonnes dont les deux premieres
+! couches sont instables.
+!-------------------------------------------------------------------------
+      active(:)=ztv(:,1)>ztv(:,2)
+
+!-------------------------------------------------------------------------
+! Definition de l'alimentation a l'origine dans thermcell_init
+!-------------------------------------------------------------------------
+      do l=1,klev-1
+         do ig=1,ngrid
+            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
+               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
+     &                       *sqrt(zlev(ig,l+1)) 
+               lalim(ig)=l+1
+               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+            endif
+         enddo
+      enddo
+      do l=1,klev
+         do ig=1,ngrid 
+            if (alim_star_tot(ig) > 1.e-10 ) then
+               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
+            endif
+         enddo
+      enddo
+      alim_star_tot(:)=1.
+
+
+
+!------------------------------------------------------------------------------
+! Calcul dans la premiere couche
+! On decide dans cette version que le thermique n'est actif que si la premiere
+! couche est instable.
+! Pourrait etre change si on veut que le thermiques puisse se dÃ©clencher
+! dans une couche l>1
+!------------------------------------------------------------------------------
+do ig=1,ngrid
+! Le panache va prendre au debut les caracteristiques de l'air contenu
+! dans cette couche.
+    if (active(ig)) then
+    ztla(ig,1)=zthl(ig,1) 
+    zqta(ig,1)=po(ig,1)
+    zqla(ig,1)=zl(ig,1)
+!cr: attention, prise en compte de f*(1)=1
+    f_star(ig,2)=alim_star(ig,1)
+    zw2(ig,2)=2.*RG*(ztv(ig,1)-ztv(ig,2))/ztv(ig,2)  &
+&                     *(zlev(ig,2)-zlev(ig,1))  &
+&                     *0.4*pphi(ig,1)/(pphi(ig,2)-pphi(ig,1))
+    w_est(ig,2)=zw2(ig,2)
+    endif
+enddo
+!
+
+!==============================================================================
+!boucle de calcul de la vitesse verticale dans le thermique
+!==============================================================================
+do l=2,klev-1
+!==============================================================================
+
+
+! On decide si le thermique est encore actif ou non
+! AFaire : Il faut sans doute ajouter entr_star a alim_star dans ce test
+    do ig=1,ngrid
+       active(ig)=active(ig) &
+&                 .and. zw2(ig,l)>1.e-10 &
+&                 .and. f_star(ig,l)+alim_star(ig,l)>1.e-10
+    enddo
+
+
+
+!---------------------------------------------------------------------------
+! calcul des proprietes thermodynamiques et de la vitesse de la couche l
+! sans tenir compte du detrainement et de l'entrainement dans cette
+! couche
+! C'est a dire qu'on suppose 
+! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)
+! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer
+! avant) a l'alimentation pour avoir un calcul plus propre
+!---------------------------------------------------------------------------
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l-1)
+   call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat(:))
+
+    do ig=1,ngrid 
+!       print*,'active',active(ig),ig,l
+        if(active(ig)) then 
+        zqla_est(ig,l)=max(0.,zqta(ig,l-1)-zqsat(ig))
+        ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l)
+        zta_est(ig,l)=ztva_est(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
+        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
+     &      -zqla_est(ig,l))-zqla_est(ig,l))
+
+!------------------------------------------------
+!AJAM:nouveau calcul de w²  
+!------------------------------------------------
+              zdz=zlev(ig,l+1)-zlev(ig,l)
+              zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+
+              zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+              zdw2=(afact)*zbuoy(ig,l)/(fact_epsilon)
+              w_est(ig,l+1)=Max(0.0001,exp(-zw2fact)*(w_est(ig,l)-zdw2)+zdw2)
+ 
+
+             if (w_est(ig,l+1).lt.0.) then
+                w_est(ig,l+1)=zw2(ig,l)
+             endif
+       endif
+    enddo
+
+
+!-------------------------------------------------
+!calcul des taux d'entrainement et de detrainement
+!-------------------------------------------------
+
+     do ig=1,ngrid
+        if (active(ig)) then
+
+          zw2m=max(0.5*(w_est(ig,l)+w_est(ig,l+1)),0.1)
+          zw2m=w_est(ig,l+1)
+          zdz=zlev(ig,l+1)-zlev(ig,l)
+          zbuoy(ig,l)=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l)
+!          zbuoybis=zbuoy(ig,l)+RG*0.1/300.
+          zbuoybis=zbuoy(ig,l)
+          zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l+1))/rhobarz(ig,l)
+          zdqt(ig,l)=max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l)
+
+          
+          entr_star(ig,l)=f_star(ig,l)*zdz*  zbetalpha*MAX(0.,  &
+    &     afact*zbuoybis/zw2m - fact_epsilon )
+
+
+          detr_star(ig,l)=f_star(ig,l)*zdz                        &
+    &     *MAX(1.e-3, -afact*zbetalpha*zbuoy(ig,l)/zw2m          &
+    &     + 0.012*(zdqt(ig,l)/zw2m)**0.5 )
+          
+! En dessous de lalim, on prend le max de alim_star et entr_star pour
+! alim_star et 0 sinon
+        if (l.lt.lalim(ig)) then
+          alim_star(ig,l)=max(alim_star(ig,l),entr_star(ig,l))
+          entr_star(ig,l)=0.
+        endif
+
+! Calcul du flux montant normalise
+      f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l)  &
+     &              -detr_star(ig,l)
+
+      endif
+   enddo
+
+
+!----------------------------------------------------------------------------
+!calcul de la vitesse verticale en melangeant Tl et qt du thermique
+!---------------------------------------------------------------------------
+   activetmp(:)=active(:) .and. f_star(:,l+1)>1.e-10
+   do ig=1,ngrid
+       if (activetmp(ig)) then 
+           Zsat=.false.
+           ztla(ig,l)=(f_star(ig,l)*ztla(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*zthl(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+           zqta(ig,l)=(f_star(ig,l)*zqta(ig,l-1)+  &
+     &            (alim_star(ig,l)+entr_star(ig,l))*po(ig,l))  &
+     &            /(f_star(ig,l+1)+detr_star(ig,l))
+
+        endif
+    enddo
+
+   ztemp(:)=zpspsk(:,l)*ztla(:,l)
+   call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l))
+
+   do ig=1,ngrid
+      if (activetmp(ig)) then
+        if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l
+! on ecrit de maniere conservative (sat ou non)
+!          T = Tl +Lv/Cp ql
+           zqla(ig,l)=max(0.,zqta(ig,l)-zqsatth(ig,l))
+           ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l)
+           ztva(ig,l) = ztva(ig,l)/zpspsk(ig,l)
+!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
+           zha(ig,l) = ztva(ig,l)
+           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
+     &              -zqla(ig,l))-zqla(ig,l))
+           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+           zdz=zlev(ig,l+1)-zlev(ig,l)
+           zeps(ig,l)=(entr_star(ig,l)+alim_star(ig,l))/(f_star(ig,l)*zdz)
+
+            zw2fact=fact_epsilon*2.*zdz/(1.+betalpha)
+            zdw2=afact*zbuoy(ig,l)/(fact_epsilon)
+            zw2(ig,l+1)=Max(0.0001,exp(-zw2fact)*(zw2(ig,l)-zdw2)+zdw2) 
+      endif
+   enddo
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 460: ig, l',ig, l
+!
+!---------------------------------------------------------------------------
+!initialisations pour le calcul de la hauteur du thermique, de l'inversion et de la vitesse verticale max 
+!---------------------------------------------------------------------------
+
+   do ig=1,ngrid
+            if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then
+!               stop'On tombe sur le cas particulier de thermcell_dry'
+                print*,'On tombe sur le cas particulier de thermcell_plume'
+                zw2(ig,l+1)=0.
+                linter(ig)=l+1
+            endif
+
+        if (zw2(ig,l+1).lt.0.) then 
+           linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))  &
+     &               -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+           zw2(ig,l+1)=0.
+        endif
+
+           wa_moy(ig,l+1)=sqrt(zw2(ig,l+1)) 
+
+        if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+!   lmix est le niveau de la couche ou w (wa_moy) est maximum
+!on rajoute le calcul de lmix_bis
+            if (zqla(ig,l).lt.1.e-10) then
+               lmix_bis(ig)=l+1
+            endif
+            lmix(ig)=l+1
+            wmaxa(ig)=wa_moy(ig,l+1)
+        endif
+   enddo
+
+!=========================================================================
+! FIN DE LA BOUCLE VERTICALE
+      enddo
+!=========================================================================
+
+!on recalcule alim_star_tot
+       do ig=1,ngrid
+          alim_star_tot(ig)=0.
+       enddo
+       do ig=1,ngrid
+          do l=1,lalim(ig)-1
+          alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
+          enddo
+       enddo
+       
+
+        if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l
+
+#undef wrgrads_thermcell
+#ifdef wrgrads_thermcell
+         call wrgradsfi(1,klev,entr_star(igout,1:klev),'esta      ','esta      ')
+         call wrgradsfi(1,klev,detr_star(igout,1:klev),'dsta      ','dsta      ')
+         call wrgradsfi(1,klev,zbuoy(igout,1:klev),'buoy      ','buoy      ')
+         call wrgradsfi(1,klev,zdqt(igout,1:klev),'dqt      ','dqt      ')
+         call wrgradsfi(1,klev,w_est(igout,1:klev),'w_est     ','w_est     ')
+         call wrgradsfi(1,klev,w_est(igout,2:klev+1),'w_es2     ','w_es2     ')
+         call wrgradsfi(1,klev,zw2(igout,1:klev),'zw2A      ','zw2A      ')
+#endif
+
+
+     return 
+     end
+
Index: /LMDZ4/trunk/libf/phylmd/thermcell_qsat.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/thermcell_qsat.F90	(revision 1403)
+++ /LMDZ4/trunk/libf/phylmd/thermcell_qsat.F90	(revision 1403)
@@ -0,0 +1,92 @@
+subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
+implicit none
+
+#include "YOMCST.h"
+#include "YOETHF.h"
+#include "FCTTRE.h"
+
+
+!====================================================================
+! DECLARATIONS
+!====================================================================
+
+! Arguments
+INTEGER klon
+REAL zpspsk(klon),pplev(klon)
+REAL ztemp(klon),zqta(klon),zqsat(klon)
+LOGICAL active(klon)
+
+! Variables locales
+INTEGER ig,iter
+REAL Tbef(klon),DT(klon)
+REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
+logical Zsat
+REAL RLvCp
+REAL, SAVE :: DDT0=.01
+LOGICAL afaire(klon),tout_converge
+
+!====================================================================
+! INITIALISATIONS
+!====================================================================
+
+RLvCp = RLVTT/RCPD
+tout_converge=.false.
+afaire(:)=.false.
+DT(:)=0.
+
+
+!====================================================================
+! Routine a vectoriser en copiant active dans converge et en mettant
+! la boucle sur les iterations a l'exterieur est en mettant
+! converge= false des que la convergence est atteinte.
+!====================================================================
+
+do ig=1,klon
+   if (active(ig)) then
+               Tbef(ig)=ztemp(ig)
+               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+               qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+               qsatbef=MIN(0.5,qsatbef)
+               zcor=1./(1.-retv*qsatbef)
+               qsatbef=qsatbef*zcor
+               qlbef=max(0.,zqta(ig)-qsatbef)
+               DT(ig) = 0.5*RLvCp*qlbef
+               zqsat(ig)=qsatbef
+     endif
+enddo
+
+! Traitement du cas ou il y a condensation mais faible
+! On ne condense pas mais on dit que le qsat est le qta
+do ig=1,klon
+   if (active(ig)) then
+      if (0.<abs(DT(ig)).and.abs(DT(ig))<=DDT0) then
+         zqsat(ig)=zqta(ig)
+      endif
+   endif
+enddo
+
+do iter=1,10
+    afaire(:)=abs(DT(:)).gt.DDT0
+    do ig=1,klon
+               if (afaire(ig)) then
+                 Tbef(ig)=Tbef(ig)+DT(ig)
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig)
+                 qsatbef=MIN(0.5,qsatbef)
+                 zcor=1./(1.-retv*qsatbef)
+                 qsatbef=qsatbef*zcor
+                 qlbef=zqta(ig)-qsatbef
+                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig)))
+                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
+                 zcor=1./(1.-retv*qsatbef)
+                 dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor)
+                 num=-Tbef(ig)+ztemp(ig)+RLvCp*qlbef
+                 denom=1.+RLvCp*dqsat_dT
+                 zqsat(ig) = qsatbef
+                 DT(ig)=num/denom
+               endif
+    enddo
+enddo
+
+return
+end
Index: /LMDZ4/trunk/libf/phylmd/tracinca_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/tracinca_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/tracinca_mod.F90	(revision 1403)
@@ -45,9 +45,10 @@
     USE vampir
     USE comgeomphy
+    USE control_mod
+
     
     IMPLICIT NONE
     
     INCLUDE "indicesol.h"
-    INCLUDE "control.h"
     INCLUDE "dimensions.h"
     INCLUDE "paramet.h"
@@ -125,5 +126,5 @@
     CALL VTb(VTinca)
     
-    calday = FLOAT(julien) + gmtime
+    calday = REAL(julien) + gmtime
     ncsec  = NINT (86400.*gmtime)
      
Index: /LMDZ4/trunk/libf/phylmd/traclmdz_mod.F90
===================================================================
--- /LMDZ4/trunk/libf/phylmd/traclmdz_mod.F90	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/traclmdz_mod.F90	(revision 1403)
@@ -6,4 +6,6 @@
 ! only if running without any other chemestry model as INCA or REPROBUS.  
 !
+
+  IMPLICIT NONE
 
   REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: masktr   ! Masque reservoir de sol traceur
@@ -35,4 +37,18 @@
 !$OMP THREADPRIVATE(id_be)
 
+!IM ajout traceurs RR 
+  INTEGER,SAVE :: id_dry !traceur dry intrusions
+!$OMP THREADPRIVATE(id_dry)
+  INTEGER,SAVE :: id_pcsat, id_pcocsat, id_pcq ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
+!$OMP THREADPRIVATE(id_pcsat, id_pcocsat, id_pcq)
+  INTEGER,SAVE :: id_pcs0, id_pcos0, id_pcq0 ! traceurs pseudo-vapeur CL qsat, qsat_oc, q
+!                                            ! qui ne sont pas transportes par la convection
+!$OMP THREADPRIVATE(id_pcs0, id_pcos0, id_pcq0)
+
+  INTEGER, SAVE:: id_o3
+  !$OMP THREADPRIVATE(id_o3)
+  ! index of ozone tracer with Cariolle parameterization
+  ! 0 means no ozone tracer
+
   LOGICAL,SAVE :: rnpb=.TRUE. ! Presence du couple Rn222, Pb210
 !$OMP THREADPRIVATE(rnpb)
@@ -47,5 +63,4 @@
     USE dimphy
     USE infotrac
-    IMPLICIT NONE
     
     ! Input argument
@@ -65,11 +80,11 @@
 
 
-  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, aerosol, lessivage)
+  SUBROUTINE traclmdz_init(pctsrf, ftsol, tr_seri, t_seri, pplay, sh, aerosol, lessivage)
     ! This subroutine allocates and initialize module variables and control variables.
     USE dimphy
     USE infotrac
+    USE regr_pr_comb_coefoz_m, ONLY: alloc_coefoz
+    USE press_coefoz_m, ONLY: press_coefoz
     USE carbon_cycle_mod, ONLY : carbon_cycle_init, carbon_cycle_tr, carbon_cycle_cpl
-
-    IMPLICIT NONE
 
     INCLUDE "indicesol.h"
@@ -78,5 +93,9 @@
     REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: pctsrf ! Pourcentage de sol f(nature du sol)
     REAL,DIMENSION(klon,nbsrf),INTENT(IN)     :: ftsol  ! Temperature du sol (surf)(Kelvin)
-    REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri! Concentration Traceur [U/KgA]  
+!IM traceurs RR   REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri! Concentration Traceur [U/KgA]  
+    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri! Concentration Traceur [U/KgA]  
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
 
 ! Output variables
@@ -85,5 +104,6 @@
         
 ! Local variables    
-    INTEGER :: ierr, it, iiq
+    INTEGER :: ierr, it, iiq, i, k
+    REAL,DIMENSION(klon,klev)      :: qsat   ! pression de la vapeur a saturation
     
 ! --------------------------------------------
@@ -121,7 +141,8 @@
     
 !
-! Recherche des traceurs connus : Be7, CO2,...
+! Recherche des traceurs connus : Be7, O3, CO2,...
 ! --------------------------------------------
     id_be=0
+    id_o3=0
     DO it=1,nbtr
        iiq=niadv(it+2)
@@ -135,6 +156,69 @@
           CALL init_be(pctsrf,masktr(:,id_be),tautr(id_be),vdeptr(id_be),scavtr(id_be),srcbe)
           WRITE(*,*) 'Initialisation srcBe: OK'
+       ELSE IF (tname(iiq)=="O3" .OR. tname(iiq)=="o3") THEN
+          ! Recherche de l'ozone : parametrization de la chimie par Cariolle
+          id_o3=it
+          CALL alloc_coefoz   ! allocate ozone coefficients
+          CALL press_coefoz   ! read input pressure levels
        END IF    
     END DO
+
+    id_dry=0
+
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "dry" .OR. tname(iiq) == "Dry" ) THEN
+        id_dry=it
+       END IF    
+    END DO  
+
+    id_pcsat=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcsat" .OR. tname(iiq) == "Pcsat" ) THEN
+        id_pcsat=it
+      END IF
+    END DO
+
+    id_pcocsat=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcocsat" .OR. tname(iiq) == "Pcocsat" ) THEN
+        id_pcocsat=it
+       END IF
+    END DO
+
+    id_pcq=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcq" .OR. tname(iiq) == "Pcq" ) THEN
+        id_pcq=it
+       END IF
+    END DO
+
+    id_pcs0=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcs0" .OR. tname(iiq) == "Pcs0" ) THEN
+        id_pcs0=it
+      END IF
+    END DO
+
+    id_pcos0=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcos0" .OR. tname(iiq) == "Pcos0" ) THEN
+        id_pcos0=it
+       END IF
+    END DO
+
+    id_pcq0=0
+    DO it=1,nbtr
+       iiq=niadv(it+2)
+       IF ( tname(iiq) == "pcq0" .OR. tname(iiq) == "Pcq0" ) THEN
+        id_pcq0=it
+       END IF
+    END DO
+
 !
 ! Valeurs specifiques pour les traceurs Rn222 et Pb210
@@ -159,19 +243,93 @@
     END IF
 
+!IM initialisation traceurs pseudo-vapeurs
+    call q_sat(klon*klev,t_seri,pplay,qsat)
+    IF ( id_pcsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcsat) = qsat(i,k)
+       ELSE
+        tr_seri(i,k,id_pcsat) = 100.
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcocsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        IF ( pctsrf (i, is_oce) > 0. ) THEN
+         tr_seri(i,k,id_pcocsat) = qsat(i,k)
+        ELSE
+         tr_seri(i,k,id_pcocsat) = 100.
+        END IF
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcq) = sh(i,k)
+       ELSE
+        tr_seri(i,k,id_pcq) = 100.
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcs0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcs0) = qsat(i,k)
+       ELSE
+        tr_seri(i,k,id_pcs0) = 100.
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcos0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        IF ( pctsrf (i, is_oce) > 0. ) THEN
+         tr_seri(i,k,id_pcos0) = qsat(i,k)
+        ELSE
+         tr_seri(i,k,id_pcos0) = 100.
+        END IF
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcq0) = sh(i,k)
+       ELSE
+        tr_seri(i,k,id_pcq0) = 100.
+       END IF
+      END DO
+     END DO
+    END IF
+ 
   END SUBROUTINE traclmdz_init
 
-  SUBROUTINE traclmdz(                           &
-       nstep,    pdtphys,      t_seri,           &
-       paprs,    pplay,        cdragh,  coefh,   &
-       yu1,      yv1,          ftsol,   pctsrf,  &
-       xlat,     couchelimite,                   &
-       tr_seri,  source,       solsym,  d_tr_cl)
+  SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
+       cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
+       tr_seri, source, solsym, d_tr_cl, zmasse)
     
     USE dimphy
     USE infotrac
+    USE regr_pr_comb_coefoz_m, ONLY: regr_pr_comb_coefoz
+    USE o3_chem_m, ONLY: o3_chem
     USE carbon_cycle_mod, ONLY : carbon_cycle, carbon_cycle_tr, carbon_cycle_cpl
-    
-    IMPLICIT NONE
-    
     INCLUDE "YOMCST.h"
     INCLUDE "indicesol.h"
@@ -185,6 +343,9 @@
 !Configuration grille,temps:
     INTEGER,INTENT(IN) :: nstep      ! nombre d'appels de la physiq
+    INTEGER,INTENT(IN) :: julien     ! Jour julien
+    REAL,INTENT(IN)    :: gmtime
     REAL,INTENT(IN)    :: pdtphys    ! Pas d'integration pour la physique (seconde)  
     REAL,DIMENSION(klon),INTENT(IN) :: xlat    ! latitudes pour chaque point 
+    REAL, INTENT(IN):: xlon(:) ! dim(klon) longitude
 
 !
@@ -194,4 +355,5 @@
     REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
     REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
+    REAL,intent(in):: zmasse (:, :)   ! dim(klon,klev) density of air, in kg/m2
 
 
@@ -204,4 +366,6 @@
     REAL,DIMENSION(klon),INTENT(IN)      :: yv1        ! vents au premier niveau
     LOGICAL,INTENT(IN)                   :: couchelimite
+!IM traceurs RR
+    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
 
 ! Arguments necessaires pour les sources et puits de traceur:
@@ -223,12 +387,13 @@
 
     INTEGER :: i, k, it
+    INTEGER lmt_pas ! number of time steps of "physics" per day
 
     REAL,DIMENSION(klon)           :: d_trs    ! Td dans le reservoir
-    REAL,DIMENSION(klon,klev)      :: delp     ! epaisseur de couche (Pa)
-    
     REAL,DIMENSION(klon,klev,nbtr) :: d_tr_dec ! Td radioactive
     REAL                           :: zrho      ! Masse Volumique de l'air KgA/m3
 
-!
+!IM traceurs RR
+    REAL,DIMENSION(klon,klev)      :: qsat   ! pression de la vapeur a saturation
+    REAL :: amn, amx
 !
 !=================================================================
@@ -245,4 +410,70 @@
     END IF
   
+!IM ajout traceurs RR
+    call q_sat(klon*klev,t_seri,pplay,qsat)
+    
+    IF ( id_pcsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcsat) = qsat(i,k)
+       END IF
+      END DO 
+     END DO
+    END IF
+
+    IF ( id_pcocsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        IF ( pctsrf (i, is_oce) > 0. ) THEN
+         tr_seri(i,k,id_pcocsat) = qsat(i,k)
+        END IF
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcq) = sh(i,k)
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcs0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcs0) = qsat(i,k)
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcos0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        IF ( pctsrf (i, is_oce) > 0. ) THEN
+         tr_seri(i,k,id_pcos0) = qsat(i,k)
+        END IF
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).GE.85000.) THEN
+        tr_seri(i,k,id_pcq0) = sh(i,k)
+       END IF
+      END DO
+     END DO
+    END IF
 
     DO it=1,nbtr
@@ -265,11 +496,4 @@
     END IF
     
-
-    DO k = 1, klev
-       DO i = 1, klon
-          delp(i,k) = paprs(i,k)-paprs(i,k+1)
-       END DO
-    END DO
-    
     DO it=1, nbtr
        IF (couchelimite .AND. pbl_flg(it) == 0 ) THEN ! couche limite avec quantite dans le sol calculee
@@ -277,5 +501,5 @@
                cdragh, coefh,t_seri,ftsol,pctsrf,  &
                tr_seri(:,:,it),trs(:,it),          &
-               paprs, pplay, delp,                 &
+               paprs, pplay, zmasse * rg, &
                masktr(:,it),fshtr(:,it),hsoltr(it),&
                tautr(it),vdeptr(it),               &
@@ -294,5 +518,65 @@
        END IF
     END DO
-           
+          
+!IM traceurs RR
+    IF ( id_pcsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcsat))
+       END IF 
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcocsat /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcocsat) = MIN (qsat(i,k), tr_seri(i,k,id_pcocsat))
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq /= 0 ) THEN
+     DO k = 1, klev 
+      DO i = 1, klon 
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcq) = MIN (qsat(i,k), tr_seri(i,k,id_pcq))
+       END IF
+      END DO  
+     END DO  
+    END IF  
+
+    IF ( id_pcs0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcs0) = MIN (qsat(i,k), tr_seri(i,k,id_pcs0))
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcos0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcos0) = MIN (qsat(i,k), tr_seri(i,k,id_pcos0))
+       END IF
+      END DO
+     END DO
+    END IF
+
+    IF ( id_pcq0 /= 0 ) THEN
+     DO k = 1, klev
+      DO i = 1, klon
+       IF ( pplay(i,k).LT.85000.) THEN
+        tr_seri(i,k,id_pcq0) = MIN (qsat(i,k), tr_seri(i,k,id_pcq0))
+       END IF
+      END DO
+     END DO
+    END IF
 !======================================================================
 !   Calcul de l'effet du puits radioactif
@@ -312,4 +596,18 @@
 
 !======================================================================
+!   Parameterization of ozone chemistry
+!======================================================================
+
+    IF (id_o3 /= 0) then
+       lmt_pas = NINT(86400./pdtphys)
+       IF (MOD(nstep - 1, lmt_pas) == 0) THEN
+          ! Once per day, update the coefficients for ozone chemistry:
+          CALL regr_pr_comb_coefoz(julien, xlat, paprs, pplay)
+       END IF
+       CALL o3_chem(julien, gmtime, t_seri, zmasse, pdtphys, xlat, &
+            xlon, tr_seri(:, :, id_o3))
+    END IF
+
+!======================================================================
 !   Calcul de cycle de carbon
 !======================================================================
@@ -327,6 +625,4 @@
     USE infotrac
     
-    IMPLICIT NONE
-    
     REAL,DIMENSION(klon,nbtr), INTENT(OUT) :: trs_out
     INTEGER :: ierr
Index: /LMDZ4/trunk/libf/phylmd/undefSTD.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/undefSTD.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/undefSTD.F	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE undefSTD(itap,freq_calNMC)
Index: /LMDZ4/trunk/libf/phylmd/wake.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/wake.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/wake.F	(revision 1403)
@@ -1,3 +1,6 @@
-      Subroutine WAKE (p,ph,ppi,dtime,sigd_con
+!
+! $Id$
+!
+      Subroutine WAKE (p,ph,pi,dtime,sigd_con
      :                ,te0,qe0,omgb
      :                ,dtdwn,dqdwn,amdwn,amup,dta,dqa
@@ -24,4 +27,1830 @@
 c
       use dimphy
+      IMPLICIT none
+c============================================================================
+C
+C
+C   But : Decrire le comportement des poches froides apparaissant dans les
+C        grands systemes convectifs, et fournir l'energie disponible pour
+C        le declenchement de nouvelles colonnes convectives.
+C
+C   Variables d'etat : deltatw    : ecart de temperature wake-undisturbed area
+C                      deltaqw    : ecart d'humidite wake-undisturbed area
+C                      sigmaw     : fraction d'aire occupee par la poche.
+C
+C   Variable de sortie : 
+c
+c			 wape : WAke Potential Energy
+c                        fip  : Front Incident Power (W/m2) - ALP
+c                        gfl  : Gust Front Length per unit area (m-1)
+C                        dtls : large scale temperature tendency due to wake
+C                        dqls : large scale humidity tendency due to wake
+C                        hw   : hauteur de la poche
+C                     dp_omgb : vertical gradient of large scale omega
+C                     wdens   : densite de poches
+C                      omgbdth: flux of Delta_Theta transported by LS omega
+C                      dtKE   : differential heating (wake - unpertubed)
+C                      dqKE   : differential moistening (wake - unpertubed)
+C                      omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
+C                 dp_deltomg  : vertical gradient of omg (s-1)
+C                     spread  : spreading term in dt_wake and dq_wake
+C                 deltatw     : updated temperature difference (T_w-T_u).
+C                 deltaqw     : updated humidity difference (q_w-q_u).
+C                 sigmaw      : updated wake fractional area.
+C                 d_deltat_gw : delta T tendency due to GW
+c
+C   Variables d'entree : 
+c
+c		         aire : aire de la maille
+c			 te0  : temperature dans l'environnement  (K)
+C                        qe0  : humidite dans l'environnement     (kg/kg)
+C                        omgb : vitesse verticale moyenne sur la maille (Pa/s)
+C                        dtdwn: source de chaleur due aux descentes (K/s)
+C                        dqdwn: source d'humidite due aux descentes (kg/kg/s)
+C			 dta  : source de chaleur due courants satures et detrain  (K/s)
+C			 dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
+C                        amdwn: flux de masse total des descentes, par unite de
+C                                surface de la maille (kg/m2/s)
+C                        amup : flux de masse total des ascendances, par unite de
+C                                surface de la maille (kg/m2/s)
+C                        p    : pressions aux milieux des couches (Pa)
+C                        ph   : pressions aux interfaces (Pa)
+C                        pi  : (p/p_0)**kapa (adim)
+C                        dtime: increment temporel (s)
+c
+C   Variables internes :
+c
+c			 rhow : masse volumique de la poche froide
+C                        rho  : environment density at P levels
+C                        rhoh : environment density at Ph levels
+C                        te   : environment temperature | may change within
+C                        qe   : environment humidity    | sub-time-stepping
+C                        the  : environment potential temperature
+C                        thu  : potential temperature in undisturbed area
+C                        tu   :  temperature  in undisturbed area
+C                        qu   : humidity in undisturbed area
+C                      dp_omgb: vertical gradient og LS omega
+C                      omgbw  : wake average vertical omega
+C                     dp_omgbw: vertical gradient of omgbw
+C                      omgbdq : flux of Delta_q transported by LS omega
+C                        dth  : potential temperature diff. wake-undist.
+C                        th1  : first pot. temp. for vertical advection (=thu)
+C                        th2  : second pot. temp. for vertical advection (=thw)
+C                        q1   : first humidity for vertical advection
+C                        q2   : second humidity for vertical advection
+C                     d_deltatw   : terme de redistribution pour deltatw
+C                     d_deltaqw   : terme de redistribution pour deltaqw
+C                      deltatw0   : deltatw initial
+C                      deltaqw0   : deltaqw initial
+C                      hw0    : hw initial
+C                      sigmaw0: sigmaw initial
+C                      amflux : horizontal mass flux through wake boundary
+C                      wdens_ref: initial number of wakes per unit area (3D) or per
+C                               unit length (2D), at the beginning of each time step
+C                      Tgw    : 1 sur la période de onde de gravité
+c                      Cgw    : vitesse de propagation de onde de gravité
+c                      LL     : distance entre 2 poches
+
+c-------------------------------------------------------------------------
+c          Déclaration de variables
+c-------------------------------------------------------------------------
+
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "cvthermo.h"
+#include "iniprint.h"
+
+c Arguments en entree
+c--------------------
+
+      REAL, dimension(klon,klev) :: p, pi
+      REAL, dimension(klon,klev+1) :: ph, omgb
+      REAL dtime
+      REAL, dimension(klon,klev) :: te0,qe0
+      REAL, dimension(klon,klev) :: dtdwn, dqdwn
+      REAL, dimension(klon,klev) :: wdtPBL,wdqPBL
+      REAL, dimension(klon,klev) :: udtPBL,udqPBL
+      REAL, dimension(klon,klev) :: amdwn, amup
+      REAL, dimension(klon,klev) :: dta, dqa
+      REAL, dimension(klon) :: sigd_con
+
+c Sorties
+c--------
+
+      REAL, dimension(klon,klev) :: deltatw, deltaqw, dth
+      REAL, dimension(klon,klev) :: tu, qu
+      REAL, dimension(klon,klev) :: dtls, dqls
+      REAL, dimension(klon,klev) :: dtKE, dqKE
+      REAL, dimension(klon,klev) :: dtPBL, dqPBL
+      REAL, dimension(klon,klev) :: spread
+      REAL, dimension(klon,klev) :: d_deltatgw
+      REAL, dimension(klon,klev) :: d_deltatw2, d_deltaqw2
+      REAL, dimension(klon,klev+1) :: omgbdth, omg
+      REAL, dimension(klon,klev) :: dp_omgb, dp_deltomg
+      REAL, dimension(klon,klev) :: d_deltat_gw
+      REAL, dimension(klon) :: hw, sigmaw, wape, fip, gfl, Cstar
+      REAL, dimension(klon) :: wdens
+      INTEGER, dimension(klon) :: ktopw
+
+c Variables internes
+c-------------------
+
+c Variables à fixer
+      REAL ALON
+      REAL coefgw
+      REAL :: wdens_ref
+      REAL stark
+      REAL alpk
+      REAL delta_t_min
+      INTEGER nsub
+      REAL dtimesub
+      REAL sigmad, hwmin,wapecut
+      REAL :: sigmaw_max
+      REAL :: dens_rate
+      REAL wdens0
+cIM 080208
+      LOGICAL, dimension(klon) :: gwake
+
+c Variables de sauvegarde
+      REAL, dimension(klon,klev) :: deltatw0
+      REAL, dimension(klon,klev) :: deltaqw0
+      REAL, dimension(klon,klev) :: te, qe
+      REAL, dimension(klon) :: sigmaw0, sigmaw1
+
+c Variables pour les GW
+      REAL, DIMENSION(klon) :: LL
+      REAL, dimension(klon,klev) :: N2
+      REAL, dimension(klon,klev) :: Cgw
+      REAL, dimension(klon,klev) :: Tgw
+
+c Variables liées au calcul de hw
+      REAL, DIMENSION(klon) :: ptop_provis, ptop, ptop_new
+      REAL, DIMENSION(klon) :: sum_dth
+      REAL, DIMENSION(klon) :: dthmin
+      REAL, DIMENSION(klon) :: z, dz, hw0
+      INTEGER, DIMENSION(klon) :: ktop, kupper
+
+c Sub-timestep tendencies and related variables
+       REAL d_deltatw(klon,klev),d_deltaqw(klon,klev)
+       REAL d_te(klon,klev),d_qe(klon,klev)
+       REAL d_sigmaw(klon),alpha(klon)
+       REAL q0_min(klon),q1_min(klon)
+       LOGICAL wk_adv(klon), OK_qx_qw(klon)
+       REAL epsilon
+       DATA epsilon/1.e-15/
+
+c Autres variables internes
+      INTEGER isubstep, k, i
+
+      REAL, DIMENSION(klon) :: sum_thu, sum_tu, sum_qu,sum_thvu
+      REAL, DIMENSION(klon) :: sum_dq, sum_rho
+      REAL, DIMENSION(klon) :: sum_dtdwn, sum_dqdwn
+      REAL, DIMENSION(klon) :: av_thu, av_tu, av_qu, av_thvu
+      REAL, DIMENSION(klon) :: av_dth, av_dq, av_rho
+      REAL, DIMENSION(klon) :: av_dtdwn, av_dqdwn
+
+      REAL, DIMENSION(klon,klev) :: rho, rhow
+      REAL, DIMENSION(klon,klev+1) :: rhoh
+      REAL, DIMENSION(klon,klev) :: rhow_moyen
+      REAL, DIMENSION(klon,klev) :: zh
+      REAL, DIMENSION(klon,klev+1) :: zhh
+      REAL, DIMENSION(klon,klev) :: epaisseur1, epaisseur2
+
+      REAL, DIMENSION(klon,klev) :: the, thu
+
+!      REAL, DIMENSION(klon,klev) :: d_deltatw, d_deltaqw
+
+      REAL, DIMENSION(klon,klev+1) :: omgbw
+      REAL, DIMENSION(klon) :: pupper
+      REAL, DIMENSION(klon) :: omgtop
+      REAL, DIMENSION(klon,klev) :: dp_omgbw
+      REAL, DIMENSION(klon) :: ztop, dztop
+      REAL, DIMENSION(klon,klev) :: alpha_up
+      
+      REAL, dimension(klon) :: RRe1, RRe2
+      REAL :: RRd1, RRd2
+      REAL, DIMENSION(klon,klev) :: Th1, Th2, q1, q2
+      REAL, DIMENSION(klon,klev) :: D_Th1, D_Th2, D_dth
+      REAL, DIMENSION(klon,klev) :: D_q1, D_q2, D_dq
+      REAL, DIMENSION(klon,klev) :: omgbdq
+
+      REAL, dimension(klon) :: ff, gg
+      REAL, dimension(klon) :: wape2, Cstar2, heff
+
+      REAL, DIMENSION(klon,klev) :: Crep
+      REAL Crep_upper, Crep_sol
+
+      REAL, DIMENSION(klon,klev) :: ppi
+
+ccc nrlmd
+      real, dimension(klon) :: death_rate,nat_rate
+      real, dimension(klon,klev) :: entr
+      real, dimension(klon,klev) :: detr
+
+C-------------------------------------------------------------------------
+c         Initialisations
+c-------------------------------------------------------------------------
+
+c      print*, 'wake initialisations'
+
+c   Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
+c-------------------------------------------------------------------------
+
+      DATA wapecut,sigmad, hwmin /5.,.02,10./
+ccc nrlmd
+      DATA sigmaw_max /0.4/
+      DATA dens_rate /0.1/
+ccc
+C Longueur de maille (en m)
+c-------------------------------------------------------------------------
+
+c      ALON = 3.e5
+      ALON = 1.e6
+
+
+C Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
+c
+c      coefgw : Coefficient pour les ondes de gravité
+c       stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
+c       wdens : Densité de poche froide par maille
+c-------------------------------------------------------------------------
+
+ccc nrlmd      coefgw=10
+c      coefgw=1
+c      wdens0 = 1.0/(alon**2)
+ccc nrlmd      wdens = 1.0/(alon**2)
+ccc nrlmd      stark = 0.50
+cCRtest
+ccc nrlmd      alpk=0.1
+c      alpk = 1.0
+c      alpk = 0.5
+c      alpk = 0.05
+c
+       stark  = 0.33
+       Alpk   = 0.25
+       wdens_ref  = 8.e-12
+       coefgw = 4.
+      Crep_upper=0.9
+      Crep_sol=1.0
+
+ccc nrlmd Lecture du fichier wake_param.data
+      OPEN(99,file='wake_param.data',status='old',
+     $          form='formatted',err=9999)
+      READ(99,*,end=9998) stark
+      READ(99,*,end=9998) Alpk
+      READ(99,*,end=9998) wdens_ref
+      READ(99,*,end=9998) coefgw
+9998  Continue
+      CLOSE(99)
+9999  Continue
+c
+c   Initialisation de toutes des densites a wdens_ref.
+c   Les densites peuvent evoluer si les poches debordent
+c   (voir au tout debut de la boucle sur les substeps)
+      wdens = wdens_ref
+c
+c      print*,'stark',stark
+c      print*,'alpk',alpk
+c      print*,'wdens',wdens
+c      print*,'coefgw',coefgw
+ccc
+C Minimum value for |T_wake - T_undist|. Used for wake top definition
+c-------------------------------------------------------------------------
+
+      delta_t_min = 0.2
+
+C 1. - Save initial values and initialize tendencies
+C --------------------------------------------------
+
+      DO k=1,klev
+      DO i=1, klon
+        ppi(i,k)=pi(i,k)
+	deltatw0(i,k) = deltatw(i,k)
+	deltaqw0(i,k)= deltaqw(i,k)
+	te(i,k) = te0(i,k)
+	qe(i,k) = qe0(i,k)
+	dtls(i,k) = 0.
+	dqls(i,k) = 0.
+        d_deltat_gw(i,k)=0.
+        d_te(i,k) = 0.
+        d_qe(i,k) = 0.
+        d_deltatw(i,k) = 0.
+        d_deltaqw(i,k) = 0.
+!IM 060508 beg
+        d_deltatw2(i,k)=0.
+        d_deltaqw2(i,k)=0.
+!IM 060508 end
+      ENDDO
+      ENDDO
+c      sigmaw1=sigmaw
+c      IF (sigd_con.GT.sigmaw1) THEN
+c      print*, 'sigmaw,sigd_con', sigmaw, sigd_con
+c      ENDIF
+      DO i=1, klon
+cc      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
+      sigmaw(i) = amax1(sigmaw(i),sigmad)
+      sigmaw(i) = amin1(sigmaw(i),0.99)
+      sigmaw0(i) = sigmaw(i)
+      wape(i) = 0.
+      wape2(i) = 0.
+      d_sigmaw(i) = 0.
+      ktopw(i) = 0
+      ENDDO
+C
+C
+C 2. - Prognostic part
+C --------------------
+C
+C
+C 2.1 - Undisturbed area and Wake integrals
+C ---------------------------------------------------------
+
+      DO i=1, klon
+      z(i) = 0.
+      ktop(i)=0
+      kupper(i) = 0
+      sum_thu(i) = 0.
+      sum_tu(i) = 0.
+      sum_qu(i) = 0.
+      sum_thvu(i) = 0.
+      sum_dth(i) = 0.
+      sum_dq(i) = 0.
+      sum_rho(i) = 0.
+      sum_dtdwn(i) = 0.
+      sum_dqdwn(i) = 0.
+
+      av_thu(i) = 0.
+      av_tu(i) =0.
+      av_qu(i) =0.
+      av_thvu(i) = 0.
+      av_dth(i) = 0.
+      av_dq(i) = 0.
+      av_rho(i) =0.
+      av_dtdwn(i) =0.
+      av_dqdwn(i) = 0.
+      ENDDO
+c
+c Distance between wakes
+       DO i = 1,klon
+        LL(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens(i))
+       ENDDO
+C Potential temperatures and humidity
+c----------------------------------------------------------
+      DO k =1,klev
+       DO i=1, klon 
+!        write(*,*)'wake 1',i,k,rd,te(i,k)
+        rho(i,k) = p(i,k)/(rd*te(i,k))
+!        write(*,*)'wake 2',rho(i,k)
+        IF(k .eq. 1) THEN
+!        write(*,*)'wake 3',i,k,rd,te(i,k)
+          rhoh(i,k) = ph(i,k)/(rd*te(i,k))
+!        write(*,*)'wake 4',i,k,rd,te(i,k)
+          zhh(i,k)=0
+        ELSE
+!          write(*,*)'wake 5',rd,(te(i,k)+te(i,k-1))
+          rhoh(i,k) = ph(i,k)*2./(rd*(te(i,k)+te(i,k-1)))
+!          write(*,*)'wake 6',(-rhoh(i,k)*RG)+zhh(i,k-1)
+          zhh(i,k)=(ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG)+zhh(i,k-1)
+        ENDIF
+!          write(*,*)'wake 7',ppi(i,k)
+        the(i,k) = te(i,k)/ppi(i,k)
+        thu(i,k) = (te(i,k) - deltatw(i,k)*sigmaw(i))/ppi(i,k)
+        tu(i,k) = te(i,k) - deltatw(i,k)*sigmaw(i)
+        qu(i,k)  =  qe(i,k) - deltaqw(i,k)*sigmaw(i)
+!          write(*,*)'wake 8',(rd*(te(i,k)+deltatw(i,k)))
+        rhow(i,k) = p(i,k)/(rd*(te(i,k)+deltatw(i,k)))
+        dth(i,k) = deltatw(i,k)/ppi(i,k)
+       ENDDO
+      ENDDO
+        
+      DO k = 1, klev-1
+      DO i=1, klon 
+        IF(k.eq.1) THEN
+          N2(i,k)=0
+        ELSE
+          N2(i,k)=amax1(0.,-RG**2/the(i,k)*rho(i,k)*(the(i,k+1)-
+     $            the(i,k-1))/(p(i,k+1)-p(i,k-1)))
+        ENDIF
+        ZH(i,k)=(zhh(i,k)+zhh(i,k+1))/2
+
+        Cgw(i,k)=sqrt(N2(i,k))*ZH(i,k)
+        Tgw(i,k)=coefgw*Cgw(i,k)/LL(i)
+      ENDDO
+      ENDDO
+
+      DO i=1, klon
+      N2(i,klev)=0
+      ZH(i,klev)=0
+      Cgw(i,klev)=0
+      Tgw(i,klev)=0
+      ENDDO
+
+c  Calcul de la masse volumique moyenne de la colonne   (bdlmd)
+c-----------------------------------------------------------------
+
+      DO k=1,klev
+       DO i=1, klon
+        epaisseur1(i,k)=0.
+        epaisseur2(i,k)=0.
+       ENDDO
+      ENDDO
+
+      DO i=1, klon
+      epaisseur1(i,1)= -(ph(i,2)-ph(i,1))/(rho(i,1)*rg)+1.
+      epaisseur2(i,1)= -(ph(i,2)-ph(i,1))/(rho(i,1)*rg)+1.
+      rhow_moyen(i,1) = rhow(i,1)
+      ENDDO
+
+      DO k = 2, klev
+      DO i=1, klon
+        epaisseur1(i,k)= -(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg) +1.
+        epaisseur2(i,k)=epaisseur2(i,k-1)+epaisseur1(i,k)
+        rhow_moyen(i,k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+
+     $                 rhow(i,k)*epaisseur1(i,k))/epaisseur2(i,k)
+      ENDDO
+      ENDDO
+
+C
+C Choose an integration bound well above wake top
+c-----------------------------------------------------------------
+c
+C       Pupper = 50000.  ! melting level
+c       Pupper = 60000.
+c       Pupper = 80000.  ! essais pour case_e
+       DO i = 1,klon
+        Pupper(i) = 0.6*ph(i,1)
+        Pupper(i) = max(Pupper(i), 45000.)
+ccc        Pupper(i) = 60000.
+       ENDDO
+
+C
+C    Determine Wake top pressure (Ptop) from buoyancy integral
+C    --------------------------------------------------------
+c
+c-1/ Pressure of the level where dth becomes less than delta_t_min.
+
+      DO i=1,klon
+      ptop_provis(i)=ph(i,1)
+      ENDDO
+      DO k= 2,klev
+      DO i=1,klon
+c
+cIM v3JYG; ptop_provis(i).LT. ph(i,1)
+c
+        IF (dth(i,k) .GT. -delta_t_min .and.
+     $      dth(i,k-1).LT. -delta_t_min .and.
+     $      ptop_provis(i).EQ. ph(i,1)) THEN
+          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
+     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /
+     $          (dth(i,k) - dth(i,k-1))
+        ENDIF
+      ENDDO
+      ENDDO
+
+c-2/ dth integral
+
+      DO i=1,klon
+      sum_dth(i) = 0.
+      dthmin(i) = -delta_t_min
+      z(i) = 0.
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+        dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-Ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i) .gt. 0) THEN
+          z(i) = z(i)+dz(i)
+          sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
+          dthmin(i) = amin1(dthmin(i),dth(i,k))
+        ENDIF
+      ENDDO
+      ENDDO
+
+c-3/ height of triangle with area= sum_dth and base = dthmin
+
+      DO i=1,klon
+      hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
+      hw0(i) = amax1(hwmin,hw0(i))
+      ENDDO
+
+c-4/ now, get Ptop
+
+      DO i=1,klon
+      z(i) = 0.
+      ptop(i) = ph(i,1)
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+        dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg),hw0(i)-z(i))
+        IF (dz(i) .gt. 0) THEN
+         z(i) = z(i)+dz(i)
+         ptop(i) = ph(i,k)-rho(i,k)*rg*dz(i)
+        ENDIF
+      ENDDO
+      ENDDO
+
+
+C-5/ Determination de ktop et kupper
+
+      DO k=klev,1,-1
+      DO i=1,klon
+        IF (ph(i,k+1) .lt. ptop(i)) ktop(i)=k
+        IF (ph(i,k+1) .lt. pupper(i)) kupper(i)=k
+      ENDDO
+      ENDDO
+
+c      On evite kupper = 1
+      DO i=1,klon
+        kupper(i) = max(kupper(i),2)
+      ENDDO
+
+
+c-6/ Correct ktop and ptop
+
+      DO i = 1,klon
+        ptop_new(i)=ptop(i)
+      ENDDO
+      DO k= klev,2,-1
+      DO i=1,klon
+        IF (k .LE. ktop(i) .and.
+     $      ptop_new(i) .EQ. ptop(i) .and.
+     $      dth(i,k) .GT. -delta_t_min .and.
+     $      dth(i,k-1).LT. -delta_t_min) THEN
+          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
+     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /
+     $          (dth(i,k) - dth(i,k-1))
+        ENDIF
+      ENDDO
+      ENDDO
+
+      DO i=1,klon
+        ptop(i) = ptop_new(i)
+      ENDDO
+
+      DO k=klev,1,-1
+      DO i=1,klon
+        IF (ph(i,k+1) .lt. ptop(i)) ktop(i)=k
+      ENDDO
+      ENDDO
+c
+c-5/ Set deltatw & deltaqw to 0 above kupper
+c
+      DO k = 1,klev
+      DO i=1,klon
+       IF (k.GE. kupper(i)) THEN
+        deltatw(i,k) = 0.
+        deltaqw(i,k) = 0.
+       ENDIF
+      ENDDO
+      ENDDO
+c
+C
+C Vertical gradient of LS omega
+C
+      DO k = 1,klev
+      DO i=1,klon
+       IF (k.LE. kupper(i)) THEN
+        dp_omgb(i,k) = (omgb(i,k+1) - omgb(i,k))/(ph(i,k+1)-ph(i,k))
+       ENDIF
+      ENDDO
+      ENDDO
+C
+C Integrals (and wake top level number)
+C --------------------------------------
+C
+C Initialize sum_thvu to 1st level virt. pot. temp.
+
+      DO i=1,klon
+      z(i) = 1.
+      dz(i) = 1.
+      sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
+      sum_dth(i) = 0.
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i) .GT. 0) THEN
+         z(i) = z(i)+dz(i)
+         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
+         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
+         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
+         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
+         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
+         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
+         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
+         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
+         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
+        ENDIF
+      ENDDO
+      ENDDO
+c
+      DO i=1,klon
+        hw0(i) = z(i)
+      ENDDO
+c
+C
+C 2.1 - WAPE and mean forcing computation
+C ---------------------------------------
+C
+C ---------------------------------------
+C
+C Means
+
+      DO i=1,klon
+      av_thu(i) = sum_thu(i)/hw0(i)
+      av_tu(i) = sum_tu(i)/hw0(i)
+      av_qu(i) = sum_qu(i)/hw0(i)
+      av_thvu(i) = sum_thvu(i)/hw0(i)
+c      av_thve = sum_thve/hw0
+      av_dth(i) = sum_dth(i)/hw0(i)
+      av_dq(i) = sum_dq(i)/hw0(i)
+      av_rho(i) = sum_rho(i)/hw0(i)
+      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+      wape(i) = - rg*hw0(i)*(av_dth(i)
+     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*
+     $     av_dq(i) ))/av_thvu(i)
+      ENDDO
+C
+C 2.2 Prognostic variable update
+C ------------------------------
+C
+C Filter out bad wakes
+
+      DO k = 1,klev
+       DO i=1,klon
+        IF ( wape(i) .LT. 0.) THEN
+          deltatw(i,k) = 0.
+          deltaqw(i,k) = 0.
+          dth(i,k) = 0.
+        ENDIF
+       ENDDO
+      ENDDO
+c
+      DO i=1,klon
+      IF ( wape(i) .LT. 0.) THEN
+        wape(i) = 0.
+        Cstar(i) = 0.
+        hw(i) = hwmin
+        sigmaw(i) = amax1(sigmad,sigd_con(i))
+        fip(i) = 0.
+        gwake(i) = .FALSE.
+      ELSE
+        Cstar(i) = stark*sqrt(2.*wape(i))
+        gwake(i) = .TRUE.
+      ENDIF
+      ENDDO
+
+c
+c Check qx and qw positivity
+c --------------------------
+      DO i = 1,klon
+       q0_min(i)=min(  (qe(i,1)-sigmaw(i)*deltaqw(i,1)),
+     $              (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1))  )
+      ENDDO
+      DO k = 2,klev
+      DO i = 1,klon
+        q1_min(i)=min(  (qe(i,k)-sigmaw(i)*deltaqw(i,k)),
+     $              (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k))  )
+        IF (q1_min(i).le.q0_min(i)) THEN
+          q0_min(i)=q1_min(i)
+        ENDIF
+      ENDDO
+      ENDDO
+c
+      DO i = 1,klon
+       OK_qx_qw(i) = q0_min(i) .GE. 0.
+       alpha(i) = 1.
+      ENDDO
+c
+CC -----------------------------------------------------------------
+C    Sub-time-stepping
+C    -----------------
+C
+      nsub=10
+      dtimesub=dtime/nsub
+c
+c------------------------------------------------------------
+      DO isubstep = 1,nsub
+c------------------------------------------------------------
+c
+c wk_adv is the logical flag enabling wake evolution in the time advance loop
+      DO i = 1,klon
+       wk_adv(i) = OK_qx_qw(i) .AND. alpha(i) .GE. 1.
+      ENDDO
+c
+ccc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement négatif de ktop à kupper --------
+ccc           On calcule pour cela une densité wdens0 pour laquelle on aurait un entrainement nul ---
+      DO i=1,klon
+cc       print *,' isubstep,wk_adv(i),cstar(i),wape(i) ',
+cc     $           isubstep,wk_adv(i),cstar(i),wape(i)
+        IF (wk_adv(i) .AND. cstar(i).GT.0.01) THEN
+           omg(i,kupper(i)+1) = - Rg*amdwn(i,kupper(i)+1)/sigmaw(i)
+     $                + Rg*amup(i,kupper(i)+1)/(1.-sigmaw(i))
+           wdens0 = ( sigmaw(i) / (4.*3.14) ) *
+     $     ( (1.-sigmaw(i)) * omg(i,kupper(i)+1) /
+     $     ( (ph(i,1)-pupper(i)) * cstar(i) )  ) **(2)
+         IF ( wdens(i) .LE. wdens0*1.1 ) THEN
+            wdens(i) = wdens0
+         ENDIF
+cc	   print*,'omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i)
+cc     $     ,ph(i,1)-pupper(i)',
+cc     $             omg(i,kupper(i)+1),wdens0,wdens(i),cstar(i)
+cc     $     ,ph(i,1)-pupper(i)
+        ENDIF
+      ENDDO
+
+ccc nrlmd
+
+      DO i=1,klon
+       IF (wk_adv(i)) THEN
+        gfl(i) = 2.*sqrt(3.14*wdens(i)*sigmaw(i))
+        sigmaw(i)=amin1(sigmaw(i),sigmaw_max)
+       ENDIF
+      ENDDO
+      DO i=1,klon
+        IF (wk_adv(i)) THEN
+ccc nrlmd          Introduction du taux de mortalité des poches et test sur sigmaw_max=0.4
+ccc         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
+           IF (sigmaw(i).ge.sigmaw_max) THEN
+           death_rate(i)=gfl(i)*Cstar(i)/sigmaw(i)
+           ELSE
+             death_rate(i)=0.
+           END IF
+        d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
+     $               - death_rate(i)*sigmaw(i)*dtimesub
+c     $              - nat_rate(i)*sigmaw(i)*dtimesub
+cc        print*, 'd_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+cc     $  death_rate(i),ktop(i),kupper(i)',
+cc     $	         d_sigmaw(i),sigmaw(i),gfl(i),Cstar(i),wape(i),
+cc     $  death_rate(i),ktop(i),kupper(i)
+
+c        sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
+c        sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
+c        wdens = wdens0/(10.*sigmaw)
+c        sigmaw =max(sigmaw,sigd_con)
+c        sigmaw =max(sigmaw,sigmad)
+        ENDIF
+      ENDDO
+C
+C
+c calcul de la difference de vitesse verticale poche - zone non perturbee
+cIM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
+cIM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
+cIM 060208 au niveau k=1..?
+      DO k= 1,klev
+      DO i = 1,klon
+      if (wk_adv(i)) THEN !!! nrlmd
+        dp_deltomg(i,k)=0.
+      end if
+      ENDDO
+      ENDDO
+      DO k= 1,klev+1
+      DO i = 1,klon
+      if (wk_adv(i)) THEN !!! nrlmd
+        omg(i,k)=0.
+      end if
+      ENDDO
+      ENDDO
+c
+      DO i=1,klon
+        IF (wk_adv(i)) THEN
+        z(i)= 0.
+        omg(i,1) = 0.
+        dp_deltomg(i,1) = -(gfl(i)*Cstar(i))/(sigmaw(i) * (1-sigmaw(i)))
+        ENDIF
+      ENDDO
+c
+      DO k= 2,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
+          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*rg)
+          z(i) = z(i)+dz(i)
+          dp_deltomg(i,k)= dp_deltomg(i,1)
+          omg(i,k)= dp_deltomg(i,1)*z(i)
+       ENDIF
+      ENDDO
+      ENDDO
+c
+      DO i = 1,klon
+        IF (wk_adv(i)) THEN
+        dztop(i)=-(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*rg)
+        ztop(i) = z(i)+dztop(i)
+        omgtop(i)=dp_deltomg(i,1)*ztop(i)
+        ENDIF
+      ENDDO
+c
+c        -----------------
+c        From m/s to Pa/s
+c        -----------------
+c
+       DO i=1,klon
+        IF (wk_adv(i)) THEN
+        omgtop(i) = -rho(i,ktop(i))*rg*omgtop(i)
+        dp_deltomg(i,1) = omgtop(i)/(ptop(i)-ph(i,1))
+        ENDIF
+       ENDDO
+c
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
+          omg(i,k) = - rho(i,k)*rg*omg(i,k)
+          dp_deltomg(i,k) = dp_deltomg(i,1)
+       ENDIF
+      ENDDO
+      ENDDO
+c
+c   raccordement lineaire de omg de ptop a pupper
+
+      DO i=1,klon
+      IF ( wk_adv(i) .AND. kupper(i) .GT. ktop(i)) THEN
+        omg(i,kupper(i)+1) = - Rg*amdwn(i,kupper(i)+1)/sigmaw(i)
+     $                + Rg*amup(i,kupper(i)+1)/(1.-sigmaw(i))
+        dp_deltomg(i,kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/
+     $                     (ptop(i)-pupper(i))
+      ENDIF
+      ENDDO
+c
+cc      DO i=1,klon
+cc        print*,'Pente entre 0 et kupper (référence)'
+cc     $   	,omg(i,kupper(i)+1)/(pupper(i)-ph(i,1))
+cc        print*,'Pente entre ktop et kupper'
+cc     $  	,(omg(i,kupper(i)+1)-omgtop(i))/(pupper(i)-ptop(i))
+cc      ENDDO
+cc
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .GT. ktop(i) .AND. k .LE. kupper(i)) THEN
+          dp_deltomg(i,k) = dp_deltomg(i,kupper(i))
+          omg(i,k) = omgtop(i)+(ph(i,k)-ptop(i))*dp_deltomg(i,kupper(i))
+       ENDIF
+      ENDDO
+      ENDDO
+ccc nrlmd
+cc      DO i=1,klon
+cc      print*,'deltaw_ktop,deltaw_conv',omgtop(i),omg(i,kupper(i)+1)
+cc      END DO
+ccc
+c
+c
+c--    Compute wake average vertical velocity omgbw
+c
+c
+      DO k = 1,klev+1
+      DO i=1,klon
+        IF ( wk_adv(i)) THEN
+        omgbw(i,k) = omgb(i,k)+(1.-sigmaw(i))*omg(i,k)
+        ENDIF
+      ENDDO
+      ENDDO
+c--    and its vertical gradient dp_omgbw
+c
+      DO k = 1,klev
+      DO i=1,klon
+        IF ( wk_adv(i)) THEN
+        dp_omgbw(i,k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
+        ENDIF
+      ENDDO
+      ENDDO
+C
+c--    Upstream coefficients for omgb velocity
+c--    (alpha_up(k) is the coefficient of the value at level k)
+c--    (1-alpha_up(k) is the coefficient of the value at level k-1)
+      DO k = 1,klev
+      DO i=1,klon
+        IF ( wk_adv(i)) THEN
+         alpha_up(i,k) = 0.
+         IF (omgb(i,k) .GT. 0.) alpha_up(i,k) = 1.
+        ENDIF
+      ENDDO
+      ENDDO
+
+c  Matrix expressing [The,deltatw] from  [Th1,Th2]
+
+      DO i=1,klon
+        IF ( wk_adv(i)) THEN
+         RRe1(i) = 1.-sigmaw(i)
+         RRe2(i) = sigmaw(i)
+        ENDIF
+      ENDDO
+      RRd1 = -1.
+      RRd2 = 1.
+c
+c--    Get [Th1,Th2], dth and [q1,q2]
+c
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
+        dth(i,k) = deltatw(i,k)/ppi(i,k)
+        Th1(i,k) = the(i,k) - sigmaw(i)     *dth(i,k)   ! undisturbed area
+        Th2(i,k) = the(i,k) + (1.-sigmaw(i))*dth(i,k)   ! wake
+        q1(i,k) = qe(i,k) - sigmaw(i)     *deltaqw(i,k) ! undisturbed area
+        q2(i,k) = qe(i,k) + (1.-sigmaw(i))*deltaqw(i,k) ! wake
+       ENDIF
+      ENDDO
+      ENDDO
+
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+       D_Th1(i,1) = 0.
+       D_Th2(i,1) = 0.
+       D_dth(i,1) = 0.
+       D_q1(i,1) = 0.
+       D_q2(i,1) = 0.
+       D_dq(i,1) = 0.
+       end if
+      ENDDO
+
+      DO k= 2,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
+        D_Th1(i,k) = Th1(i,k-1)-Th1(i,k)
+        D_Th2(i,k) = Th2(i,k-1)-Th2(i,k)
+        D_dth(i,k) = dth(i,k-1)-dth(i,k)
+        D_q1(i,k) = q1(i,k-1)-q1(i,k)
+        D_q2(i,k) = q2(i,k-1)-q2(i,k)
+        D_dq(i,k) = deltaqw(i,k-1)-deltaqw(i,k)
+       ENDIF
+      ENDDO
+      ENDDO
+
+      DO i=1,klon
+        IF( wk_adv(i)) THEN
+         omgbdth(i,1) = 0.
+         omgbdq(i,1) = 0.
+        ENDIF
+      ENDDO
+
+      DO k= 2,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN  !   loop on interfaces
+        omgbdth(i,k) = omgb(i,k)*(    dth(i,k-1) -     dth(i,k))
+        omgbdq(i,k)  = omgb(i,k)*(deltaqw(i,k-1) - deltaqw(i,k))
+       ENDIF
+      ENDDO
+      ENDDO
+c
+c-----------------------------------------------------------------
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
+c-----------------------------------------------------------------
+c
+c   Compute redistribution (advective) term
+c
+         d_deltatw(i,k) =
+     $             dtimesub/(Ph(i,k)-Ph(i,k+1))*(
+     $       RRd1*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
+     $      -RRd2*omg(i,k+1)*(1.-sigmaw(i))*D_Th2(i,k+1)
+     $      -(1.-alpha_up(i,k))*omgbdth(i,k) - alpha_up(i,k+1)*
+     $      omgbdth(i,k+1))*ppi(i,k)
+c         print*,'d_deltatw=',d_deltatw(i,k)
+c
+         d_deltaqw(i,k) =
+     $             dtimesub/(Ph(i,k)-Ph(i,k+1))*(
+     $       RRd1*omg(i,k  )*sigmaw(i)     *D_q1(i,k)
+     $      -RRd2*omg(i,k+1)*(1.-sigmaw(i))*D_q2(i,k+1)
+     $      -(1.-alpha_up(i,k))*omgbdq(i,k) - alpha_up(i,k+1)*
+     $      omgbdq(i,k+1))
+c         print*,'d_deltaqw=',d_deltaqw(i,k)
+c
+c   and increment large scale tendencies
+c
+
+c
+C
+CC -----------------------------------------------------------------
+         d_te(i,k) =  dtimesub*(
+     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
+     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_Th2(i,k+1) )
+     $               /(Ph(i,k)-Ph(i,k+1))
+ccc nrlmd     $         -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*dp_deltomg(i,k)
+     $         -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)
+     $         *(omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1))
+ccc
+     $                      )*ppi(i,k)
+c
+         d_qe(i,k) =  dtimesub*(
+     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_q1(i,k)
+     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_q2(i,k+1) )
+     $               /(Ph(i,k)-Ph(i,k+1))
+ccc nrlmd     $         -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*dp_deltomg(i,k)
+     $         -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)
+     $         *(omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1))
+ccc
+     $                      )
+ccc nrlmd
+       ELSE IF(wk_adv(i) .AND. k .EQ. kupper(i)) THEN
+         d_te(i,k) =  dtimesub*(
+     $       ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
+     $        /(Ph(i,k)-Ph(i,k+1)))
+     $                       )*ppi(i,k)
+
+         d_qe(i,k) =  dtimesub*(
+     $       ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_q1(i,k)       
+     $        /(Ph(i,k)-Ph(i,k+1)))
+     $                       )
+
+       ENDIF
+ccc
+      ENDDO
+      ENDDO
+c------------------------------------------------------------------
+C
+C   Increment state variables
+
+      DO k= 1,klev
+      DO i = 1,klon
+ccc nrlmd       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
+        IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+ccc
+
+
+c
+c Coefficient de répartition
+
+        Crep(i,k)=Crep_sol*(ph(i,kupper(i))-ph(i,k))/(ph(i,kupper(i))
+     $          -ph(i,1))
+        Crep(i,k)=Crep(i,k)+Crep_upper*(ph(i,1)-ph(i,k))/(p(i,1)-
+     $          ph(i,kupper(i)))
+        
+
+c Reintroduce compensating subsidence term.
+
+c        dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
+c        dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
+c     .                   /(1-sigmaw)
+c        dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
+c        dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
+c     .                   /(1-sigmaw)
+c
+c        dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
+c        dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
+c     .                   /(1-sigmaw)
+c        dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
+c        dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
+c     .                   /(1-sigmaw)
+
+        dtKE(i,k)=(dtdwn(i,k)/sigmaw(i) - dta(i,k)/(1.-sigmaw(i)))
+        dqKE(i,k)=(dqdwn(i,k)/sigmaw(i) - dqa(i,k)/(1.-sigmaw(i)))
+c        print*,'dtKE= ',dtKE(i,k),' dqKE= ',dqKE(i,k)
+c
+        dtPBL(i,k)=(wdtPBL(i,k)/sigmaw(i) - udtPBL(i,k)/(1.-sigmaw(i)))
+        dqPBL(i,k)=(wdqPBL(i,k)/sigmaw(i) - udqPBL(i,k)/(1.-sigmaw(i)))
+c        print*,'dtPBL= ',dtPBL(i,k),' dqPBL= ',dqPBL(i,k)
+c
+ccc nrlmd          Prise en compte du taux de mortalité
+ccc               Définitions de entr, detr
+        detr(i,k)=0.
+
+        entr(i,k)=detr(i,k)+gfl(i)*cstar(i)+
+     $          sigmaw(i)*(1.-sigmaw(i))*dp_deltomg(i,k)
+
+        spread(i,k) = (entr(i,k)-detr(i,k))/sigmaw(i)
+ccc        spread(i,k) = (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
+ccc     $  sigmaw(i)
+
+
+c ajout d'un effet onde de gravité -Tgw(k)*deltatw(k) 03/02/06 YU Jingmei
+
+!      write(lunout,*)'wake.F ',i,k, dtimesub,d_deltat_gw(i,k),
+!     &  Tgw(i,k),deltatw(i,k)
+        d_deltat_gw(i,k)=d_deltat_gw(i,k)-Tgw(i,k)*deltatw(i,k)*
+     $  dtimesub
+!      write(lunout,*)'wake.F ',i,k, dtimesub,d_deltatw(i,k)
+        ff(i)=d_deltatw(i,k)/dtimesub
+
+c Sans GW
+c
+c        deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-spread(k)*deltatw(k))
+c
+c GW formule 1
+c
+c        deltatw(k) = deltatw(k)+dtimesub*
+c     $         (ff+dtKE(k) - spread(k)*deltatw(k)-Tgw(k)*deltatw(k))
+c
+c GW formule 2
+
+        IF (dtimesub*Tgw(i,k).lt.1.e-10) THEN
+          d_deltatw(i,k) = dtimesub*
+     $       (ff(i)+dtKE(i,k)+dtPBL(i,k)
+ccc     $       -spread(i,k)*deltatw(i,k)
+     $       - entr(i,k)*deltatw(i,k)/sigmaw(i)
+     $       - (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)
+     $       / (1.-sigmaw(i))
+ccc
+     $       -Tgw(i,k)*deltatw(i,k))
+        ELSE
+           d_deltatw(i,k) = 1/Tgw(i,k)*(1-exp(-dtimesub*
+     $       Tgw(i,k)))*
+     $       (ff(i)+dtKE(i,k)+dtPBL(i,k)
+ccc     $       -spread(i,k)*deltatw(i,k)
+     $       - entr(i,k)*deltatw(i,k)/sigmaw(i)
+     $       - (death_rate(i)*sigmaw(i)+detr(i,k))*deltatw(i,k)
+     $       / (1.-sigmaw(i))
+ccc
+     $       -Tgw(i,k)*deltatw(i,k))
+        ENDIF
+
+        dth(i,k) = deltatw(i,k)/ppi(i,k)
+
+        gg(i)=d_deltaqw(i,k)/dtimesub
+
+       d_deltaqw(i,k) = dtimesub*(gg(i)+ dqKE(i,k)+dqPBL(i,k)
+ccc     $     -spread(i,k)*deltaqw(i,k))
+     $        - entr(i,k)*deltaqw(i,k)/sigmaw(i)
+     $        - (death_rate(i)*sigmaw(i)+detr(i,k))*deltaqw(i,k)
+     $        /(1.-sigmaw(i)))
+ccc
+
+ccc nrlmd
+ccc       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
+ccc       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
+ccc
+       ENDIF
+      ENDDO
+      ENDDO
+
+C
+C   Scale tendencies so that water vapour remains positive in w and x.
+C
+      call wake_vec_modulation(klon,klev,wk_adv,epsilon,qe,d_qe,deltaqw,
+     $                d_deltaqw,sigmaw,d_sigmaw,alpha)
+c
+ccc nrlmd
+cc      print*,'alpha'
+cc      do i=1,klon
+cc         print*,alpha(i)
+cc      end do
+ccc
+      DO k = 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+        d_te(i,k)=alpha(i)*d_te(i,k)
+        d_qe(i,k)=alpha(i)*d_qe(i,k)
+        d_deltatw(i,k)=alpha(i)*d_deltatw(i,k)
+        d_deltaqw(i,k)=alpha(i)*d_deltaqw(i,k)
+        d_deltat_gw(i,k)=alpha(i)*d_deltat_gw(i,k)
+       ENDIF
+      ENDDO
+      ENDDO
+      DO i = 1,klon
+       IF( wk_adv(i)) THEN
+        d_sigmaw(i)=alpha(i)*d_sigmaw(i)
+       ENDIF
+      ENDDO
+
+C   Update large scale variables and wake variables
+cIM 060208 manque DO i + remplace DO k=1,kupper(i)
+cIM 060208     DO k = 1,kupper(i)
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+        dtls(i,k)=dtls(i,k)+d_te(i,k)
+        dqls(i,k)=dqls(i,k)+d_qe(i,k)
+ccc nrlmd
+        d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
+        d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
+ccc
+       ENDIF
+      ENDDO
+      ENDDO
+      DO k= 1,klev
+      DO i = 1,klon
+       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+        te(i,k) = te0(i,k) + dtls(i,k)
+        qe(i,k) = qe0(i,k) + dqls(i,k)
+        the(i,k) = te(i,k)/ppi(i,k)
+        deltatw(i,k) = deltatw(i,k)+d_deltatw(i,k)
+        deltaqw(i,k) = deltaqw(i,k)+d_deltaqw(i,k)
+        dth(i,k) = deltatw(i,k)/ppi(i,k)
+cc      print*,'k,qx,qw',k,qe(i,k)-sigmaw(i)*deltaqw(i,k)
+cc     $        ,qe(i,k)+(1-sigmaw(i))*deltaqw(i,k)
+       ENDIF
+      ENDDO
+      ENDDO
+      DO i = 1,klon
+       IF( wk_adv(i)) THEN
+        sigmaw(i) = sigmaw(i)+d_sigmaw(i)
+       ENDIF
+      ENDDO
+c
+C
+c     Determine Ptop from buoyancy integral
+c     ---------------------------------------
+c
+c-     1/ Pressure of the level where dth changes sign.
+c
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+        Ptop_provis(i)=ph(i,1)
+       ENDIF
+      ENDDO
+c
+      DO k= 2,klev
+      DO i=1,klon
+        IF ( wk_adv(i) .AND.
+     $       Ptop_provis(i) .EQ. ph(i,1) .AND.
+     $      dth(i,k) .GT. -delta_t_min .and.
+     $      dth(i,k-1).LT. -delta_t_min) THEN
+          Ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
+     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /(dth(i,k)
+     $          - dth(i,k-1))
+        ENDIF
+      ENDDO
+      ENDDO
+c
+c-     2/ dth integral
+c
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+       sum_dth(i) = 0.
+       dthmin(i) = -delta_t_min
+       z(i) = 0.
+       end if
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+        dz(i) = -(amax1(ph(i,k+1),Ptop_provis(i))-Ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i) .gt. 0) THEN
+         z(i) = z(i)+dz(i)
+         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
+         dthmin(i) = amin1(dthmin(i),dth(i,k))
+        ENDIF
+       ENDIF
+      ENDDO
+      ENDDO
+c
+c-     3/ height of triangle with area= sum_dth and base = dthmin
+
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+         hw(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
+         hw(i) = amax1(hwmin,hw(i))
+       ENDIF
+      ENDDO
+c
+c-     4/ now, get Ptop
+c
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+       ktop(i) = 0
+       z(i)=0.
+       end if
+      ENDDO
+c
+      DO k = 1,klev
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+        dz(i) = amin1(-(ph(i,k+1)-Ph(i,k))/(rho(i,k)*rg),hw(i)-z(i))
+        IF (dz(i) .gt. 0) THEN
+         z(i) = z(i)+dz(i)
+         Ptop(i) = Ph(i,k)-rho(i,k)*rg*dz(i)
+         ktop(i) = k
+        ENDIF
+       ENDIF
+      ENDDO
+      ENDDO
+c
+c      4.5/Correct ktop and ptop
+c
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+        Ptop_new(i)=ptop(i)
+       ENDIF
+      ENDDO
+c
+      DO k= klev,2,-1
+      DO i=1,klon
+cIM v3JYG; IF (k .GE. ktop(i)
+       IF ( wk_adv(i) .AND.
+     $      k .LE. ktop(i) .AND.
+     $      ptop_new(i) .EQ. ptop(i) .AND.
+     $      dth(i,k) .GT. -delta_t_min .and.
+     $      dth(i,k-1).LT. -delta_t_min) THEN
+          Ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
+     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /(dth(i,k)
+     $          - dth(i,k-1))
+        ENDIF
+      ENDDO
+      ENDDO
+c
+c
+      DO i=1,klon
+       IF ( wk_adv(i)) THEN
+        ptop(i) = ptop_new(i)
+       ENDIF
+      ENDDO
+
+      DO k=klev,1,-1
+      DO i=1,klon
+      if (wk_adv(i)) then !!! nrlmd
+        IF (ph(i,k+1) .LT. ptop(i)) ktop(i)=k
+      end if
+      ENDDO
+      ENDDO
+c
+c      5/ Set deltatw & deltaqw to 0 above kupper
+c
+      DO k = 1,klev
+      DO i=1,klon
+        IF ( wk_adv(i) .AND. k .GE. kupper(i)) THEN
+         deltatw(i,k) = 0.
+         deltaqw(i,k) = 0.
+        ENDIF
+      ENDDO
+      ENDDO
+c
+C
+c-------------Cstar computation---------------------------------
+      DO i=1, klon
+       if (wk_adv(i)) then !!! nrlmd
+      sum_thu(i) = 0.
+      sum_tu(i) = 0.
+      sum_qu(i) = 0.
+      sum_thvu(i) = 0.
+      sum_dth(i) = 0.
+      sum_dq(i) = 0.
+      sum_rho(i) = 0.
+      sum_dtdwn(i) = 0.
+      sum_dqdwn(i) = 0.
+
+      av_thu(i) = 0.
+      av_tu(i) =0.
+      av_qu(i) =0.
+      av_thvu(i) = 0.
+      av_dth(i) = 0.
+      av_dq(i) = 0.
+      av_rho(i) =0.
+      av_dtdwn(i) =0.
+      av_dqdwn(i) = 0.
+       end if
+      ENDDO
+C
+C Integrals (and wake top level number)
+C --------------------------------------
+C
+C Initialize sum_thvu to 1st level virt. pot. temp.
+
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+      z(i) = 1.
+      dz(i) = 1.
+      sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
+      sum_dth(i) = 0.
+       end if
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+        dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i) .GT. 0) THEN
+         z(i) = z(i)+dz(i)
+         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
+         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
+         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
+         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
+         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
+         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
+         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
+         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
+         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
+        ENDIF
+       end if
+      ENDDO
+      ENDDO
+c
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+        hw0(i) = z(i)
+       end if
+      ENDDO
+c
+C
+C - WAPE and mean forcing computation
+C ---------------------------------------
+C
+C ---------------------------------------
+C
+C Means
+
+      DO i=1,klon
+       if (wk_adv(i)) then !!! nrlmd
+       av_thu(i) = sum_thu(i)/hw0(i)
+       av_tu(i) = sum_tu(i)/hw0(i)
+       av_qu(i) = sum_qu(i)/hw0(i)
+       av_thvu(i) = sum_thvu(i)/hw0(i)
+       av_dth(i) = sum_dth(i)/hw0(i)
+       av_dq(i) = sum_dq(i)/hw0(i)
+       av_rho(i) = sum_rho(i)/hw0(i)
+       av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+       av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+c
+       wape(i) = - rg*hw0(i)*(av_dth(i)
+     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*
+     $     av_dq(i) ))/av_thvu(i)
+       end if
+      ENDDO
+C
+C Filter out bad wakes
+
+      DO k = 1,klev
+       DO i=1,klon
+        if (wk_adv(i)) then !!! nrlmd
+        IF ( wape(i) .LT. 0.) THEN
+          deltatw(i,k) = 0.
+          deltaqw(i,k) = 0.
+          dth(i,k) = 0.
+        ENDIF
+	end if
+       ENDDO
+      ENDDO
+c
+      DO i=1,klon
+      if (wk_adv(i)) then !!! nrlmd
+      IF ( wape(i) .LT. 0.) THEN
+        wape(i) = 0.
+        Cstar(i) = 0.
+        hw(i) = hwmin
+        sigmaw(i) = max(sigmad,sigd_con(i))
+        fip(i) = 0.
+        gwake(i) = .FALSE.
+      ELSE
+        Cstar(i) = stark*sqrt(2.*wape(i))
+        gwake(i) = .TRUE.
+      ENDIF
+      end if
+      ENDDO
+
+       ENDDO      ! end sub-timestep loop
+C
+C -----------------------------------------------------------------
+c   Get back to tendencies per second
+c
+      DO k = 1,klev
+      DO i=1,klon
+
+ccc nrlmd        IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN
+        IF ( OK_qx_qw(i) .AND. k .LE. kupper(i)) THEN
+ccc
+         dtls(i,k) = dtls(i,k)/dtime
+         dqls(i,k) = dqls(i,k)/dtime
+         d_deltatw2(i,k)=d_deltatw2(i,k)/dtime
+         d_deltaqw2(i,k)=d_deltaqw2(i,k)/dtime
+         d_deltat_gw(i,k) = d_deltat_gw(i,k)/dtime
+cc      print*,'k,dqls,omg,entr,detr',k,dqls(i,k),omg(i,k),entr(i,k)
+cc     $         ,death_rate(i)*sigmaw(i)
+        ENDIF
+      ENDDO
+      ENDDO
+
+c
+c----------------------------------------------------------
+c   Determine wake final state; recompute wape, cstar, ktop;
+c   filter out bad wakes.
+c----------------------------------------------------------
+c
+C 2.1 - Undisturbed area and Wake integrals
+C ---------------------------------------------------------
+
+      DO i=1,klon
+ccc nrlmd       if (wk_adv(i)) then !!! nrlmd
+      if (OK_qx_qw(i)) then
+ccc
+        z(i) = 0.
+        sum_thu(i) = 0.
+        sum_tu(i) = 0.
+        sum_qu(i) = 0.
+        sum_thvu(i) = 0.
+        sum_dth(i) = 0.
+        sum_dq(i) = 0.
+        sum_rho(i) = 0.
+        sum_dtdwn(i) = 0.
+        sum_dqdwn(i) = 0.
+
+        av_thu(i) = 0.
+        av_tu(i) =0.
+        av_qu(i) =0.
+        av_thvu(i) = 0.
+        av_dth(i) = 0.
+        av_dq(i) = 0.
+        av_rho(i) =0.
+        av_dtdwn(i) =0.
+        av_dqdwn(i) = 0.
+       end if	
+      ENDDO
+C Potential temperatures and humidity
+c----------------------------------------------------------
+
+      DO k =1,klev
+      DO i=1,klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+       if (OK_qx_qw(i)) then
+ccc
+        rho(i,k) = p(i,k)/(rd*te(i,k))
+        IF(k .eq. 1) THEN
+          rhoh(i,k) = ph(i,k)/(rd*te(i,k))
+          zhh(i,k)=0
+        ELSE
+          rhoh(i,k) = ph(i,k)*2./(rd*(te(i,k)+te(i,k-1)))
+          zhh(i,k)=(ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG)+zhh(i,k-1)
+        ENDIF
+        the(i,k) = te(i,k)/ppi(i,k)
+        thu(i,k) = (te(i,k) - deltatw(i,k)*sigmaw(i))/ppi(i,k)
+        tu(i,k) = te(i,k) - deltatw(i,k)*sigmaw(i)
+        qu(i,k)  =  qe(i,k) - deltaqw(i,k)*sigmaw(i)
+        rhow(i,k) = p(i,k)/(rd*(te(i,k)+deltatw(i,k)))
+        dth(i,k) = deltatw(i,k)/ppi(i,k)
+       ENDIF
+      ENDDO
+      ENDDO
+
+C Integrals (and wake top level number)
+C -----------------------------------------------------------
+
+C Initialize sum_thvu to 1st level virt. pot. temp.
+
+      DO i=1,klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+      if (OK_qx_qw(i)) then
+ccc
+        z(i) = 1.
+        dz(i) = 1.
+        sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
+        sum_dth(i) = 0.
+      ENDIF
+      ENDDO
+
+      DO k = 1,klev
+      DO i=1,klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+       if (OK_qx_qw(i)) then
+ccc
+        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
+        IF (dz(i) .GT. 0) THEN
+         z(i) = z(i)+dz(i)
+         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
+         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
+         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
+         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
+         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
+         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
+         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
+         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
+         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
+        ENDIF
+       ENDIF
+      ENDDO
+      ENDDO
+c
+      DO i=1,klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+       if (OK_qx_qw(i)) then
+ccc
+        hw0(i) = z(i)
+       ENDIF
+      ENDDO
+c
+C - WAPE and mean forcing computation
+C-------------------------------------------------------------
+
+C Means
+
+      DO i=1, klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+      if (OK_qx_qw(i)) then
+ccc
+        av_thu(i) = sum_thu(i)/hw0(i)
+        av_tu(i) = sum_tu(i)/hw0(i)
+        av_qu(i) = sum_qu(i)/hw0(i)
+        av_thvu(i) = sum_thvu(i)/hw0(i)
+        av_dth(i) = sum_dth(i)/hw0(i)
+        av_dq(i) = sum_dq(i)/hw0(i)
+        av_rho(i) = sum_rho(i)/hw0(i)
+        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
+        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
+
+        wape2(i) = - rg*hw0(i)*(av_dth(i)
+     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)
+     $     + av_dth(i)*av_dq(i) ))/av_thvu(i)
+       ENDIF
+      ENDDO
+
+C Prognostic variable update
+C ------------------------------------------------------------
+
+C Filter out bad wakes
+c
+      DO k = 1,klev
+      DO i=1,klon
+ccc nrlmd        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
+      if (OK_qx_qw(i) .AND. wape2(i) .LT. 0.) then
+ccc
+          deltatw(i,k) = 0.
+          deltaqw(i,k) = 0.
+          dth(i,k) = 0.
+        ENDIF
+      ENDDO
+      ENDDO
+c
+
+      DO i=1, klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+      if (OK_qx_qw(i)) then
+ccc
+       IF ( wape2(i) .LT. 0.) THEN
+        wape2(i) = 0.
+        Cstar2(i) = 0.
+        hw(i) = hwmin
+        sigmaw(i) = amax1(sigmad,sigd_con(i))
+        fip(i) = 0.
+        gwake(i) = .FALSE.
+      ELSE
+        if(prt_level.ge.10) print*,'wape2>0'
+        Cstar2(i) = stark*sqrt(2.*wape2(i))
+        gwake(i) = .TRUE.
+      ENDIF
+      ENDIF
+      ENDDO
+c
+      DO i=1, klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+       if (OK_qx_qw(i)) then
+ccc
+        ktopw(i) = ktop(i)
+       ENDIF
+      ENDDO
+c
+      DO i=1, klon
+ccc nrlmd       IF ( wk_adv(i)) THEN
+       if (OK_qx_qw(i)) then
+ccc
+       IF (ktopw(i) .gt. 0 .and. gwake(i)) then
+
+Cjyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
+ccc       heff = 600.
+C      Utilisation de la hauteur hw
+cc       heff = 0.7*hw
+       heff(i) = hw(i)
+
+       FIP(i) = 0.5*rho(i,ktopw(i))*Cstar2(i)**3*heff(i)*2*
+     $      sqrt(sigmaw(i)*wdens(i)*3.14)
+       FIP(i) = alpk * FIP(i)
+Cjyg2
+       ELSE
+         FIP(i) = 0.
+       ENDIF
+       ENDIF
+      ENDDO
+c
+C   Limitation de sigmaw
+
+ccc nrlmd
+c       DO i=1,klon
+c         IF (OK_qx_qw(i)) THEN
+c	   IF (sigmaw(i).GE.sigmaw_max) sigmaw(i)=sigmaw_max
+c	 ENDIF
+c       ENDDO
+ccc
+      DO k = 1,klev
+       DO i=1, klon
+
+ccc nrlmd      On maintient désormais constant sigmaw en régime permanent
+ccc      IF ((sigmaw(i).GT.sigmaw_max).or.
+        IF     ( ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
+     $         (ktopw(i).le.2) .OR.
+     $         .not. OK_qx_qw(i) ) THEN
+ccc
+          dtls(i,k) = 0.
+          dqls(i,k) = 0.
+          deltatw(i,k) = 0.
+          deltaqw(i,k) = 0.
+        ENDIF
+       ENDDO
+      ENDDO
+c
+ccc nrlmd      On maintient désormais constant sigmaw en régime permanent
+      DO i=1, klon
+        IF  ( ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
+     $        (ktopw(i).le.2) .OR.
+     $        .not. OK_qx_qw(i)   ) THEN
+         wape(i) = 0.
+         cstar(i)=0.
+         hw(i) = hwmin
+         sigmaw(i) = sigmad
+         fip(i) = 0.
+        ELSE
+         wape(i) = wape2(i)
+         cstar(i)=cstar2(i)
+        ENDIF
+cc        print*,'wape wape2 ktopw OK_qx_qw =',
+cc     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
+      ENDDO
+c
+c
+      RETURN
+      END
+
+      SUBROUTINE wake_vec_modulation(nlon,nl,wk_adv,epsilon,qe,d_qe,
+     $           deltaqw,d_deltaqw,sigmaw,d_sigmaw,alpha)
+c------------------------------------------------------
+cDtermination du coefficient alpha tel que les tendances
+c corriges alpha*d_G, pour toutes les grandeurs G, correspondent
+c a une humidite positive dans la zone (x) et dans la zone (w).
+c------------------------------------------------------
+c
+ 
+c  Input
+      REAL qe(nlon,nl),d_qe(nlon,nl)
+      REAL deltaqw(nlon,nl),d_deltaqw(nlon,nl)
+      REAL sigmaw(nlon),d_sigmaw(nlon)
+      LOGICAL wk_adv(nlon)
+      INTEGER nl,nlon
+c  Output
+      REAL alpha(nlon)
+c  Internal variables
+      REAL zeta(nlon,nl)
+      REAL alpha1(nlon)
+      REAL x,a,b,c,discrim
+      REAL epsilon
+!      DATA epsilon/1.e-15/
+c
+      DO k=1,nl
+      DO i = 1,nlon
+       IF (wk_adv(i)) THEN
+        IF ((deltaqw(i,k)+d_deltaqw(i,k)).ge.0.) then
+         zeta(i,k)=0.
+        ELSE
+         zeta(i,k)=1.
+        END IF
+       ENDIF
+      ENDDO
+      DO i = 1,nlon
+       IF (wk_adv(i)) THEN
+        x = qe(i,k)+(zeta(i,k)-sigmaw(i))*deltaqw(i,k)
+     $    + d_qe(i,k)+(zeta(i,k)-sigmaw(i))*d_deltaqw(i,k)
+     $    - d_sigmaw(i)*(deltaqw(i,k)+d_deltaqw(i,k))
+        a = -d_sigmaw(i)*d_deltaqw(i,k)
+        b = d_qe(i,k)+(zeta(i,k)-sigmaw(i))*d_deltaqw(i,k)
+     $    - deltaqw(i,k)*d_sigmaw(i)
+        c = qe(i,k)+(zeta(i,k)-sigmaw(i))*deltaqw(i,k)+epsilon
+        discrim = b*b-4.*a*c
+c      print*, 'x, a, b, c, discrim', x, a, b, c, discrim
+        IF (a+b .GE. 0.) THEN !! Condition suffisante pour la positivité de ovap
+         alpha1(i)=1.
+        ELSE
+         IF (x .GE. 0.) THEN
+            alpha1(i)=1.
+         ELSE
+              IF (a .GT. 0.) THEN
+                 alpha1(i)=0.9*min(   (2.*c)/(-b+sqrt(discrim)),
+     $                        (-b+sqrt(discrim))/(2.*a)   )
+              ELSE IF (a .eq. 0.) then
+                 alpha1(i)=0.9*(-c/b)
+              ELSE
+c         print*,'a,b,c discrim',a,b,c discrim
+                 alpha1(i)=0.9*max(   (2.*c)/(-b+sqrt(discrim)),
+     $                        (-b+sqrt(discrim))/(2.*a)   )
+              ENDIF
+         ENDIF
+        ENDIF
+       alpha(i) = min(alpha(i),alpha1(i))
+       ENDIF
+      ENDDO
+      ENDDO
+!
+      return
+      end
+
+      Subroutine WAKE_scal (p,ph,ppi,dtime,sigd_con
+     :                ,te0,qe0,omgb
+     :                ,dtdwn,dqdwn,amdwn,amup,dta,dqa
+     :                ,wdtPBL,wdqPBL,udtPBL,udqPBL
+     o                ,deltatw,deltaqw,dth,hw,sigmaw,wape,fip,gfl
+     o                ,dtls,dqls
+     o                ,ktopw,omgbdth,dp_omgb,wdens
+     o                ,tu,qu
+     o                ,dtKE,dqKE
+     o                ,dtPBL,dqPBL
+     o                ,omg,dp_deltomg,spread
+     o                ,Cstar,d_deltat_gw
+     o                ,d_deltatw2,d_deltaqw2)
+
+***************************************************************
+*                                                             *
+* WAKE                                                        *
+*      retour a un Pupper fixe                                *
+*                                                             *
+* written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
+* modified by :   ROEHRIG Romain        01/29/2007            *
+***************************************************************
+c
+      USE dimphy
       IMPLICIT none
 c============================================================================
@@ -113,1643 +1942,4 @@
 
 #include "dimensions.h"
-#include "YOMCST.h"
-#include "cvthermo.h"
-#include "iniprint.h"
-
-c Arguments en entree
-c--------------------
-
-      REAL, dimension(klon,klev) :: p, ppi
-      REAL, dimension(klon,klev+1) :: ph, omgb
-      REAL dtime
-      REAL, dimension(klon,klev) :: te0,qe0
-      REAL, dimension(klon,klev) :: dtdwn, dqdwn
-      REAL, dimension(klon,klev) :: wdtPBL,wdqPBL
-      REAL, dimension(klon,klev) :: udtPBL,udqPBL
-      REAL, dimension(klon,klev) :: amdwn, amup
-      REAL, dimension(klon,klev) :: dta, dqa
-      REAL, dimension(klon) :: sigd_con
-
-c Sorties
-c--------
-
-      REAL, dimension(klon,klev) :: deltatw, deltaqw, dth
-      REAL, dimension(klon,klev) :: tu, qu
-      REAL, dimension(klon,klev) :: dtls, dqls
-      REAL, dimension(klon,klev) :: dtKE, dqKE
-      REAL, dimension(klon,klev) :: dtPBL, dqPBL
-      REAL, dimension(klon,klev) :: spread
-      REAL, dimension(klon,klev) :: d_deltatgw
-      REAL, dimension(klon,klev) :: d_deltatw2, d_deltaqw2
-      REAL, dimension(klon,klev+1) :: omgbdth, omg
-      REAL, dimension(klon,klev) :: dp_omgb, dp_deltomg
-      REAL, dimension(klon,klev) :: d_deltat_gw
-      REAL, dimension(klon) :: hw, sigmaw, wape, fip, gfl, Cstar
-      INTEGER, dimension(klon) :: ktopw
-
-c Variables internes
-c-------------------
-
-c Variables à fixer
-      REAL ALON
-      REAL coefgw
-      REAL :: wdens0, wdens
-      REAL stark
-      REAL alpk
-      REAL delta_t_min
-      INTEGER nsub
-      REAL dtimesub
-      REAL sigmad, hwmin
-      REAL :: sigmaw_max
-cIM 080208
-      LOGICAL, dimension(klon) :: gwake
-
-c Variables de sauvegarde
-      REAL, dimension(klon,klev) :: deltatw0
-      REAL, dimension(klon,klev) :: deltaqw0
-      REAL, dimension(klon,klev) :: te, qe
-      REAL, dimension(klon) :: sigmaw0, sigmaw1
-
-c Variables pour les GW
-      REAL, DIMENSION(klon) :: LL
-      REAL, dimension(klon,klev) :: N2
-      REAL, dimension(klon,klev) :: Cgw
-      REAL, dimension(klon,klev) :: Tgw
-
-c Variables liées au calcul de hw
-      REAL, DIMENSION(klon) :: ptop_provis, ptop, ptop_new
-      REAL, DIMENSION(klon) :: sum_dth
-      REAL, DIMENSION(klon) :: dthmin
-      REAL, DIMENSION(klon) :: z, dz, hw0
-      INTEGER, DIMENSION(klon) :: ktop, kupper
-
-c Sub-timestep tendencies and related variables
-       REAL d_deltatw(klon,klev),d_deltaqw(klon,klev)
-       REAL d_te(klon,klev),d_qe(klon,klev)
-       REAL d_sigmaw(klon),alpha(klon)
-       REAL q0_min(klon),q1_min(klon)
-       LOGICAL wk_adv(klon), OK_qx_qw(klon)
-
-c Autres variables internes
-      INTEGER isubstep, k, i
-
-      REAL, DIMENSION(klon) :: sum_thu, sum_tu, sum_qu,sum_thvu
-      REAL, DIMENSION(klon) :: sum_dq, sum_rho
-      REAL, DIMENSION(klon) :: sum_dtdwn, sum_dqdwn
-      REAL, DIMENSION(klon) :: av_thu, av_tu, av_qu, av_thvu
-      REAL, DIMENSION(klon) :: av_dth, av_dq, av_rho
-      REAL, DIMENSION(klon) :: av_dtdwn, av_dqdwn
-
-      REAL, DIMENSION(klon,klev) :: rho, rhow
-      REAL, DIMENSION(klon,klev+1) :: rhoh
-      REAL, DIMENSION(klon,klev) :: rhow_moyen
-      REAL, DIMENSION(klon,klev) :: zh
-      REAL, DIMENSION(klon,klev+1) :: zhh
-      REAL, DIMENSION(klon,klev) :: epaisseur1, epaisseur2
-
-      REAL, DIMENSION(klon,klev) :: the, thu
-
-!      REAL, DIMENSION(klon,klev) :: d_deltatw, d_deltaqw
-
-      REAL, DIMENSION(klon,klev+1) :: omgbw 
-      REAL, DIMENSION(klon) :: pupper
-      REAL, DIMENSION(klon) :: omgtop
-      REAL, DIMENSION(klon,klev) :: dp_omgbw
-      REAL, DIMENSION(klon) :: ztop, dztop
-      REAL, DIMENSION(klon,klev) :: alpha_up
-      
-      REAL, dimension(klon) :: RRe1, RRe2
-      REAL :: RRd1, RRd2
-      REAL, DIMENSION(klon,klev) :: Th1, Th2, q1, q2, T1 
-      REAL, DIMENSION(klon,klev) :: D_Th1, D_Th2, D_dth
-      REAL, DIMENSION(klon,klev) :: D_q1, D_q2, D_dq
-      REAL, DIMENSION(klon,klev) :: omgbdq
-
-      REAL, dimension(klon) :: ff, gg
-      REAL, dimension(klon) :: wape2, Cstar2, heff
-
-      REAL, DIMENSION(klon,klev) :: Crep
-      REAL Crep_upper, Crep_sol
-
-C-------------------------------------------------------------------------
-c         Initialisations
-c-------------------------------------------------------------------------
-
-c      print*, 'wake initialisations'
-
-c   Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
-c-------------------------------------------------------------------------
-
-      DATA sigmad, hwmin /.02,10./
-
-C Longueur de maille (en m)
-c-------------------------------------------------------------------------
-
-c      ALON = 3.e5
-      ALON = 1.e6
-
-
-C Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
-c
-c      coefgw : Coefficient pour les ondes de gravité
-c       stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
-c       wdens : Densité de poche froide par maille
-c-------------------------------------------------------------------------
-
-      coefgw=10
-c      coefgw=1
-c      wdens0 = 1.0/(alon**2)   
-      wdens = 1.0/(alon**2)       
-      stark = 0.50
-cCRtest
-      alpk=0.1
-c      alpk = 1.0 
-c      alpk = 0.5
-c      alpk = 0.05
-      Crep_upper=0.9
-      Crep_sol=1.0
-
-C Minimum value for |T_wake - T_undist|. Used for wake top definition
-c-------------------------------------------------------------------------
-
-      delta_t_min = 0.2
-
-C 1. - Save initial values and initialize tendencies
-C --------------------------------------------------
-
-      DO k=1,klev
-      DO i=1, klon
-	deltatw0(i,k) = deltatw(i,k)
-	deltaqw0(i,k)= deltaqw(i,k)
-	te(i,k) = te0(i,k)
-	qe(i,k) = qe0(i,k)
-	dtls(i,k) = 0.
-	dqls(i,k) = 0.
-        d_deltat_gw(i,k)=0.
-        d_te(i,k) = 0.
-        d_qe(i,k) = 0.
-        d_deltatw(i,k) = 0.
-        d_deltaqw(i,k) = 0.
-!IM 060508 beg
-        d_deltatw2(i,k)=0.
-        d_deltaqw2(i,k)=0.
-!IM 060508 end
-      ENDDO
-      ENDDO
-c      sigmaw1=sigmaw
-c      IF (sigd_con.GT.sigmaw1) THEN
-c      print*, 'sigmaw,sigd_con', sigmaw, sigd_con
-c      ENDIF
-      DO i=1, klon
-cc      sigmaw(i) = amax1(sigmaw(i),sigd_con(i))
-      sigmaw(i) = amax1(sigmaw(i),sigmad)
-      sigmaw(i) = amin1(sigmaw(i),0.99)
-      sigmaw0(i) = sigmaw(i)
-      wape(i) = 0.
-      wape2(i) = 0.
-      d_sigmaw(i) = 0.
-      ktopw(i) = 0
-      ENDDO
-C
-C
-C 2. - Prognostic part
-C --------------------
-C
-C
-C 2.1 - Undisturbed area and Wake integrals
-C ---------------------------------------------------------
-
-      DO i=1, klon
-      z(i) = 0.
-      ktop(i)=0
-      kupper(i) = 0
-      sum_thu(i) = 0.
-      sum_tu(i) = 0.
-      sum_qu(i) = 0.
-      sum_thvu(i) = 0.
-      sum_dth(i) = 0.
-      sum_dq(i) = 0.
-      sum_rho(i) = 0.
-      sum_dtdwn(i) = 0.
-      sum_dqdwn(i) = 0.
-
-      av_thu(i) = 0.
-      av_tu(i) =0.
-      av_qu(i) =0.
-      av_thvu(i) = 0.
-      av_dth(i) = 0.
-      av_dq(i) = 0.
-      av_rho(i) =0.
-      av_dtdwn(i) =0.
-      av_dqdwn(i) = 0.
-      ENDDO
-c
-c Distance between wakes
-       DO i = 1,klon
-        LL(i) = (1-sqrt(sigmaw(i)))/sqrt(wdens)
-       ENDDO
-C Potential temperatures and humidity
-c----------------------------------------------------------
-      DO k =1,klev
-       DO i=1, klon 
-        rho(i,k) = p(i,k)/(rd*te(i,k))
-        IF(k .eq. 1) THEN
-          rhoh(i,k) = ph(i,k)/(rd*te(i,k))
-          zhh(i,k)=0
-        ELSE
-          rhoh(i,k) = ph(i,k)*2./(rd*(te(i,k)+te(i,k-1)))
-          zhh(i,k)=(ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG)+zhh(i,k-1)
-        ENDIF
-        the(i,k) = te(i,k)/ppi(i,k)
-        thu(i,k) = (te(i,k) - deltatw(i,k)*sigmaw(i))/ppi(i,k)
-        tu(i,k) = te(i,k) - deltatw(i,k)*sigmaw(i)
-        qu(i,k)  =  qe(i,k) - deltaqw(i,k)*sigmaw(i)
-        rhow(i,k) = p(i,k)/(rd*(tu(i,k)+deltatw(i,k)))
-        dth(i,k) = deltatw(i,k)/ppi(i,k)
-       ENDDO
-      ENDDO
-        
-      DO k = 1, klev-1
-      DO i=1, klon 
-        IF(k.eq.1) THEN
-          N2(i,k)=0
-        ELSE
-          N2(i,k)=amax1(0.,-RG**2/the(i,k)*rho(i,k)*(the(i,k+1)-
-     $            the(i,k-1))/(p(i,k+1)-p(i,k-1)))
-        ENDIF
-        ZH(i,k)=(zhh(i,k)+zhh(i,k+1))/2
-
-        Cgw(i,k)=sqrt(N2(i,k))*ZH(i,k)
-        Tgw(i,k)=coefgw*Cgw(i,k)/LL(i)
-      ENDDO
-      ENDDO
-
-      DO i=1, klon
-      N2(i,klev)=0
-      ZH(i,klev)=0
-      Cgw(i,klev)=0
-      Tgw(i,klev)=0
-      ENDDO
-
-c  Calcul de la masse volumique moyenne de la colonne   (bdlmd)
-c-----------------------------------------------------------------
-
-      DO k=1,klev
-       DO i=1, klon
-        epaisseur1(i,k)=0.
-        epaisseur2(i,k)=0.
-       ENDDO
-      ENDDO
-
-      DO i=1, klon
-      epaisseur1(i,1)= -(ph(i,2)-ph(i,1))/(rho(i,1)*rg)+1.
-      epaisseur2(i,1)= -(ph(i,2)-ph(i,1))/(rho(i,1)*rg)+1.
-      rhow_moyen(i,1) = rhow(i,1)
-      ENDDO
-
-      DO k = 2, klev
-      DO i=1, klon
-        epaisseur1(i,k)= -(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg) +1.
-        epaisseur2(i,k)=epaisseur2(i,k-1)+epaisseur1(i,k)
-        rhow_moyen(i,k) = (rhow_moyen(i,k-1)*epaisseur2(i,k-1)+
-     $                 rhow(i,k)*epaisseur1(i,k))/epaisseur2(i,k)
-      ENDDO
-      ENDDO
-
-C
-C Choose an integration bound well above wake top
-c-----------------------------------------------------------------
-c
-C       Pupper = 50000.  ! melting level
-c       Pupper = 60000.
-c       Pupper = 80000.  ! essais pour case_e
-       DO i = 1,klon
-ccc       Pupper(i) = 0.6*ph(i,1)
-        Pupper(i) = 60000.
-       ENDDO
-
-C
-C    Determine Wake top pressure (Ptop) from buoyancy integral
-C    --------------------------------------------------------
-c
-c-1/ Pressure of the level where dth becomes less than delta_t_min.
-
-      DO i=1,klon
-      ptop_provis(i)=ph(i,1)
-      ENDDO
-      DO k= 2,klev
-      DO i=1,klon
-c
-cIM v3JYG; ptop_provis(i).LT. ph(i,1)
-c
-        IF (dth(i,k) .GT. -delta_t_min .and.
-     $      dth(i,k-1).LT. -delta_t_min .and.
-     $      ptop_provis(i).EQ. ph(i,1)) THEN
-          ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
-     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /
-     $          (dth(i,k) - dth(i,k-1))
-        ENDIF
-      ENDDO
-      ENDDO
-
-c-2/ dth integral
-
-      DO i=1,klon
-      sum_dth(i) = 0.
-      dthmin(i) = -delta_t_min
-      z(i) = 0.
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-        dz(i) = -(amax1(ph(i,k+1),ptop_provis(i))-Ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i) .gt. 0) THEN
-          z(i) = z(i)+dz(i)
-          sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
-          dthmin(i) = amin1(dthmin(i),dth(i,k))
-        ENDIF
-      ENDDO
-      ENDDO
-
-c-3/ height of triangle with area= sum_dth and base = dthmin
-
-      DO i=1,klon
-      hw0(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
-      hw0(i) = amax1(hwmin,hw0(i))
-      ENDDO
-
-c-4/ now, get Ptop
-
-      DO i=1,klon
-      z(i) = 0.
-      ptop(i) = ph(i,1)
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-        dz(i) = amin1(-(ph(i,k+1)-ph(i,k))/(rho(i,k)*rg),hw0(i)-z(i))
-        IF (dz(i) .gt. 0) THEN
-         z(i) = z(i)+dz(i)
-         ptop(i) = ph(i,k)-rho(i,k)*rg*dz(i)
-        ENDIF
-      ENDDO
-      ENDDO
-
-
-C-5/ Determination de ktop et kupper
-
-      DO k=klev,1,-1
-      DO i=1,klon
-        IF (ph(i,k+1) .lt. ptop(i)) ktop(i)=k
-        IF (ph(i,k+1) .lt. pupper(i)) kupper(i)=k
-      ENDDO
-      ENDDO
-
-c-6/ Correct ktop and ptop
-
-      DO i = 1,klon
-        ptop_new(i)=ptop(i)
-      ENDDO
-      DO k= klev,2,-1
-      DO i=1,klon
-        IF (k .LE. ktop(i) .and.
-     $      ptop_new(i) .EQ. ptop(i) .and.
-     $      dth(i,k) .GT. -delta_t_min .and.
-     $      dth(i,k-1).LT. -delta_t_min) THEN
-          ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
-     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /
-     $          (dth(i,k) - dth(i,k-1))
-        ENDIF
-      ENDDO
-      ENDDO
-
-      DO i=1,klon
-        ptop(i) = ptop_new(i)
-      ENDDO
-
-      DO k=klev,1,-1
-      DO i=1,klon
-        IF (ph(i,k+1) .lt. ptop(i)) ktop(i)=k
-      ENDDO
-      ENDDO
-c
-c-5/ Set deltatw & deltaqw to 0 above kupper
-c
-      DO k = 1,klev
-      DO i=1,klon
-       IF (k.GE. kupper(i)) THEN
-        deltatw(i,k) = 0.
-        deltaqw(i,k) = 0.
-       ENDIF
-      ENDDO
-      ENDDO
-c
-C
-C Vertical gradient of LS omega
-C
-      DO k = 1,klev
-      DO i=1,klon
-       IF (k.LE. kupper(i)) THEN
-        dp_omgb(i,k) = (omgb(i,k+1) - omgb(i,k))/(ph(i,k+1)-ph(i,k))
-       ENDIF
-      ENDDO
-      ENDDO
-C
-C Integrals (and wake top level number)
-C --------------------------------------
-C
-C Initialize sum_thvu to 1st level virt. pot. temp.
-
-      DO i=1,klon
-      z(i) = 1.
-      dz(i) = 1.
-      sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
-      sum_dth(i) = 0.
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i) .GT. 0) THEN
-         z(i) = z(i)+dz(i)
-         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
-         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
-         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
-         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
-         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
-         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
-         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
-         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
-         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
-        ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i=1,klon
-        hw0(i) = z(i)
-      ENDDO
-c
-C
-C 2.1 - WAPE and mean forcing computation
-C ---------------------------------------
-C
-C ---------------------------------------
-C
-C Means
-
-      DO i=1,klon
-      av_thu(i) = sum_thu(i)/hw0(i)
-      av_tu(i) = sum_tu(i)/hw0(i)
-      av_qu(i) = sum_qu(i)/hw0(i)
-      av_thvu(i) = sum_thvu(i)/hw0(i)
-c      av_thve = sum_thve/hw0
-      av_dth(i) = sum_dth(i)/hw0(i)
-      av_dq(i) = sum_dq(i)/hw0(i)
-      av_rho(i) = sum_rho(i)/hw0(i)
-      av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-      av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-      wape(i) = - rg*hw0(i)*(av_dth(i)
-     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*
-     $     av_dq(i) ))/av_thvu(i)
-      ENDDO
-C
-C 2.2 Prognostic variable update
-C ------------------------------
-C
-C Filter out bad wakes
-
-      DO k = 1,klev
-       DO i=1,klon
-        IF ( wape(i) .LT. 0.) THEN
-          deltatw(i,k) = 0.
-          deltaqw(i,k) = 0.
-          dth(i,k) = 0.
-        ENDIF
-       ENDDO
-      ENDDO
-c
-      DO i=1,klon
-      IF ( wape(i) .LT. 0.) THEN
-        wape(i) = 0.
-        Cstar(i) = 0.
-        hw(i) = hwmin
-        sigmaw(i) = amax1(sigmad,sigd_con(i))
-        fip(i) = 0.
-        gwake(i) = .FALSE.
-      ELSE
-        Cstar(i) = stark*sqrt(2.*wape(i))
-        gwake(i) = .TRUE.
-      ENDIF
-      ENDDO
-
-c
-c Check qx and qw positivity
-c --------------------------
-      DO i = 1,klon
-       q0_min(i)=min(  (qe(i,1)-sigmaw(i)*deltaqw(i,1)),
-     $              (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1))  )
-      ENDDO
-      DO k = 2,klev
-      DO i = 1,klon
-        q1_min(i)=min(  (qe(i,k)-sigmaw(i)*deltaqw(i,k)),
-     $              (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k))  )
-        IF (q1_min(i).le.q0_min(i)) THEN
-          q0_min(i)=q1_min(i)
-        ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1,klon
-       OK_qx_qw(i) = q0_min(i) .GE. 0.
-       alpha(i) = 1.
-      ENDDO
-c
-CC -----------------------------------------------------------------
-C    Sub-time-stepping
-C    -----------------
-C
-      nsub=10
-      dtimesub=dtime/nsub
-c
-c------------------------------------------------------------
-      DO isubstep = 1,nsub
-c------------------------------------------------------------
-c
-c wk_adv is the logical flag enabling wake evolution in the time advance loop
-      DO i = 1,klon
-       wk_adv(i) = OK_qx_qw(i) .AND. alpha(i) .GE. 1.
-      ENDDO
-c
-      DO i=1,klon
-        IF (wk_adv(i)) THEN
-        gfl(i) = 2.*sqrt(3.14*wdens*sigmaw(i))
-        ENDIF
-      ENDDO
-      DO i=1,klon
-        IF (wk_adv(i)) THEN
-         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
-c        sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
-c        sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
-c        wdens = wdens0/(10.*sigmaw)
-c        sigmaw =max(sigmaw,sigd_con)
-c        sigmaw =max(sigmaw,sigmad)
-        ENDIF
-      ENDDO
-C
-C
-c calcul de la difference de vitesse verticale poche - zone non perturbee
-cIM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
-cIM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
-cIM 060208 au niveau k=1..?
-      DO k= 1,klev
-      DO i = 1,klon
-        dp_deltomg(i,k)=0.
-      ENDDO
-      ENDDO
-      DO k= 1,klev+1
-      DO i = 1,klon
-        omg(i,k)=0.
-      ENDDO
-      ENDDO
-c
-      DO i=1,klon
-        IF (wk_adv(i)) THEN
-        z(i)= 0.
-        omg(i,1) = 0.
-        dp_deltomg(i,1) = -(gfl(i)*Cstar(i))/(sigmaw(i) * (1-sigmaw(i)))
-        ENDIF
-      ENDDO
-c
-      DO k= 2,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
-          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*rg)
-          z(i) = z(i)+dz(i)
-          dp_deltomg(i,k)= dp_deltomg(i,1)
-          omg(i,k)= dp_deltomg(i,1)*z(i)
-       ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1,klon
-        IF (wk_adv(i)) THEN
-        dztop(i)=-(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*rg)
-        ztop(i) = z(i)+dztop(i)
-        omgtop(i)=dp_deltomg(i,1)*ztop(i)
-        ENDIF
-      ENDDO
-c
-c        -----------------
-c        From m/s to Pa/s
-c        -----------------
-c
-       DO i=1,klon
-        IF (wk_adv(i)) THEN
-        omgtop(i) = -rho(i,ktop(i))*rg*omgtop(i)
-        dp_deltomg(i,1) = omgtop(i)/(ptop(i)-ph(i,1))
-        ENDIF
-       ENDDO
-c
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
-          omg(i,k) = - rho(i,k)*rg*omg(i,k)
-          dp_deltomg(i,k) = dp_deltomg(i,1)
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c   raccordement lineaire de omg de ptop a pupper
-
-      DO i=1,klon
-      IF ( wk_adv(i) .AND. kupper(i) .GT. ktop(i)) THEN
-        omg(i,kupper(i)+1) = - Rg*amdwn(i,kupper(i)+1)/sigmaw(i)
-     $                + Rg*amup(i,kupper(i)+1)/(1.-sigmaw(i))
-        dp_deltomg(i,kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/
-     $                     (ptop(i)-pupper(i))
-      ENDIF
-      ENDDO
-c
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .GT. ktop(i) .AND. k .LE. kupper(i)) THEN
-          dp_deltomg(i,k) = dp_deltomg(i,kupper(i))
-          omg(i,k) = omgtop(i)+(ph(i,k)-ptop(i))*dp_deltomg(i,kupper(i))
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c
-c--    Compute wake average vertical velocity omgbw
-c
-c
-      DO k = 1,klev+1
-      DO i=1,klon
-        IF ( wk_adv(i)) THEN
-        omgbw(i,k) = omgb(i,k)+(1.-sigmaw(i))*omg(i,k)
-        ENDIF
-      ENDDO
-      ENDDO
-c--    and its vertical gradient dp_omgbw
-c
-      DO k = 1,klev
-      DO i=1,klon
-        IF ( wk_adv(i)) THEN
-        dp_omgbw(i,k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
-        ENDIF
-      ENDDO
-      ENDDO
-C
-c--    Upstream coefficients for omgb velocity
-c--    (alpha_up(k) is the coefficient of the value at level k)
-c--    (1-alpha_up(k) is the coefficient of the value at level k-1)
-      DO k = 1,klev
-      DO i=1,klon
-        IF ( wk_adv(i)) THEN
-         alpha_up(i,k) = 0.
-         IF (omgb(i,k) .GT. 0.) alpha_up(i,k) = 1.
-        ENDIF
-      ENDDO
-      ENDDO
-
-c  Matrix expressing [The,deltatw] from  [Th1,Th2]
-
-      DO i=1,klon
-        IF ( wk_adv(i)) THEN
-         RRe1(i) = 1.-sigmaw(i)
-         RRe2(i) = sigmaw(i)
-        ENDIF
-      ENDDO
-      RRd1 = -1.
-      RRd2 = 1.
-c
-c--    Get [Th1,Th2], dth and [q1,q2]
-c
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
-        dth(i,k) = deltatw(i,k)/ppi(i,k)
-        Th1(i,k) = the(i,k) - sigmaw(i)     *dth(i,k)   ! undisturbed area
-        Th2(i,k) = the(i,k) + (1.-sigmaw(i))*dth(i,k)   ! wake
-        q1(i,k) = qe(i,k) - sigmaw(i)     *deltaqw(i,k) ! undisturbed area
-        q2(i,k) = qe(i,k) + (1.-sigmaw(i))*deltaqw(i,k) ! wake
-        T1(i,k) = te(i,k) - sigmaw(i)*deltatw(i,k)! undisturb itlmd
-       ENDIF
-      ENDDO
-      ENDDO
-
-      DO i=1,klon
-       D_Th1(i,1) = 0.   !!!itlmd : ne pas mettre if wk_adv cf nrlmd?
-       D_Th2(i,1) = 0.
-       D_dth(i,1) = 0.
-       D_q1(i,1) = 0.
-       D_q2(i,1) = 0.
-       D_dq(i,1) = 0.
-      ENDDO
-
-      DO k= 2,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
-        D_Th1(i,k) = Th1(i,k-1)-Th1(i,k)
-        D_Th2(i,k) = Th2(i,k-1)-Th2(i,k)
-        D_dth(i,k) = dth(i,k-1)-dth(i,k)
-        D_q1(i,k) = q1(i,k-1)-q1(i,k)
-        D_q2(i,k) = q2(i,k-1)-q2(i,k)
-        D_dq(i,k) = deltaqw(i,k-1)-deltaqw(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-
-      DO i=1,klon
-        IF( wk_adv(i)) THEN
-         omgbdth(i,1) = 0.
-         omgbdq(i,1) = 0.
-        ENDIF
-      ENDDO
-
-      DO k= 2,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN  !   loop on interfaces
-        omgbdth(i,k) = omgb(i,k)*(    dth(i,k-1) -     dth(i,k))
-        omgbdq(i,k)  = omgb(i,k)*(deltaqw(i,k-1) - deltaqw(i,k))
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c-----------------------------------------------------------------
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
-c-----------------------------------------------------------------
-c
-c   Compute redistribution (advective) term
-c
-         d_deltatw(i,k) =
-     $             dtimesub/(Ph(i,k)-Ph(i,k+1))*(
-     $       RRd1*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
-     $      -RRd2*omg(i,k+1)*(1.-sigmaw(i))*D_Th2(i,k+1)
-     $      -(1.-alpha_up(i,k))*omgbdth(i,k) - alpha_up(i,k+1)*
-     $      omgbdth(i,k+1))*ppi(i,k)
-c         print*,'d_deltatw=',d_deltatw(i,k)
-c
-         d_deltaqw(i,k) =
-     $             dtimesub/(Ph(i,k)-Ph(i,k+1))*(
-     $       RRd1*omg(i,k  )*sigmaw(i)     *D_q1(i,k)
-     $      -RRd2*omg(i,k+1)*(1.-sigmaw(i))*D_q2(i,k+1)
-     $      -(1.-alpha_up(i,k))*omgbdq(i,k) - alpha_up(i,k+1)*
-     $      omgbdq(i,k+1))
-c         print*,'d_deltaqw=',d_deltaqw(i,k)
-c
-c   and increment large scale tendencies
-c
-
-c
-C
-CC -----------------------------------------------------------------
-         d_te(i,k) =  dtimesub*(
-     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
-     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_Th2(i,k+1) )
-     $               /(Ph(i,k)-Ph(i,k+1))
-     $         -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*
-     $            (omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1)) !instead of dp_deltomg(i,k) 
-     $                      )*ppi(i,k)
-c
-         d_qe(i,k) =  dtimesub*(
-     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_q1(i,k)
-     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_q2(i,k+1) )
-     $               /(Ph(i,k)-Ph(i,k+1))
-     $         -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*
-     $           (omg(i,k)-omg(i,k+1))/(Ph(i,k)-Ph(i,k+1))!instead of dp_deltomg(i,k)
-     $                      )
-        ELSE IF(wk_adv(i) .AND. k .EQ. kupper(i)) THEN ! corr pour conserver l'eau
-
-         d_te(i,k) =  dtimesub*(
-     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_Th1(i,k))
-     $               /(Ph(i,k)-Ph(i,k+1))
-     $                      )*ppi(i,k)
-
-         d_qe(i,k) =  dtimesub*(
-     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_q1(i,k))
-     $               /(Ph(i,k)-Ph(i,k+1))
-     $                      )
-       ENDIF
-
-c-------------------------------------------------------------------
-      ENDDO
-      ENDDO
-c------------------------------------------------------------------
-C
-C   Increment state variables
-
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
-c
-c Coefficient de répartition
-
-        Crep(i,k)=Crep_sol*(ph(i,kupper(i))-ph(i,k))/(ph(i,kupper(i))
-     $          -ph(i,1))
-        Crep(i,k)=Crep(i,k)+Crep_upper*(ph(i,1)-ph(i,k))/(p(i,1)-
-     $          ph(i,kupper(i)))
-        
-
-c Reintroduce compensating subsidence term.
-
-c        dtKE(k)=(dtdwn(k)*Crep(k))/sigmaw
-c        dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k))
-c     .                   /(1-sigmaw)
-c        dqKE(k)=(dqdwn(k)*Crep(k))/sigmaw
-c        dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k))
-c     .                   /(1-sigmaw)
-c
-c        dtKE(k)=(dtdwn(k)*Crep(k)+(1-Crep(k))*dta(k))/sigmaw
-c        dtKE(k)=dtKE(k)-(dtdwn(k)*(1-Crep(k))+dta(k)*Crep(k))
-c     .                   /(1-sigmaw)
-c        dqKE(k)=(dqdwn(k)*Crep(k)+(1-Crep(k))*dqa(k))/sigmaw
-c        dqKE(k)=dqKE(k)-(dqdwn(k)*(1-Crep(k))+dqa(k)*Crep(k))
-c     .                   /(1-sigmaw)
-
-        dtKE(i,k)=(dtdwn(i,k)/sigmaw(i) - dta(i,k)/(1.-sigmaw(i)))
-        dqKE(i,k)=(dqdwn(i,k)/sigmaw(i) - dqa(i,k)/(1.-sigmaw(i)))
-c        print*,'dtKE=',dtKE(k)
-c        print*,'dqKE=',dqKE(k)
-c
-        dtPBL(i,k)=(wdtPBL(i,k)/sigmaw(i) - udtPBL(i,k)/(1.-sigmaw(i)))
-        dqPBL(i,k)=(wdqPBL(i,k)/sigmaw(i) - udqPBL(i,k)/(1.-sigmaw(i)))
-c
-        spread(i,k) = (1.-sigmaw(i))*dp_deltomg(i,k)+gfl(i)*Cstar(i)/
-     $  sigmaw(i)
-
-
-c ajout d'un effet onde de gravité -Tgw(k)*deltatw(k) 03/02/06 YU Jingmei
-
-        d_deltat_gw(i,k)=d_deltat_gw(i,k)-Tgw(i,k)*deltatw(i,k)* 
-     $  dtimesub
-        ff(i)=d_deltatw(i,k)/dtimesub
-
-c Sans GW
-c
-c        deltatw(k)=deltatw(k)+dtimesub*(ff+dtKE(k)-spread(k)*deltatw(k)) 
-c
-c GW formule 1
-c
-c        deltatw(k) = deltatw(k)+dtimesub*
-c     $         (ff+dtKE(k) - spread(k)*deltatw(k)-Tgw(k)*deltatw(k))
-c
-c GW formule 2
-
-        IF (dtimesub*Tgw(i,k).lt.1.e-10) THEN
-          d_deltatw(i,k) = dtimesub*
-     $          (ff(i)+dtKE(i,k)+dtPBL(i,k)
-     $          - spread(i,k)*deltatw(i,k)-Tgw(i,k)*deltatw(i,k))
-        ELSE
-           d_deltatw(i,k) = 1/Tgw(i,k)*(1-exp(-dtimesub*
-     $          Tgw(i,k)))*
-     $          (ff(i)+dtKE(i,k)+dtPBL(i,k)
-     $          - spread(i,k)*deltatw(i,k)-Tgw(i,k)*deltatw(i,k))
-        ENDIF
-
-        dth(i,k) = deltatw(i,k)/ppi(i,k)
-
-        gg(i)=d_deltaqw(i,k)/dtimesub
-
-       d_deltaqw(i,k) = dtimesub*(gg(i)+ dqKE(i,k)+dqPBL(i,k)
-     $                            - spread(i,k)*deltaqw(i,k))
-
-       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
-       d_deltaqw2(i,k)=d_deltaqw2(i,k)+d_deltaqw(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-
-C
-C   Scale tendencies so that water vapour remains positive in w and x.
-C
-      call wake_vec_modulation(klon,klev,wk_adv,qe,d_qe,deltaqw,
-     $                d_deltaqw,sigmaw,d_sigmaw,alpha)
-c
-      DO k = 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
-        d_te(i,k)=alpha(i)*d_te(i,k)
-        d_qe(i,k)=alpha(i)*d_qe(i,k)
-        d_deltatw(i,k)=alpha(i)*d_deltatw(i,k)
-        d_deltaqw(i,k)=alpha(i)*d_deltaqw(i,k)
-        d_deltat_gw(i,k)=alpha(i)*d_deltat_gw(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1,klon
-       IF( wk_adv(i)) THEN
-        d_sigmaw(i)=alpha(i)*d_sigmaw(i)
-       ENDIF
-      ENDDO
-
-C   Update large scale variables and wake variables
-cIM 060208 manque DO i + remplace DO k=1,kupper(i)
-cIM 060208     DO k = 1,kupper(i)
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
-        dtls(i,k)=dtls(i,k)+d_te(i,k)
-        dqls(i,k)=dqls(i,k)+d_qe(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-      DO k= 1,klev
-      DO i = 1,klon
-       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
-        te(i,k) = te0(i,k) + dtls(i,k)
-        qe(i,k) = qe0(i,k) + dqls(i,k)
-        the(i,k) = te(i,k)/ppi(i,k)
-        deltatw(i,k) = deltatw(i,k)+d_deltatw(i,k)
-        deltaqw(i,k) = deltaqw(i,k)+d_deltaqw(i,k)
-        dth(i,k) = deltatw(i,k)/ppi(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-      DO i = 1,klon
-       IF( wk_adv(i)) THEN
-        sigmaw(i) = sigmaw(i)+d_sigmaw(i)
-       ENDIF
-      ENDDO
-c
-C
-c     Determine Ptop from buoyancy integral
-c     ---------------------------------------
-c
-c-     1/ Pressure of the level where dth changes sign.
-c
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        Ptop_provis(i)=ph(i,1)
-       ENDIF
-      ENDDO
-c
-      DO k= 2,klev
-      DO i=1,klon
-        IF ( wk_adv(i) .AND.
-     $       Ptop_provis(i) .EQ. ph(i,1) .AND.
-     $      dth(i,k) .GT. -delta_t_min .and.
-     $      dth(i,k-1).LT. -delta_t_min) THEN
-          Ptop_provis(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
-     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /(dth(i,k)
-     $          - dth(i,k-1))
-        ENDIF
-      ENDDO
-      ENDDO
-c
-c-     2/ dth integral
-c
-      DO i=1,klon
-       sum_dth(i) = 0.
-       dthmin(i) = -delta_t_min
-       z(i) = 0.
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        dz(i) = -(amax1(ph(i,k+1),Ptop_provis(i))-Ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i) .gt. 0) THEN
-         z(i) = z(i)+dz(i)
-         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
-         dthmin(i) = amin1(dthmin(i),dth(i,k))
-        ENDIF
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c-     3/ height of triangle with area= sum_dth and base = dthmin
-
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-         hw(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
-         hw(i) = amax1(hwmin,hw(i))
-       ENDIF
-      ENDDO
-c
-c-     4/ now, get Ptop
-c
-      DO i=1,klon
-       ktop(i) = 0
-       z(i)=0.
-      ENDDO
-c
-      DO k = 1,klev
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        dz(i) = amin1(-(ph(i,k+1)-Ph(i,k))/(rho(i,k)*rg),hw(i)-z(i))
-        IF (dz(i) .gt. 0) THEN
-         z(i) = z(i)+dz(i)
-         Ptop(i) = Ph(i,k)-rho(i,k)*rg*dz(i)
-         ktop(i) = k
-        ENDIF
-       ENDIF
-      ENDDO
-      ENDDO
-c
-c      4.5/Correct ktop and ptop
-c
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        Ptop_new(i)=ptop(i)
-       ENDIF
-      ENDDO
-c
-      DO k= klev,2,-1
-      DO i=1,klon
-cIM v3JYG; IF (k .GE. ktop(i)
-       IF ( wk_adv(i) .AND.
-     $      k .LE. ktop(i) .AND.
-     $      ptop_new(i) .EQ. ptop(i) .AND.
-     $      dth(i,k) .GT. -delta_t_min .and.
-     $      dth(i,k-1).LT. -delta_t_min) THEN
-          Ptop_new(i) = ((dth(i,k)+delta_t_min)*p(i,k-1)
-     $          - (dth(i,k-1)+delta_t_min)*p(i,k)) /(dth(i,k)
-     $          - dth(i,k-1))
-        ENDIF
-      ENDDO
-      ENDDO
-c
-c
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        ptop(i) = ptop_new(i)
-       ENDIF
-      ENDDO
-
-      DO k=klev,1,-1
-      DO i=1,klon
-        IF (ph(i,k+1) .LT. ptop(i)) ktop(i)=k
-      ENDDO
-      ENDDO
-c
-c      5/ Set deltatw & deltaqw to 0 above kupper
-c
-      DO k = 1,klev
-      DO i=1,klon
-        IF ( wk_adv(i) .AND. k .GE. kupper(i)) THEN
-         deltatw(i,k) = 0.
-         deltaqw(i,k) = 0.
-        ENDIF
-      ENDDO
-      ENDDO
-c
-C
-c-------------Cstar computation---------------------------------
-      DO i=1, klon
-      sum_thu(i) = 0.
-      sum_tu(i) = 0.
-      sum_qu(i) = 0.
-      sum_thvu(i) = 0.
-      sum_dth(i) = 0.
-      sum_dq(i) = 0.
-      sum_rho(i) = 0.
-      sum_dtdwn(i) = 0.
-      sum_dqdwn(i) = 0.
-
-      av_thu(i) = 0.
-      av_tu(i) =0.
-      av_qu(i) =0.
-      av_thvu(i) = 0.
-      av_dth(i) = 0.
-      av_dq(i) = 0.
-      av_rho(i) =0.
-      av_dtdwn(i) =0.
-      av_dqdwn(i) = 0.
-      ENDDO
-C
-C Integrals (and wake top level number)
-C --------------------------------------
-C
-C Initialize sum_thvu to 1st level virt. pot. temp.
-
-      DO i=1,klon
-      z(i) = 1.
-      dz(i) = 1.
-      sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
-      sum_dth(i) = 0.
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-        dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i) .GT. 0) THEN
-         z(i) = z(i)+dz(i)
-         sum_thu(i) = sum_thu(i) + th1(i,k)*dz(i)
-         sum_tu(i) = sum_tu(i) + t1(i,k)*dz(i)
-         sum_qu(i) = sum_qu(i) + q1(i,k)*dz(i)
-         sum_thvu(i) = sum_thvu(i) + th1(i,k)*(1.+eps*q1(i,k))*dz(i)!itlmd
-
-         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
-         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
-         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
-         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
-         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
-        ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i=1,klon
-        hw0(i) = z(i)
-      ENDDO
-c
-C
-C - WAPE and mean forcing computation
-C ---------------------------------------
-C
-C ---------------------------------------
-C
-C Means
-
-      DO i=1,klon
-       av_thu(i) = sum_thu(i)/hw0(i)
-       av_tu(i) = sum_tu(i)/hw0(i)
-       av_qu(i) = sum_qu(i)/hw0(i)
-       av_thvu(i) = sum_thvu(i)/hw0(i)
-       av_dth(i) = sum_dth(i)/hw0(i)
-       av_dq(i) = sum_dq(i)/hw0(i)
-       av_rho(i) = sum_rho(i)/hw0(i)
-       av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-       av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-c
-       wape(i) = - rg*hw0(i)*(av_dth(i)
-     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*
-     $     av_dq(i) ))/av_thvu(i)
-      ENDDO
-C
-C Filter out bad wakes
-
-      DO k = 1,klev
-       DO i=1,klon
-        IF ( wape(i) .LT. 0.) THEN
-          deltatw(i,k) = 0.
-          deltaqw(i,k) = 0.
-          dth(i,k) = 0.
-        ENDIF
-       ENDDO
-      ENDDO
-c
-      DO i=1,klon
-      IF ( wape(i) .LT. 0.) THEN
-        wape(i) = 0.
-        Cstar(i) = 0.
-        hw(i) = hwmin
-        sigmaw(i) = max(sigmad,sigd_con(i))
-        fip(i) = 0.
-        gwake(i) = .FALSE.
-      ELSE
-        Cstar(i) = stark*sqrt(2.*wape(i))
-        gwake(i) = .TRUE.
-      ENDIF
-      ENDDO
-
-       ENDDO      ! end sub-timestep loop
-C
-C -----------------------------------------------------------------
-c   Get back to tendencies per second
-c
-      DO k = 1,klev
-      DO i=1,klon
-       IF ( wk_adv(i) .AND. k .LE. kupper(i)) THEN  !! corr conservation eau
-         dtls(i,k) = dtls(i,k)/dtime
-         dqls(i,k) = dqls(i,k)/dtime
-         d_deltatw2(i,k)=d_deltatw2(i,k)/dtime
-         d_deltaqw2(i,k)=d_deltaqw2(i,k)/dtime
-         d_deltat_gw(i,k) = d_deltat_gw(i,k)/dtime
-        ENDIF
-      ENDDO
-      ENDDO
-c
-c
-c----------------------------------------------------------
-c   Determine wake final state; recompute wape, cstar, ktop;
-c   filter out bad wakes.
-c----------------------------------------------------------
-c
-C 2.1 - Undisturbed area and Wake integrals
-C ---------------------------------------------------------
-
-      DO i=1,klon
-        z(i) = 0.
-        sum_thu(i) = 0.
-        sum_tu(i) = 0.
-        sum_qu(i) = 0.
-        sum_thvu(i) = 0.
-        sum_dth(i) = 0.
-        sum_dq(i) = 0.
-        sum_rho(i) = 0.
-        sum_dtdwn(i) = 0.
-        sum_dqdwn(i) = 0.
-
-        av_thu(i) = 0.
-        av_tu(i) =0.
-        av_qu(i) =0.
-        av_thvu(i) = 0.
-        av_dth(i) = 0.
-        av_dq(i) = 0.
-        av_rho(i) =0.
-        av_dtdwn(i) =0.
-        av_dqdwn(i) = 0.
-      ENDDO
-C Potential temperatures and humidity
-c----------------------------------------------------------
-
-      DO k =1,klev
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        rho(i,k) = p(i,k)/(rd*te(i,k))
-        IF(k .eq. 1) THEN
-          rhoh(i,k) = ph(i,k)/(rd*te(i,k))
-          zhh(i,k)=0
-        ELSE
-          rhoh(i,k) = ph(i,k)*2./(rd*(te(i,k)+te(i,k-1)))
-          zhh(i,k)=(ph(i,k)-ph(i,k-1))/(-rhoh(i,k)*RG)+zhh(i,k-1)
-        ENDIF
-        the(i,k) = te(i,k)/ppi(i,k)
-        thu(i,k) = (te(i,k) - deltatw(i,k)*sigmaw(i))/ppi(i,k)
-        tu(i,k) = te(i,k) - deltatw(i,k)*sigmaw(i)
-        qu(i,k)  =  qe(i,k) - deltaqw(i,k)*sigmaw(i)
-        rhow(i,k) = p(i,k)/(rd*(tu(i,k)+deltatw(i,k)))
-        dth(i,k) = deltatw(i,k)/ppi(i,k)
-       ENDIF
-      ENDDO
-      ENDDO
-
-C Integrals (and wake top level number)
-C -----------------------------------------------------------
-
-C Initialize sum_thvu to 1st level virt. pot. temp.
-
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        z(i) = 1.
-        dz(i) = 1.
-        sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
-        sum_dth(i) = 0.
-      ENDIF
-      ENDDO
-
-      DO k = 1,klev
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
-        IF (dz(i) .GT. 0) THEN
-         z(i) = z(i)+dz(i)
-         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
-         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
-         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
-         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
-         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
-         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
-         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
-         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
-         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
-        ENDIF
-       ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i=1,klon
-       IF ( wk_adv(i)) THEN
-        hw0(i) = z(i)
-       ENDIF
-      ENDDO
-c
-C - WAPE and mean forcing computation
-C-------------------------------------------------------------
-
-C Means
-
-      DO i=1, klon
-       IF ( wk_adv(i)) THEN
-        av_thu(i) = sum_thu(i)/hw0(i)
-        av_tu(i) = sum_tu(i)/hw0(i)
-        av_qu(i) = sum_qu(i)/hw0(i)
-        av_thvu(i) = sum_thvu(i)/hw0(i)
-        av_dth(i) = sum_dth(i)/hw0(i)
-        av_dq(i) = sum_dq(i)/hw0(i)
-        av_rho(i) = sum_rho(i)/hw0(i)
-        av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
-        av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
-
-        wape2(i) = - rg*hw0(i)*(av_dth(i)
-     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+
-     $     av_dth(i)*av_dq(i) ))/av_thvu(i)
-       ENDIF
-      ENDDO
-
-C Prognostic variable update
-C ------------------------------------------------------------
-
-C Filter out bad wakes
-c
-      DO k = 1,klev
-      DO i=1,klon
-        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
-          deltatw(i,k) = 0.
-          deltaqw(i,k) = 0.
-          dth(i,k) = 0.
-        ENDIF
-      ENDDO
-      ENDDO
-c
-
-      DO i=1, klon
-       IF ( wk_adv(i)) THEN
-       IF ( wape2(i) .LT. 0.) THEN
-        wape2(i) = 0.
-        Cstar2(i) = 0.
-        hw(i) = hwmin
-        sigmaw(i) = amax1(sigmad,sigd_con(i))
-        fip(i) = 0.
-        gwake(i) = .FALSE.
-      ELSE
-        if(prt_level.ge.10) print*,'wape2>0'
-        Cstar2(i) = stark*sqrt(2.*wape2(i))
-        gwake(i) = .TRUE.
-      ENDIF
-      ENDIF
-      ENDDO
-c
-      DO i=1, klon
-       IF ( wk_adv(i)) THEN
-        ktopw(i) = ktop(i)
-       ENDIF
-      ENDDO
-c
-      DO i=1, klon
-       IF ( wk_adv(i)) THEN
-       IF (ktopw(i) .gt. 0 .and. gwake(i)) then
-
-Cjyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
-ccc       heff = 600.
-C      Utilisation de la hauteur hw
-cc       heff = 0.7*hw
-       heff(i) = hw(i)
-
-       FIP(i) = 0.5*rho(i,ktopw(i))*Cstar2(i)**3*heff(i)*2*
-     $      sqrt(sigmaw(i)*wdens*3.14)
-       FIP(i) = alpk * FIP(i)
-Cjyg2
-       ELSE
-         FIP(i) = 0.
-       ENDIF
-       ENDIF
-      ENDDO
-c
-C   Limitation de sigmaw
-c
-C   sécurité : si le wake occuppe plus de 90 % de la surface de la maille,
-C              alors il disparait en se mélangeant à la partie undisturbed
-c
-      sigmaw_max = 0.9
-      DO k = 1,klev
-       DO i=1, klon
-c correction NICOLAS     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
-!         print*,'wape wape2 ktopw OK_qx_qw =',
-!     $           wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
-         IF ((sigmaw(i).GT.sigmaw_max).or.
-     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
-     $      (ktopw(i).le.2) .OR.
-     $     .not. OK_qx_qw(i)) THEN
-cIM cf NR/JYG 251108  $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
-ccc      IF (sigmaw(i).GT.0.9) THEN
-          dtls(i,k) = 0.
-          dqls(i,k) = 0.
-          deltatw(i,k) = 0.
-          deltaqw(i,k) = 0.
-        ENDIF
-       ENDDO
-      ENDDO
-c
-      DO i=1, klon
-         IF ( (sigmaw(i).GT.sigmaw_max).or.
-     $      ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
-     $      (ktopw(i).le.2) .OR.
-     $     .not. OK_qx_qw(i)) THEN
-! correction NICOLAS     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
-ccc      IF (sigmaw(i).GT.0.9) THEN
-         wape(i) = 0.
-         cstar(i)= 0.  !!corr itlmd
-         hw(i) = hwmin
-         sigmaw(i) = sigmad
-         fip(i) = 0.
-        ELSE
-         wape(i) = wape2(i)
-         cstar(i)= cstar2(i) !!corr itlmd
-        ENDIF
-      ENDDO
-c
-c
-      RETURN
-      END
-
-      SUBROUTINE wake_vec_modulation(nlon,nl,wk_adv,qe,d_qe,
-     $           deltaqw,d_deltaqw,sigmaw,d_sigmaw,alpha)
-c------------------------------------------------------
-cDtermination du coefficient alpha tel que les tendances
-c corriges alpha*d_G, pour toutes les grandeurs G, correspondent
-c a une humidite positive dans la zone (x) et dans la zone (w).
-c------------------------------------------------------
-c
- 
-c  Input
-      REAL qe(nlon,nl),d_qe(nlon,nl)
-      REAL deltaqw(nlon,nl),d_deltaqw(nlon,nl)
-      REAL sigmaw(nlon),d_sigmaw(nlon)
-      LOGICAL wk_adv(nlon)
-      INTEGER nl,nlon
-c  Output
-      REAL alpha(nlon)
-c  Internal variables
-      REAL alpha1(nlon)
-      REAL x,a,b,c,discrim,zeta(nlon)
-      REAL epsilon
-      DATA epsilon/1.e-15/
-c
-      DO k=1,nl
-      DO i = 1,nlon
-       IF (wk_adv(i)) THEN
-        IF ((deltaqw(i,k)+d_deltaqw(i,k)).ge.0.) then
-         zeta(i)=0.
-        ELSE
-         zeta(i)=1.
-        END IF
-       ENDIF
-      ENDDO
-      DO i = 1,nlon
-       IF (wk_adv(i)) THEN
-        x = qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)
-     $   +d_qe(i,k)+(zeta(i)-sigmaw(i))*d_deltaqw(i,k)
-     $   -d_sigmaw(i)*(deltaqw(i,k)+d_deltaqw(i,k))
-      a=-d_sigmaw(i)*d_deltaqw(i,k)
-      b=d_qe(i,k)+(zeta(i)-sigmaw(i))*d_deltaqw(i,k)
-     $           -deltaqw(i,k)*d_sigmaw(i)
-      c=qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)-epsilon
-!       c=qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)
-
-      discrim=b*b-4.*a*c
-!       print*,'ZETA *********************'  
-!       print*,'zeta sigmaw ',zeta(:)
-!       print*,'SIGMA *********************'
-!       print*,'sigmaw ',sigmaw(:)
-
-!       print*,' x ************************'
-!       print*,'x ',x
-!       print*,'  a+b ************************'
-!       print*,'a+b ',a+b
-
-!       print*,'a b c delta zeta ',a,b,c,discrim
-        IF (a+b .GE. 0.) THEN
-         alpha1(i)=1.
-        ELSE
-         IF (x .GE. 0.) THEN
-            alpha1(i)=1.
-         ELSE
-!              IF (a .GE. 0.) THEN
-              IF (a .GT. 0.) THEN
-!       print*,'a b c delta zeta ',a,b,c,discrim,zeta(i)
-!       print*,'-b+sqrt(discrim) ',-b+sqrt(discrim)
-                 alpha1(i)=0.9*min(   (2.*c)/(-b+sqrt(discrim)),
-     $                        (-b+sqrt(discrim))/(2.*a)   )
-              ELSE IF (a.eq.0.) THEN
-                 alpha1(i)=0.9*(-c/b)
-              ELSE
-!       print*,'a b c delta zeta ',a,b,c,discrim,zeta(i)
-!       print*,'-b+sqrt(discrim) ',-b+sqrt(discrim)
-                 alpha1(i)=0.9*max(   (2.*c)/(-b+sqrt(discrim)),
-     $                        (-b+sqrt(discrim))/(2.*a)   )
-              ENDIF
-         ENDIF
-        ENDIF
-       ENDIF
-      ENDDO
-      ENDDO
-c
-      DO i = 1,nlon
-       IF (wk_adv(i)) THEN
-        alpha(i) = min(alpha(i),alpha1(i))
-       ENDIF
-      ENDDO
-c
-      return
-      end
-
-      Subroutine WAKE_scal (p,ph,ppi,dtime,sigd_con
-     :                ,te0,qe0,omgb
-     :                ,dtdwn,dqdwn,amdwn,amup,dta,dqa
-     :                ,wdtPBL,wdqPBL,udtPBL,udqPBL
-     o                ,deltatw,deltaqw,dth,hw,sigmaw,wape,fip,gfl
-     o                ,dtls,dqls
-     o                ,ktopw,omgbdth,dp_omgb,wdens
-     o                ,tu,qu
-     o                ,dtKE,dqKE
-     o                ,dtPBL,dqPBL
-     o                ,omg,dp_deltomg,spread
-     o                ,Cstar,d_deltat_gw
-     o                ,d_deltatw2,d_deltaqw2)
-
-***************************************************************
-*                                                             *
-* WAKE                                                        *
-*      retour a un Pupper fixe                                *
-*                                                             *
-* written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
-* modified by :   ROEHRIG Romain        01/29/2007            *
-***************************************************************
-c
-      USE dimphy
-      IMPLICIT none
-c============================================================================
-C
-C
-C   But : Decrire le comportement des poches froides apparaissant dans les
-C        grands systemes convectifs, et fournir l'energie disponible pour
-C        le declenchement de nouvelles colonnes convectives.
-C
-C   Variables d'etat : deltatw    : ecart de temperature wake-undisturbed area
-C                      deltaqw    : ecart d'humidite wake-undisturbed area
-C                      sigmaw     : fraction d'aire occupee par la poche.
-C
-C   Variable de sortie : 
-c
-c			 wape : WAke Potential Energy
-c                        fip  : Front Incident Power (W/m2) - ALP
-c                        gfl  : Gust Front Length per unit area (m-1)
-C                        dtls : large scale temperature tendency due to wake
-C                        dqls : large scale humidity tendency due to wake
-C                        hw   : hauteur de la poche
-C                     dp_omgb : vertical gradient of large scale omega
-C                      omgbdth: flux of Delta_Theta transported by LS omega
-C                      dtKE   : differential heating (wake - unpertubed)
-C                      dqKE   : differential moistening (wake - unpertubed)
-C                      omg    : Delta_omg =vertical velocity diff. wake-undist. (Pa/s)
-C                 dp_deltomg  : vertical gradient of omg (s-1)
-C                     spread  : spreading term in dt_wake and dq_wake
-C                 deltatw     : updated temperature difference (T_w-T_u).
-C                 deltaqw     : updated humidity difference (q_w-q_u).
-C                 sigmaw      : updated wake fractional area.
-C                 d_deltat_gw : delta T tendency due to GW
-c
-C   Variables d'entree : 
-c
-c		         aire : aire de la maille
-c			 te0  : temperature dans l'environnement  (K)
-C                        qe0  : humidite dans l'environnement     (kg/kg)
-C                        omgb : vitesse verticale moyenne sur la maille (Pa/s)
-C                        dtdwn: source de chaleur due aux descentes (K/s)
-C                        dqdwn: source d'humidite due aux descentes (kg/kg/s)
-C			 dta  : source de chaleur due courants satures et detrain  (K/s)
-C			 dqa  : source d'humidite due aux courants satures et detra (kg/kg/s)
-C                        amdwn: flux de masse total des descentes, par unite de
-C                                surface de la maille (kg/m2/s)
-C                        amup : flux de masse total des ascendances, par unite de
-C                                surface de la maille (kg/m2/s)
-C                        p    : pressions aux milieux des couches (Pa)
-C                        ph   : pressions aux interfaces (Pa)
-C                        ppi  : (p/p_0)**kapa (adim)
-C                        dtime: increment temporel (s)
-c
-C   Variables internes :
-c
-c			 rhow : masse volumique de la poche froide
-C                        rho  : environment density at P levels
-C                        rhoh : environment density at Ph levels
-C                        te   : environment temperature | may change within
-C                        qe   : environment humidity    | sub-time-stepping
-C                        the  : environment potential temperature
-C                        thu  : potential temperature in undisturbed area
-C                        tu   :  temperature  in undisturbed area
-C                        qu   : humidity in undisturbed area
-C                      dp_omgb: vertical gradient og LS omega
-C                      omgbw  : wake average vertical omega
-C                     dp_omgbw: vertical gradient of omgbw
-C                      omgbdq : flux of Delta_q transported by LS omega
-C                        dth  : potential temperature diff. wake-undist.
-C                        th1  : first pot. temp. for vertical advection (=thu)
-C                        th2  : second pot. temp. for vertical advection (=thw)
-C                        q1   : first humidity for vertical advection
-C                        q2   : second humidity for vertical advection
-C                     d_deltatw   : terme de redistribution pour deltatw
-C                     d_deltaqw   : terme de redistribution pour deltaqw
-C                      deltatw0   : deltatw initial
-C                      deltaqw0   : deltaqw initial
-C                      hw0    : hw initial
-C                      sigmaw0: sigmaw initial
-C                      amflux : horizontal mass flux through wake boundary
-C                      wdens  : number of wakes per unit area (3D) or per
-C                               unit length (2D)
-C                      Tgw    : 1 sur la période de onde de gravité
-c                      Cgw    : vitesse de propagation de onde de gravité
-c                      LL     : distance entre 2 poches
-
-c-------------------------------------------------------------------------
-c          Déclaration de variables
-c-------------------------------------------------------------------------
-
-#include "dimensions.h"
 cccc#include "dimphy.h"
 #include "YOMCST.h"
Index: /LMDZ4/trunk/libf/phylmd/write_histISCCP.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/write_histISCCP.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/write_histISCCP.h	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       IF (ok_isccp) THEN
@@ -77,5 +77,5 @@
      .                 meantaucld(:,n))
 c
-        zx_tmp_fi2d(1:klon)=float(seed(1:klon,n))
+        zx_tmp_fi2d(1:klon)=REAL(seed(1:klon,n))
 c
 c       print*,'n=',n,' write_ISCCP avant seed'
Index: /LMDZ4/trunk/libf/phylmd/write_histmthNMC.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/write_histmthNMC.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/write_histmthNMC.h	(revision 1403)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       IF (ok_histNMC(1)) THEN
Index: /LMDZ4/trunk/libf/phylmd/write_histrac.h
===================================================================
--- /LMDZ4/trunk/libf/phylmd/write_histrac.h	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/write_histrac.h	(revision 1403)
@@ -9,4 +9,5 @@
      CALL histwrite_phy(nid_tra,"phis",itau_w,pphis)
      CALL histwrite_phy(nid_tra,"aire",itau_w,airephy)
+     CALL histwrite_phy(nid_tra,"zmasse",itau_w,zmasse)
 
 !TRACEURS
@@ -65,5 +66,5 @@
 ! DIVERS    
      CALL histwrite_phy(nid_tra,"pplay",itau_w,pplay)     
-     CALL histwrite_phy(nid_tra,"t",itau_w,t_seri)     
+     CALL histwrite_phy(nid_tra,"T",itau_w,t_seri)     
      CALL histwrite_phy(nid_tra,"mfu",itau_w,pmfu)
      CALL histwrite_phy(nid_tra,"mfd",itau_w,pmfd)
Index: /LMDZ4/trunk/libf/phylmd/yamada4.F
===================================================================
--- /LMDZ4/trunk/libf/phylmd/yamada4.F	(revision 1402)
+++ /LMDZ4/trunk/libf/phylmd/yamada4.F	(revision 1403)
@@ -38,5 +38,5 @@
 c    iflag_pbl=7 : MY 2.0.Fournier
 c    iflag_pbl=8 : MY 2.5
-c    iflag_pbl=9 : un test ?
+c    iflag_pbl>=9 : MY 2.5 avec diffusion verticale
 
 c.......................................................................
@@ -66,6 +66,4 @@
 
       integer nlay,nlev
-cym      PARAMETER (nlay=klev)
-cym      PARAMETER (nlev=klev+1)
 
       logical first
@@ -98,11 +96,7 @@
       real fl,zzz,zl0,zq2,zn2
 
-cym      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
-cym     s  ,lyam(klon,klev),knyam(klon,klev)
-cym     s  ,w2yam(klon,klev),t2yam(klon,klev)
-      real,allocatable,save,dimension(:,:) :: rino,smyam,styam,lyam,
-     s                                        knyam,w2yam,t2yam
-cym      common/pbldiag/rino,smyam,styam,lyam,knyam,w2yam,t2yam
-c$OMP THREADPRIVATE(rino,smyam,styam,lyam,knyam,w2yam,t2yam)
+      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
+     s  ,lyam(klon,klev),knyam(klon,klev)
+     s  ,w2yam(klon,klev),t2yam(klon,klev)
       logical,save :: firstcall=.true.
 c$OMP THREADPRIVATE(firstcall)       
@@ -119,7 +113,4 @@
       
       if (firstcall) then
-        allocate(rino(klon,klev+1),smyam(klon,klev),styam(klon,klev))
-        allocate(lyam(klon,klev),knyam(klon,klev))
-        allocate(w2yam(klon,klev),t2yam(klon,klev))
 	allocate(l0(klon))
 	firstcall=.false.
@@ -127,5 +118,5 @@
 
 
-      if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then
+      if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.10)) then
            stop'probleme de coherence dans appel a MY'
       endif
@@ -412,8 +403,10 @@
       enddo
 
-c     if (iflag_pbl.ge.7..and.0.eq.1) then
-c        q2(:,1)=q2(:,2)
-c        call vdif_q2(dt,g,rconst,plev,temp,kq,q2)
-c     endif
+! Transport diffusif vertical de la TKE.
+      if (iflag_pbl.ge.9) then
+!       print*,'YAMADA VDIF'
+        q2(:,1)=q2(:,2)
+        call vdif_q2(dt,g,rconst,ngrid,plev,temp,kq,q2)
+      endif
 
 c   Traitement des cas noctrunes avec l'introduction d'une longueur
@@ -492,2 +485,145 @@
       return
       end
+      SUBROUTINE vdif_q2(timestep,gravity,rconst,ngrid,plev,temp,
+     &  kmy,q2)
+      use dimphy
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+cccc#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+
+      real plev(klon,klev+1)
+      real temp(klon,klev)
+      real timestep
+      real gravity,rconst
+      real kstar(klon,klev+1),zz
+      real kmy(klon,klev+1)
+      real q2(klon,klev+1)
+      real deltap(klon,klev+1)
+      real denom(klon,klev+1),alpha(klon,klev+1),beta(klon,klev+1)
+      integer ngrid
+
+      integer i,k
+
+! 	print*,'RD=',rconst
+      do k=1,klev
+         do i=1,ngrid
+c test
+!       print*,'i,k',i,k
+! 	print*,'temp(i,k)=',temp(i,k)
+! 	print*,'(plev(i,k)-plev(i,k+1))=',plev(i,k),plev(i,k+1)
+            zz=(plev(i,k)+plev(i,k+1))*gravity/(rconst*temp(i,k))
+            kstar(i,k)=0.125*(kmy(i,k+1)+kmy(i,k))*zz*zz
+     s      /(plev(i,k)-plev(i,k+1))*timestep
+         enddo
+      enddo
+
+      do k=2,klev
+         do i=1,ngrid
+            deltap(i,k)=0.5*(plev(i,k-1)-plev(i,k+1))
+         enddo
+      enddo
+      do i=1,ngrid
+         deltap(i,1)=0.5*(plev(i,1)-plev(i,2))
+         deltap(i,klev+1)=0.5*(plev(i,klev)-plev(i,klev+1))
+         denom(i,klev+1)=deltap(i,klev+1)+kstar(i,klev)
+         alpha(i,klev+1)=deltap(i,klev+1)*q2(i,klev+1)/denom(i,klev+1)
+         beta(i,klev+1)=kstar(i,klev)/denom(i,klev+1)
+      enddo
+
+      do k=klev,2,-1
+         do i=1,ngrid
+            denom(i,k)=deltap(i,k)+(1.-beta(i,k+1))*
+     s      kstar(i,k)+kstar(i,k-1)
+c   correction d'un bug 10 01 2001
+            alpha(i,k)=(q2(i,k)*deltap(i,k)
+     s      +kstar(i,k)*alpha(i,k+1))/denom(i,k)
+            beta(i,k)=kstar(i,k-1)/denom(i,k)
+         enddo
+      enddo
+
+c  Si on recalcule q2(1)
+      if(1.eq.0) then
+      do i=1,ngrid
+         denom(i,1)=deltap(i,1)+(1-beta(i,2))*kstar(i,1)
+         q2(i,1)=(q2(i,1)*deltap(i,1)
+     s      +kstar(i,1)*alpha(i,2))/denom(i,1)
+      enddo
+      endif
+c   sinon, on peut sauter cette boucle...
+
+      do k=2,klev+1
+         do i=1,ngrid
+            q2(i,k)=alpha(i,k)+beta(i,k)*q2(i,k-1)
+         enddo
+      enddo
+
+      return
+      end
+      SUBROUTINE vdif_q2e(timestep,gravity,rconst,ngrid,
+     &   plev,temp,kmy,q2)
+      use dimphy
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+cccc#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+
+      real plev(klon,klev+1)
+      real temp(klon,klev)
+      real timestep
+      real gravity,rconst
+      real kstar(klon,klev+1),zz
+      real kmy(klon,klev+1)
+      real q2(klon,klev+1)
+      real deltap(klon,klev+1)
+      real denom(klon,klev+1),alpha(klon,klev+1),beta(klon,klev+1)
+      integer ngrid
+
+      integer i,k
+
+      do k=1,klev
+         do i=1,ngrid
+            zz=(plev(i,k)+plev(i,k+1))*gravity/(rconst*temp(i,k))
+            kstar(i,k)=0.125*(kmy(i,k+1)+kmy(i,k))*zz*zz
+     s      /(plev(i,k)-plev(i,k+1))*timestep
+         enddo
+      enddo
+
+      do k=2,klev
+         do i=1,ngrid
+            deltap(i,k)=0.5*(plev(i,k-1)-plev(i,k+1))
+         enddo
+      enddo
+      do i=1,ngrid
+         deltap(i,1)=0.5*(plev(i,1)-plev(i,2))
+         deltap(i,klev+1)=0.5*(plev(i,klev)-plev(i,klev+1))
+      enddo
+
+      do k=klev,2,-1
+         do i=1,ngrid
+            q2(i,k)=q2(i,k)+
+     s      ( kstar(i,k)*(q2(i,k+1)-q2(i,k))
+     s       -kstar(i,k-1)*(q2(i,k)-q2(i,k-1)) )
+     s      /deltap(i,k)
+         enddo
+      enddo
+
+      do i=1,ngrid
+         q2(i,1)=q2(i,1)+
+     s   ( kstar(i,1)*(q2(i,2)-q2(i,1))
+     s                                      )
+     s   /deltap(i,1)
+         q2(i,klev+1)=q2(i,klev+1)+
+     s   ( 
+     s    -kstar(i,klev)*(q2(i,klev+1)-q2(i,klev)) )
+     s   /deltap(i,klev+1)
+      enddo
+
+      return
+      end
Index: /LMDZ4/trunk/makegcm
===================================================================
--- /LMDZ4/trunk/makegcm	(revision 1402)
+++ /LMDZ4/trunk/makegcm	(revision 1403)
@@ -49,16 +49,13 @@
 ###### VERSION LMDZ.4
 set INCALIB=../INCA3/config/lib
-#set LMDGCM="`pwd`"
-#setenv LIBOGCM $LMDGCM/libo
+set LMDGCM="`pwd`"
+setenv LIBOGCM $LMDGCM/libo
 #
 #
-#setenv NCDFINC /tmpdir/fairhead/1P1bis/netcdf-3.6.1/include
-#setenv NCDFLIB /tmpdir/fairhead/1P1bis/netcdf-3.6.1/lib
-#setenv IOIPSLDIR /tmpdir/fairhead/IOIPSL/modipsl/lib
-#setenv MODIPSLDIR /tmpdir/fairhead/IOIPSL/modipsl/lib
-#setenv IOIPSLDIR /d4/fairhead/gfortran/ioispl-v2_1_9
-#setenv MODIPSLDIR /d4/fairhead/gfortran/ioispl-v2_1_9
-#setenv NCDFINC /d4/fairhead/gfortran/netcdf-4.0.1/include
-#setenv NCDFLIB /d4/fairhead/gfortran/netcdf-4.0.1/lib
+setenv IOIPSLDIR /d4/fairhead/gfortran/ioipsl_v2_1_9
+setenv MODIPSLDIR /d4/fairhead/gfortran/ioipsl_v2_1_9
+setenv NCDFINC /d4/fairhead/gfortran_4.4/netcdf-4.1.1/include
+setenv NCDFLIB /d4/fairhead/gfortran_4.4/netcdf-4.1.1/lib
+
 
 
@@ -1044,4 +1041,9 @@
 cd $localdir
 
+set source_code=${code}.F
+if ( -f $LMDGCM/libf/dyn${dimc}d${FLAG_PARA}/${code}.F90 ) then
+  set source_code=${code}.F90
+endif
+
 echo $make -f $LMDGCM/makefile \
 OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
@@ -1068,4 +1070,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+SOURCE=$source_code \
 PROG=$code
 
@@ -1094,4 +1097,5 @@
 MOD_SUFFIX=$mod_suffix \
 AR=$ar \
+SOURCE=$source_code \
 PROG=$code
 
Index: /LMDZ4/trunk/orchidee.def
===================================================================
--- /LMDZ4/trunk/orchidee.def	(revision 1402)
+++ /LMDZ4/trunk/orchidee.def	(revision 1403)
@@ -1,20 +1,24 @@
-#
-# $Header$
 #
 #
-# SECHIBA
+# Parameter file for LMDZ4OR_v2 configuration
+# See comments : http://forge.ipsl.jussieu.fr/orchidee/
 #
-STOMATE_OK_CO2=FALSE
+STOMATE_OK_CO2=TRUE
 # STOMATE_OK_STOMATE is not set
 # STOMATE_OK_DGVM is not set
 # STOMATE_WATCHOUT is not set
-#SECHIBA_restart_in=default
-SECHIBA_restart_in=start_sech.nc
+SECHIBA_restart_in=default
 SECHIBA_rest_out=sechiba_rest.nc
 SECHIBA_reset_time=y
-SECHIBA_reset_time is not set
+#
 OUTPUT_FILE=sechiba_out.nc
 WRITE_STEP=2592000
-SECHIBA_HISTLEVEL=10
+SECHIBA_HISTLEVEL=5
+#
+SECHIBA_HISTFILE2 = FALSE
+SECHIBA_OUTPUT_FILE2 = sechiba_out_2.nc
+WRITE_STEP2 = 86400.0
+SECHIBA_HISTLEVEL2 = 1
+#
 STOMATE_OUTPUT_FILE=stomate_history.nc
 STOMATE_HIST_DT=10.
@@ -25,4 +29,5 @@
 # IMPOSE_VEG is not set
 VEGETATION_FILE=carteveg5km.nc
+# VEGETATION_FILE=pft_new.nc
 DIFFUCO_LEAFCI=233.
 CONDVEG_SNOWA=default
@@ -42,5 +47,17 @@
 HYDROL_DSP=default
 HYDROL_QSV=0.0
+HYDROL_OK_HDIFF=n
+HYDROL_TAU_HDIFF=1800.
 THERMOSOIL_TPRO=280.
 RIVER_ROUTING=y
 ROUTING_FILE=routing.nc
+LAI_MAP=y
+LAI_FILE=lai2D.nc
+SECHIBA_QSINT=0.02
+ALB_BARE_MODEL = FALSE
+PERCENT_THROUGHFALL_PFT = 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30.
+RVEG_PFT = .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5
+CDRAG_FROM_GCM = .TRUE.
+#LAND_USE=y
+#VEGET_YEAR=0
+#VEGET_UPDATE=1Y
Index: /LMDZ4/trunk/physiq.def
===================================================================
--- /LMDZ4/trunk/physiq.def	(revision 1402)
+++ /LMDZ4/trunk/physiq.def	(revision 1403)
@@ -1,126 +1,5 @@
-#
 ## $Id$
 #
-#
-# Automatically generated make config: don t edit
-#
-type_ocean=force
-# avec ou sans orchidee 
-VEGET=n
-#type_run = AMIP, ENSP, clim
-type_run=AMIP
-#
-# Controle des sorties
-# sorties moyennees tous les jours  dans histday.nc
-OK_journe=y
-# sorties moyennees tous les mois  dans histmth.nc
-OK_mensuel=y
-# sorties moyennees toutes les 6 ou bien 3h dans histhf.nc
-ok_hf=n
-# sorties moyennees tous les pas de temps de la physique dans histins.nc
-OK_instan=n
-#
-ecrit_mth=30.
-ecrit_day=1.
-ecrit_hf=0.25
-#
-#niveau de sortie "hf" lev_histhf 
-lev_histhf=4
-#niveau de sortie "day" lev_histday
-lev_histday=5
-#niveau de sortie "mth" lev_histmth 
-lev_histmth=4
-
-# parametres KE
-if_ebil=0
-epmax = .99
-ok_adj_ema = n
-iflag_clw = 1
-# 
-# parametres nuages
-cld_lc_lsc = 2.6e-4
-cld_lc_con = 2.6e-4
-cld_tau_lsc = 3600.
-cld_tau_con = 3600.
-ffallv_lsc = 1.
-ffallv_con = 1.
-coef_eva = 2.e-5
-reevap_ice = y
-iflag_cldcon = 3
-iflag_pdf = 1
-fact_cldcon = 1.
-facttemps = 1.e-4
-ok_newmicro = y
-iflag_ratqs=0
-ratqsbas = 0.005
-ratqshaut = 0.33
-rad_froid = 35
-rad_chau1=12
-rad_chau2=11
-ksta_ter=1.e-7
-ksta=1.e-10
-#ok_kzmin : calcul Kzmin dans la CL de surface
-ok_kzmin=y
-#
-# parametres climatique
-R_ecc = 0.016715
-R_peri = 102.7
-R_incl = 23.441
-solaire = 1365.
-co2_ppm = 348.
-#RCO2 = co2_ppm * 1.0e-06  * 44.011/28.97
-#RCO2 = 348. * 1.0e-06  * 44.011/28.97
-#RCO2 =   5.286789092164308E-04
-#RCO2 = 425.43e-06
-CH4_ppb = 1650.
-#RCH4 = 1.65E-06* 16.043/28.97
-#RCH4 =   9.137366240938903E-07
-N2O_ppb = 306.
-#RN2O = 306.E-09* 44.013/28.97
-#RN2O =    4.648939592682085E-07
-CFC11_ppt = 280.
-#RCFC11 = 280.E-12* 137.3686/28.97
-#RCFC11 =    1.327690990680013E-09
-CFC12_ppt = 484.
-#RCFC12 = 484.E-12* 120.9140/28.97
-#RCFC12 =    2.020102726958923E-09
-#
-# effets direct et indirect des aerosols
-ok_ade=n
-ok_aie=n
-bl95_b0=1.7
-bl95_b1=0.2
-#
-# parametres simulateur ISCCP
-#ok_isccp : y/n avec/sans simulateur ISCCP
-ok_isccp=n
-#top_height = 1 ou 3
-top_height = 1
-#overlap = 1, 2 ou 3
-overlap = 3
-#cdmmax
-cdmmax = 2.5E-3
-#cdhmax
-cdhmax = 2.0E-3
-#
-#ok_regdyn : y/n calcul/non des regymes dynamiques sur regions pre-definies
-ok_regdyn=y
-#
-# Flag  pour la convection (1 pour LMD, 2 pour Tiedtke, 3 KE nouvelle physique, 30 KE IPCC)
-iflag_con=30
-#
-# activation thermiques wake, ...
-iflag_thermals = 0
-nsplit_thermals =1
-tau_thermals=1800.
-iflag_pbl = 1
-iflag_coupl=0
-iflag_wake=0
-iflag_clos=0
-iflag_mix=1
-qqa1=0.
-qqa2=1.
-## frequence (en  jours ) de l'ecriture du fichier histphy               
-ecritphy=30
+# PARAMETRES ANCIENNEMENT DANS gcm.def
 ##  Cycle diurne  ou non                 
 cycle_diurne=y
@@ -129,4 +8,6 @@
 ##  Choix ou non  de  New oliq               
 new_oliq=y
+##  Activation ou non de la parametrisation de Hines pour la strato
+ok_hines=n
 ##  Orodr  ou  non   pour l orographie              
 ok_orodr=y
@@ -136,5 +17,203 @@
 ok_limitvrai=n
 ## Nombre  d'appels des routines de rayonnements ( par jour)                 
-nbapp_rad=12
+nbapp_rad=24
+##  Flag  pour la convection : 1 pour LMD, 2 pour Tiedtke, 3 KE(nvlle version JYG), 30 KE(version IPCC AR4), 4 KE vect
+iflag_con=30
 ## Facteur multiplication des precip convectives dans KE
 cvl_corr=1.0
+##  Facteur additif pour l'albedo
+pmagic=0.008
+#
+#
+#
+# Parametres fichiers de sortie
+#
+### type_run = type run par rapport aux fichiers et variables de sortie
+# - type_run = CLIM/ENSP (=1)
+# - type_run = AMIP/CFMI (=2)
+type_run=AMIP
+### OK_journe= y sortir fichier journalier histday.nc, =n pas de fichier histday.nc
+OK_journe=n
+### OK_mensuel= y sortir fichier mensuel histmth.nc, =n pas de fichier histmth.nc
+OK_mensuel=y
+### OK_instan=y, ecrire sorties "instantannees" (chaque pas de temps de la  physique)
+OK_instan=n
+### OK_hf=y, ecrire sorties hautes frequence histhf.nc, =n pas de fichier histhf.nc
+ok_hf=n
+#
+# Parametres niveau de sorties differents fichiers 
+#
+### lev_histhf=0-4, niveau de sortie fichier "histhf.nc" 
+# - lev_histhf=0 => pas de sorties histhf.nc
+# - lev_histhf=2 => defaut
+# - lev_histhf=3 => variables sur niveaux standards
+# - lev_histhf=4 => histhf3d.nc champs 3d niveaux modele => fichier. histhf3d.nc
+lev_histhf=2
+### lev_histday=0-5, niveau de sortie fichier "histday.nc"
+# - lev_histday=0 => pas de sorties lev_histday.nc
+# - lev_histday=2 => defaut
+# - lev_histday=3 => + champs 3D => F. Lott
+# - lev_histday=4 => + champs sous-surfaces
+# - lev_histday=5 => + champs F. Aires
+lev_histday=2
+### lev_histmth=0-4, niveau de sortie fichier "histmth.nc"
+# - lev_histmth=0 => pas de sorties lev_histmth.nc
+# - lev_histmth=2 => defaut
+# - lev_histmth=3 => albedo, rugosite sous-surfaces
+# - lev_histmth=4 => champs tendances 3d
+lev_histmth=2
+### ecrit_hf = frequence ecriture fichier histhf.nc en jours
+ecrit_hf=0.250
+### ecrit_day = frequence ecriture fichier histday.nc en jours
+ecrit_day=1.
+### ecrit_mth = frequence ecriture fichier histmth.nc en jours
+ecrit_mth=30
+### freqin_isccp = frequence input en secondes du simulateur ISCCP
+freq_ISCCP=10800.
+### freqout_isccp = frequence output en jours du simulateur ISCCP
+ecrit_ISCCP=30
+### niveau du diagnostique de conservation d energie
+if_ebil=0
+#
+# parametres KE
+#
+### epmax = Efficacite precipitation maximale
+epmax = .999
+### ok_adj_ema = ?? pas utilise
+ok_adj_ema = n
+### iflag_clw Flag calcul eau liquide
+# - iflag_clw=0 : qcond_incld(i,l) = em_qcondc(l)
+# - iflag_clw=1 : qcond_incld(i,l) = em_qcond(l)
+# - iflag_clw=2 : eau liquide diagnostique en fonction de la Precip
+iflag_clw = 1
+# 
+# parametres nuages
+#
+### cld_lc_lsc  contenu en eau liquide des nuages large-scale (fisrtilp) 
+cld_lc_lsc = 4.16e-4
+### cld_lc_con  contenu en eau liquide des nuages convectifs (fisrtilp) 
+cld_lc_con = 4.16e-4
+### cld_tau_lsc cte de temps utilisee pour eliminer l eau large-scale (fisrtilp) 
+cld_tau_lsc = 1800.
+### cld_tau_con cte de temps utilisee pour eliminer l eau convective (fisrtilp) 
+cld_tau_con = 1800.
+### ffallv_lsc  cte utilisee dans calcul vitesse de chute cristaux de glace large-scale (fisrtilp) 
+ffallv_lsc = 0.5
+### ffallv_lsc  cte utilisee dans calcul vitesse de chute cristaux de glace convectifs (fisrtilp) 
+ffallv_con = 0.5
+### coef_eva coef evaporation precips eau/glace (fisrtilp/fisrtilp_tr?/conlmd?)
+coef_eva = 2.e-5
+### reevap_ice  reevaporation de toute la precip dans la couche du dessous pour la glace (fisrtilp) 
+reevap_ice = y
+### iflag_cldcon  flag pour calculer ratqsc=F(ratqsbas,fact_cldcon,q_seri) (physiq) 
+# - iflag_cldcon<=-1 diag. rain_Tiedtke 
+# - iflag_cldcon=1, ratqsc=ratqsbas+fact_cldcon*(q_seri(1)-q_seri(k))/q_seri(k)
+# - iflag_cldcon=1/2, ratqs=max(ratqs,ratqsc)
+# - iflag_cldcon=3,   ratqs=ratqss
+iflag_cldcon = 3
+### iflag_pdf :  flag calcul distribution sous-maille de l eau et des nuages 
+# - iflag_pdf=0, version ratqs, 
+# - iflag_pdf=1, calcul eau condensee, fraction nuageuse, eau nuageuse a partir
+# -              des PDFS de Sandrine Bony 
+iflag_pdf = 1
+### fact_cldcon  constante calcul ratqsc (voir iflag_cldcon) et proprietes nuages convectifs, clwcon0 (physiq.F) 
+fact_cldcon = 1.
+### facttemps=   facteur de relaxation de ratqs (iflag_cldcon=1/2) et rnebcon (iflag_cldcon=3)
+facttemps = 0.
+## ok_newmicro   =y appel newmicro , =n appel nuage (calcul epaisseur optique et emmissivite des nuages) 
+ok_newmicro = y
+### iflag_ratqs=0 correspond a la version IPCC AR4 
+iflag_ratqs=0
+### ratqsbas     ratqs en bas si iflag_cldcon=1 
+ratqsbas = 0.005
+### ratqshaut    ratqs en haut pour ratqss "stables"  
+ratqshaut = 0.33
+### rad_froid    rayon cristaux des nuages de glace "froids" 
+rad_froid = 35
+### rad_chau1    rayon goutelettes d eau chauds", en haut: k=4-klev 
+rad_chau1=12
+### rad_chau2    rayon goutelettes d eau chauds", en bas: k=1-3  
+rad_chau2=11
+# 
+# Coefficient et parametres sur les drags
+#
+f_cdrag_ter=1.
+f_cdrag_stable=1.
+f_cdrag_oce=0.8
+f_rugoro=0.
+### ksta_ter      coef.diffusion minimale sur terre/sic/lic 
+ksta_ter=1.e-7
+### cdmmax =     cdrag maximum pour le moment
+cdmmax = 2.5E-3
+### cdhmax =     cdrag maximum pour l energie
+cdhmax = 2.0E-3
+#
+# Parametres "orbitaux/ ere geologique"
+#
+### R_ecc =      Excentricite
+R_ecc = 0.016715
+### R_peri =     Equinoxe
+R_peri = 102.7
+### R_incl =     Inclinaison
+R_incl = 23.441
+### solaire =    Constante solaire
+solaire = 1361.
+#
+# Taux gaz a effet de serre
+#
+### co2_ppm =    taux CO2 en ppm
+co2_ppm = 367.
+### CH4_ppb =    taux CH4 en ppb
+CH4_ppb = 1760.
+### N2O_ppb =    taux N2O en ppb
+N2O_ppb = 316.
+### CFC11_ppt =  taux CFC11 en ppt
+CFC11_ppt = 741.2
+### CFC12_ppt =  taux CFC12 en ppt
+CFC12_ppt = 535.
+#
+# Parametres effets directs/indirects des "aerosols"
+#
+### ok_ade=y/n   flag Aerosol direct effect
+ok_ade=n
+### ok_aie=y/n   flag Aerosol indirect effect
+ok_aie=n
+### aer_type =   Aerosol variation type : actuel / preind / scenario / annuel
+aer_type=actuel
+###  type of coupled aerosol =1 (default) =2 => bc  only =3 => pom only =4 => seasalt only =5 => dust only =6 => all aerosol
+flag_aerosol=6 
+### bl95_b0 =    Parameter in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b0=1.7
+### bl95_b1 =    Parameter in CDNC-maer link (Boucher&Lohmann 1995)
+bl95_b1=0.2
+#
+# Parametre de lecture de l'ozone
+#
+# Allowed values are 0, 1 and 2
+# 0: do not read an ozone climatology
+# 1: read a single ozone climatology that will be used day and night
+# 2: read two ozone climatologies, the average day and night climatology and the daylight climatology
+read_climoz=0
+#
+# Parametres simulateur COSP (CFMIP Observational Simulator Package)
+#
+### ok_cosp=y/n flag simulateur COSP
+ok_cosp=n
+## freq_COSP = frequence d'appel de COSP en secondes
+freq_COSP=10800.
+#
+# Parametres simulateur ISCCP
+#
+### ok_isccp=y/n flag simulateur ISCCP
+ok_isccp=n
+### top_height = flag choix calcul nuages par le simulateur en utilisant 
+# -              les donnees IR et/ou VIS et l algorithme ISCCP-D1
+# - top_height = 1 -> algo IR-VIS
+# - top_height = 2 -> identique a 1, mais "ptop(ibox)=pfull(ilev)"
+# - top_height = 3 -> algo IR
+top_height = 1
+### overlap =    Hypothese de Recouvrement (HR) utilisee pour le simulateur ISCCP
+# - overlap=1    Max overlap
+# - overlap=2    Random overlap
+# - overlap=3    Max/Random overlap
+overlap = 3
Index: /LMDZ4/trunk/run.def
===================================================================
--- /LMDZ4/trunk/run.def	(revision 1402)
+++ /LMDZ4/trunk/run.def	(revision 1403)
@@ -1,9 +1,13 @@
+# $Id$
 #
-## $Id$
-#
+## Fichier de configuration general
+## 
 INCLUDEDEF=physiq.def
 INCLUDEDEF=gcm.def
 INCLUDEDEF=orchidee.def
 INCLUDEDEF=output.def
+## Type de calendrier utilise
+## valeur possible: earth_360d (defaut), earth_365d, earth_366d
+calend=earth_360d
 ## Jour de l'etat initial ( = 350  si 20 Decembre ,par expl. ,comme ici )
 dayref=1
@@ -11,13 +15,33 @@
 anneeref=1980
 ## Nombre de jours d'integration
-nday=1
+nday=5
+## Remise a zero de la date initiale
+raz_date=0
 ## periode de sortie des variables de controle (en pas)
 iconser=240
-## periode d'ecriture du fichier histoire (en jour)
-iecri=1
+## sorties instantanees dans la dynamique (fichiers dyn_hist.nc and co.)
+ok_dyn_ins=n
+## periode d'ecriture des sorties instantanees dans la dynamique
+## (en pas dynamiques)
+iecri=960
+## sorties de valeurs moyennes dans la dynamique (fichiers dyn_hist_ave.nc and co.)
+ok_dyn_ave=n
+## periode de stockage des moyennes dans la dynamique et dans dynzon
+periodav=30
 ## flag de sortie dynzon
 ok_dynzon=n
-## periode de stockage fichier dynzon (en jour)
-periodav=30.
-## Output diagnistics from the dynamics in Grads file dyn.dat
-output_grads_dyn=n
+## activation du calcul d equilibrage de charge
+adjust=n
+## activation du filtre fft
+use_filtre_fft=n
+## niveau d'impression de controle
+prt_level=1
+##
+## Informations sur la configuration utilisee
+## 
+### type_ocean = force / slab  /couple
+type_ocean=force
+### version_ocean = nemo / opa8 
+version_ocean=nemo
+### VEGET= y si ORCHIDEE, =n si bucket
+VEGET=n
