Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1DUTILS.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1DUTILS.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1DUTILS.h	(revision 3815)
@@ -0,0 +1,4448 @@
+#include "conf_gcm.F90"
+#include "q_sat.F"
+
+!
+! $Id: conf_unicol.F 1279 2010-08-04 17:20:56Z lahellec $
+!
+!
+!
+      SUBROUTINE conf_unicol
+!
+#ifdef CPP_IOIPSL
+      use IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      use ioipsl_getincom
+#endif
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!     Auteurs :   A. Lahellec  .
+!
+!   Declarations :
+!   --------------
+
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "tsoilnudge.h"
+#include "fcg_gcssold.h"
+#include "fcg_racmo.h"
+#include "iniprint.h"
+!
+!
+!   local:
+!   ------
+
+!      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      
+!
+!  -------------------------------------------------------------------
+!
+!      .........    Initilisation parametres du lmdz1D      ..........
+!
+!---------------------------------------------------------------------
+!   initialisations:
+!   ----------------
+
+!Config  Key  = lunout
+!Config  Desc = unite de fichier pour les impressions
+!Config  Def  = 6
+!Config  Help = unite de fichier pour les impressions 
+!Config         (defaut sortie standard = 6)
+      lunout=6
+!      CALL getin('lunout', lunout)
+      IF (lunout /= 5 .and. lunout /= 6) THEN
+        OPEN(lunout,FILE='lmdz.out')
+      ENDIF
+
+!Config  Key  = prt_level
+!Config  Desc = niveau d'impressions de débogage
+!Config  Def  = 0
+!Config  Help = Niveau d'impression pour le débogage
+!Config         (0 = minimum d'impression)
+!      prt_level = 0
+!      CALL getin('prt_level',prt_level)
+
+!-----------------------------------------------------------------------
+!  Parametres de controle du run:
+!-----------------------------------------------------------------------
+
+!Config  Key  = restart
+!Config  Desc = on repart des startphy et start1dyn
+!Config  Def  = false
+!Config  Help = les fichiers restart doivent etre renomme en start
+       restart =.false.
+       CALL getin('restart',restart)
+
+!Config  Key  = forcing_type
+!Config  Desc = defines the way the SCM is forced:
+!Config  Def  = 0
+!!Config  Help = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!         = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!         = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!         = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!         = 4 ==> forcing_twpi = .true.
+!             initial profiles from TWPICE nc files 
+!             LS convergence and SST imposed from TWPICE nc files 
+!         = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO idealized
+!             LS convergence imposed from  RICO (cst) 
+!         = 6 ==> forcing_amma = .true.
+!         = 10 ==> forcing_case = .true.
+!             initial profiles from case.nc file 
+!         = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!         = 50 ==> forcing_fire = .true.
+!         = 59 ==> forcing_sandu = .true.
+!             initial profiles from sanduref file: see prof.inp.001
+!             SST varying with time and divergence constante: see ifa_sanduref.txt file
+!             Radiation has to be computed interactively
+!         = 60 ==> forcing_astex = .true.
+!             initial profiles from file: see prof.inp.001 
+!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
+!             Radiation has to be computed interactively
+!         = 61 ==> forcing_armcu = .true.
+!             initial profiles from file: see prof.inp.001 
+!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
+!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
+!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s 
+!             Radiation to be switched off
+!
+       forcing_type = 0
+       CALL getin('forcing_type',forcing_type)
+         imp_fcg_gcssold   = .false.
+         ts_fcg_gcssold    = .false.  
+         Tp_fcg_gcssold    = .false.  
+         Tp_ini_gcssold    = .false.  
+         xTurb_fcg_gcssold = .false. 
+        IF (forcing_type .eq.40) THEN
+          CALL getin('imp_fcg',imp_fcg_gcssold)
+          CALL getin('ts_fcg',ts_fcg_gcssold)
+          CALL getin('tp_fcg',Tp_fcg_gcssold)
+          CALL getin('tp_ini',Tp_ini_gcssold)
+          CALL getin('turb_fcg',xTurb_fcg_gcssold)
+        ENDIF
+
+!Paramètres de forçage
+!Config  Key  = tend_t
+!Config  Desc = forcage ou non par advection de T
+!Config  Def  = false
+!Config  Help = forcage ou non par advection de T
+       tend_t =0
+       CALL getin('tend_t',tend_t)
+
+!Config  Key  = tend_q
+!Config  Desc = forcage ou non par advection de q
+!Config  Def  = false
+!Config  Help = forcage ou non par advection de q
+       tend_q =0
+       CALL getin('tend_q',tend_q)
+
+!Config  Key  = tend_u
+!Config  Desc = forcage ou non par advection de u
+!Config  Def  = false
+!Config  Help = forcage ou non par advection de u
+       tend_u =0
+       CALL getin('tend_u',tend_u)
+
+!Config  Key  = tend_v
+!Config  Desc = forcage ou non par advection de v
+!Config  Def  = false
+!Config  Help = forcage ou non par advection de v
+       tend_v =0
+       CALL getin('tend_v',tend_v)
+
+!Config  Key  = tend_w
+!Config  Desc = forcage ou non par vitesse verticale
+!Config  Def  = false
+!Config  Help = forcage ou non par vitesse verticale
+       tend_w =0
+       CALL getin('tend_w',tend_w)
+
+!Config  Key  = tend_rayo
+!Config  Desc = forcage ou non par dtrad
+!Config  Def  = false
+!Config  Help = forcage ou non par dtrad
+       tend_rayo =0
+       CALL getin('tend_rayo',tend_rayo)
+
+
+!Config  Key  = nudge_t
+!Config  Desc = constante de nudging de T
+!Config  Def  = false
+!Config  Help = constante de nudging de T
+       nudge_t =0.
+       CALL getin('nudge_t',nudge_t)
+
+!Config  Key  = nudge_q
+!Config  Desc = constante de nudging de q
+!Config  Def  = false
+!Config  Help = constante de nudging de q
+       nudge_q =0.
+       CALL getin('nudge_q',nudge_q)
+
+!Config  Key  = nudge_u
+!Config  Desc = constante de nudging de u
+!Config  Def  = false
+!Config  Help = constante de nudging de u
+       nudge_u =0.
+       CALL getin('nudge_u',nudge_u)
+
+!Config  Key  = nudge_v
+!Config  Desc = constante de nudging de v
+!Config  Def  = false
+!Config  Help = constante de nudging de v
+       nudge_v =0.
+       CALL getin('nudge_v',nudge_v)
+
+!Config  Key  = nudge_w
+!Config  Desc = constante de nudging de w
+!Config  Def  = false
+!Config  Help = constante de nudging de w
+       nudge_w =0.
+       CALL getin('nudge_w',nudge_w)
+
+
+!Config  Key  = iflag_nudge
+!Config  Desc = atmospheric nudging ttype (decimal code)
+!Config  Def  = 0
+!Config  Help = 0 ==> no nudging
+!  If digit number n of iflag_nudge is set, then nudging of type n is on
+!  If digit number n of iflag_nudge is not set, then nudging of type n is off
+!   (digits are numbered from the right)
+       iflag_nudge = 0
+       CALL getin('iflag_nudge',iflag_nudge)
+
+!Config  Key  = ok_flux_surf
+!Config  Desc = forcage ou non par les flux de surface
+!Config  Def  = false
+!Config  Help = forcage ou non par les flux de surface
+       ok_flux_surf =.false.
+       CALL getin('ok_flux_surf',ok_flux_surf)
+
+!Config  Key  = ok_prescr_ust
+!Config  Desc = ustar impose ou non
+!Config  Def  = false
+!Config  Help = ustar impose ou non
+       ok_prescr_ust = .false.
+       CALL getin('ok_prescr_ust',ok_prescr_ust)
+
+!Config  Key  = ok_old_disvert
+!Config  Desc = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
+!Config  Def  = false
+!Config  Help = utilisation de l ancien programme disvert0 (dans 1DUTILS.h)
+       ok_old_disvert = .FALSE.
+       CALL getin('ok_old_disvert',ok_old_disvert)
+
+!Config  Key  = time_ini
+!Config  Desc = meaningless in this  case
+!Config  Def  = 0.
+!Config  Help = 
+       tsurf = 0.
+       CALL getin('time_ini',time_ini)
+
+!Config  Key  = rlat et rlon
+!Config  Desc = latitude et longitude
+!Config  Def  = 0.0  0.0
+!Config  Help = fixe la position de la colonne
+       xlat = 0.
+       xlon = 0.
+       CALL getin('rlat',xlat)
+       CALL getin('rlon',xlon)
+
+!Config  Key  = airephy
+!Config  Desc = Grid cell area
+!Config  Def  = 1.e11
+!Config  Help = 
+       airefi = 1.e11
+       CALL getin('airephy',airefi)
+
+!Config  Key  = nat_surf
+!Config  Desc = surface type
+!Config  Def  = 0 (ocean)
+!Config  Help = 0=ocean,1=land,2=glacier,3=banquise
+       nat_surf = 0.
+       CALL getin('nat_surf',nat_surf)
+
+!Config  Key  = tsurf
+!Config  Desc = surface temperature
+!Config  Def  = 290.
+!Config  Help = not used if type_ts_forcing=1 in lmdz1d.F
+       tsurf = 290.
+       CALL getin('tsurf',tsurf)
+
+!Config  Key  = psurf
+!Config  Desc = surface pressure
+!Config  Def  = 102400.
+!Config  Help = 
+       psurf = 102400.
+       CALL getin('psurf',psurf)
+
+!Config  Key  = zsurf
+!Config  Desc = surface altitude
+!Config  Def  = 0.
+!Config  Help = 
+       zsurf = 0.
+       CALL getin('zsurf',zsurf)
+
+!Config  Key  = rugos
+!Config  Desc = coefficient de frottement
+!Config  Def  = 0.0001
+!Config  Help = calcul du Cdrag
+       rugos = 0.0001
+       CALL getin('rugos',rugos)
+
+!Config  Key  = wtsurf et wqsurf
+!Config  Desc = ???
+!Config  Def  = 0.0 0.0
+!Config  Help = 
+       wtsurf = 0.0
+       wqsurf = 0.0
+       CALL getin('wtsurf',wtsurf)
+       CALL getin('wqsurf',wqsurf)
+
+!Config  Key  = albedo
+!Config  Desc = albedo
+!Config  Def  = 0.09
+!Config  Help = 
+       albedo = 0.09
+       CALL getin('albedo',albedo)
+
+!Config  Key  = agesno
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       xagesno = 30.0
+       CALL getin('agesno',xagesno)
+
+!Config  Key  = restart_runoff
+!Config  Desc = age de la neige
+!Config  Def  = 30.0
+!Config  Help = 
+       restart_runoff = 0.0
+       CALL getin('restart_runoff',restart_runoff)
+
+!Config  Key  = qsolinp
+!Config  Desc = initial bucket water content (kg/m2) when land (5std)
+!Config  Def  = 30.0
+!Config  Help = 
+       qsolinp = 1.
+       CALL getin('qsolinp',qsolinp)
+
+!Config  Key  = zpicinp
+!Config  Desc = denivellation orographie
+!Config  Def  = 300.
+!Config  Help =  input brise
+       zpicinp = 300.
+       CALL getin('zpicinp',zpicinp)
+!Config key = nudge_tsoil
+!Config  Desc = activation of soil temperature nudging
+!Config  Def  = .FALSE.
+!Config  Help = ...
+
+       nudge_tsoil=.FALSE.
+       CALL getin('nudge_tsoil',nudge_tsoil)
+
+!Config key = isoil_nudge
+!Config  Desc = level number where soil temperature is nudged
+!Config  Def  = 3
+!Config  Help = ...
+
+       isoil_nudge=3
+       CALL getin('isoil_nudge',isoil_nudge)
+
+!Config key = Tsoil_nudge
+!Config  Desc = target temperature for tsoil(isoil_nudge)
+!Config  Def  = 300.
+!Config  Help = ...
+
+       Tsoil_nudge=300.
+       CALL getin('Tsoil_nudge',Tsoil_nudge)
+
+!Config key = tau_soil_nudge
+!Config  Desc = nudging relaxation time for tsoil
+!Config  Def  = 3600.
+!Config  Help = ...
+
+       tau_soil_nudge=3600.
+       CALL getin('tau_soil_nudge',tau_soil_nudge)
+
+
+
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' Configuration des parametres du gcm1D: '
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)' restart = ', restart
+      write(lunout,*)' forcing_type = ', forcing_type
+      write(lunout,*)' time_ini = ', time_ini
+      write(lunout,*)' rlat = ', xlat
+      write(lunout,*)' rlon = ', xlon
+      write(lunout,*)' airephy = ', airefi
+      write(lunout,*)' nat_surf = ', nat_surf
+      write(lunout,*)' tsurf = ', tsurf
+      write(lunout,*)' psurf = ', psurf
+      write(lunout,*)' zsurf = ', zsurf
+      write(lunout,*)' rugos = ', rugos
+      write(lunout,*)' wtsurf = ', wtsurf
+      write(lunout,*)' wqsurf = ', wqsurf
+      write(lunout,*)' albedo = ', albedo
+      write(lunout,*)' xagesno = ', xagesno
+      write(lunout,*)' restart_runoff = ', restart_runoff
+      write(lunout,*)' qsolinp = ', qsolinp
+      write(lunout,*)' zpicinp = ', zpicinp
+      write(lunout,*)' nudge_tsoil = ', nudge_tsoil
+      write(lunout,*)' isoil_nudge = ', isoil_nudge
+      write(lunout,*)' Tsoil_nudge = ', Tsoil_nudge
+      write(lunout,*)' tau_soil_nudge = ', tau_soil_nudge
+      IF (forcing_type .eq.40) THEN
+        write(lunout,*) '--- Forcing type GCSS Old --- with:'
+        write(lunout,*)'imp_fcg',imp_fcg_gcssold
+        write(lunout,*)'ts_fcg',ts_fcg_gcssold
+        write(lunout,*)'tp_fcg',Tp_fcg_gcssold
+        write(lunout,*)'tp_ini',Tp_ini_gcssold
+        write(lunout,*)'xturb_fcg',xTurb_fcg_gcssold
+      ENDIF
+
+      write(lunout,*)' +++++++++++++++++++++++++++++++++++++++'
+      write(lunout,*)
+!
+      RETURN
+      END
+!
+! $Id: dyn1deta0.F 1279 2010/07/30 A Lahellec$
+!
+!
+      SUBROUTINE dyn1deta0(fichnom,plev,play,phi,phis,presnivs,                 &
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart
+      USE write_field_phy
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+!=======================================================
+! Ecriture du fichier de redemarrage sous format NetCDF
+!=======================================================
+!   Declarations:
+!   -------------
+      include "dimensions.h"
+      include "comconst.h"
+      include "temps.h"
+!!#include "control.h"
+      include "logic.h"
+      include "netcdf.inc"
+
+!   Arguments:
+!   ----------
+      CHARACTER*(*) fichnom
+!Al1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev+1),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot),omega2(klon,klev)
+!      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+!   Variables locales pour NetCDF:
+!   ------------------------------
+      INTEGER iq
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*12 modname
+      character*80 abort_message
+      LOGICAL found
+
+      modname = 'dyn1deta0 : '
+      nmq(1)="vap"
+      nmq(2)="cond"
+      do iq=3,nqtot
+        write(nmq(iq),'("tra",i1)') iq-2
+      enddo
+      print*,'in dyn1deta0 ',fichnom,klon,klev,nqtot
+      CALL open_startphy(fichnom)
+      print*,'after open startphy ',fichnom,nmq
+
+!
+! Lecture des parametres de controle:
+!
+      CALL get_var("controle",tab_cntrl)
+       
+
+      im         = tab_cntrl(1)
+      jm         = tab_cntrl(2)
+      lllm       = tab_cntrl(3)
+      day_ref    = tab_cntrl(4)
+      annee_ref  = tab_cntrl(5)
+!      rad        = tab_cntrl(6)
+!      omeg       = tab_cntrl(7)
+!      g          = tab_cntrl(8)
+!      cpp        = tab_cntrl(9)
+!      kappa      = tab_cntrl(10)
+!      daysec     = tab_cntrl(11)
+!      dtvr       = tab_cntrl(12)
+!      etot0      = tab_cntrl(13)
+!      ptot0      = tab_cntrl(14)
+!      ztot0      = tab_cntrl(15)
+!      stot0      = tab_cntrl(16)
+!      ang0       = tab_cntrl(17)
+!      pa         = tab_cntrl(18)
+!      preff      = tab_cntrl(19)
+!
+!      clon       = tab_cntrl(20)
+!      clat       = tab_cntrl(21)
+!      grossismx  = tab_cntrl(22)
+!      grossismy  = tab_cntrl(23)
+!
+      IF ( tab_cntrl(24).EQ.1. )  THEN
+        fxyhypb  =.true.
+!        dzoomx   = tab_cntrl(25)
+!        dzoomy   = tab_cntrl(26)
+!        taux     = tab_cntrl(28)
+!        tauy     = tab_cntrl(29)
+      ELSE
+        fxyhypb = .false.
+        ysinus  = .false.
+        IF( tab_cntrl(27).EQ.1. ) ysinus =.true. 
+      ENDIF
+
+      day_ini = tab_cntrl(30)
+      itau_dyn = tab_cntrl(31)
+!   .................................................................
+!
+!
+!      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
+!Al1
+       Print*,'day_ref,annee_ref,day_ini,itau_dyn',                         &
+     &              day_ref,annee_ref,day_ini,itau_dyn
+
+!  Lecture des champs
+!
+      CALL get_field("play",play,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Play> est absent'
+      CALL get_field("phi",phi,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phi> est absent'
+      CALL get_field("phis",phis,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Phis> est absent'
+      CALL get_field("presnivs",presnivs,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Presnivs> est absent'
+      CALL get_field("ucov",ucov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <ucov> est absent'
+      CALL get_field("vcov",vcov,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <vcov> est absent'
+      CALL get_field("temp",temp,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <temp> est absent'
+      CALL get_field("omega2",omega2,found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <omega2> est absent'
+      plev(1,klev+1)=0.
+      CALL get_field("plev",plev(:,1:klev),found)
+      IF (.NOT. found) PRINT*, modname//'Le champ <Plev> est absent'
+
+      Do iq=1,nqtot
+        CALL get_field("q"//nmq(iq),q(:,:,iq),found)
+        IF (.NOT.found)PRINT*, modname//'Le champ <q'//nmq//'> est absent'
+      EndDo
+
+      CALL close_startphy
+      print*,' close startphy',fichnom,play(1,1),play(1,klev),temp(1,klev)
+!
+      RETURN
+      END
+!
+! $Id: dyn1dredem.F 1279 2010/07/29 A Lahellec$
+!
+!
+      SUBROUTINE dyn1dredem(fichnom,plev,play,phi,phis,presnivs,           &
+     &                          ucov,vcov,temp,q,omega2)
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE phys_state_var_mod
+      USE iostart
+      USE infotrac
+      use control_mod
+
+      IMPLICIT NONE
+!=======================================================
+! Ecriture du fichier de redemarrage sous format NetCDF
+!=======================================================
+!   Declarations:
+!   -------------
+      include "dimensions.h"
+      include "comconst.h"
+      include "temps.h"
+!!#include "control.h"
+      include "logic.h"
+      include "netcdf.inc"
+
+!   Arguments:
+!   ----------
+      CHARACTER*(*) fichnom
+!Al1 plev tronque pour .nc mais plev(klev+1):=0
+      real :: plev(klon,klev),play (klon,klev),phi(klon,klev)
+      real :: presnivs(klon,klev)
+      real :: ucov(klon,klev),vcov(klon,klev),temp(klon,klev)
+      real :: q(klon,klev,nqtot)
+      real :: omega2(klon,klev),rho(klon,klev+1)
+!      real :: ug(klev),vg(klev),fcoriolis
+      real :: phis(klon) 
+
+!   Variables locales pour NetCDF:
+!   ------------------------------
+      INTEGER nid
+      INTEGER ierr
+      INTEGER iq,l
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      character*4 nmq(nqtot)
+      character*20 modname
+      character*80 abort_message
+!
+      INTEGER nb
+      SAVE nb
+      DATA nb / 0 /
+
+      CALL open_restartphy(fichnom)
+      print*,'redm1 ',fichnom,klon,klev,nqtot
+      nmq(1)="vap"
+      nmq(2)="cond"
+      nmq(3)="tra1"
+      nmq(4)="tra2"
+
+      modname = 'dyn1dredem'
+      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
+      IF (ierr .NE. NF_NOERR) THEN
+         abort_message="Pb. d ouverture "//fichnom
+         CALL abort_gcm('Modele 1D',abort_message,1)
+      ENDIF
+
+      DO l=1,length
+       tab_cntrl(l) = 0.
+      ENDDO
+       tab_cntrl(1)  = FLOAT(iim)
+       tab_cntrl(2)  = FLOAT(jjm)
+       tab_cntrl(3)  = FLOAT(llm)
+       tab_cntrl(4)  = FLOAT(day_ref)
+       tab_cntrl(5)  = FLOAT(annee_ref)
+       tab_cntrl(6)  = rad
+       tab_cntrl(7)  = omeg
+       tab_cntrl(8)  = g
+       tab_cntrl(9)  = cpp
+       tab_cntrl(10) = kappa
+       tab_cntrl(11) = daysec
+       tab_cntrl(12) = dtvr
+!       tab_cntrl(13) = etot0
+!       tab_cntrl(14) = ptot0
+!       tab_cntrl(15) = ztot0
+!       tab_cntrl(16) = stot0
+!       tab_cntrl(17) = ang0
+!       tab_cntrl(18) = pa
+!       tab_cntrl(19) = preff
+!
+!    .....    parametres  pour le zoom      ......   
+
+!       tab_cntrl(20)  = clon
+!       tab_cntrl(21)  = clat
+!       tab_cntrl(22)  = grossismx
+!       tab_cntrl(23)  = grossismy
+!
+      IF ( fxyhypb )   THEN
+       tab_cntrl(24) = 1.
+!       tab_cntrl(25) = dzoomx
+!       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+!       tab_cntrl(28) = taux
+!       tab_cntrl(29) = tauy
+      ELSE
+       tab_cntrl(24) = 0.
+!       tab_cntrl(25) = dzoomx
+!       tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = 0.
+       tab_cntrl(29) = 0.
+       IF( ysinus )  tab_cntrl(27) = 1.
+      ENDIF
+!Al1 iday_end -> day_end
+       tab_cntrl(30) = FLOAT(day_end)
+       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
+!
+      CALL put_var("controle","Param. de controle Dyn1D",tab_cntrl)
+!
+
+!  Ecriture/extension de la coordonnee temps
+
+      nb = nb + 1
+
+!  Ecriture des champs
+!
+      CALL put_field("plev","p interfaces sauf la nulle",plev)
+      CALL put_field("play","",play)
+      CALL put_field("phi","geopotentielle",phi)
+      CALL put_field("phis","geopotentiell de surface",phis)
+      CALL put_field("presnivs","",presnivs)
+      CALL put_field("ucov","",ucov)
+      CALL put_field("vcov","",vcov)
+      CALL put_field("temp","",temp)
+      CALL put_field("omega2","",omega2)
+
+      Do iq=1,nqtot
+        CALL put_field("q"//nmq(iq),"eau vap ou condens et traceurs",           &
+     &                                                      q(:,:,iq))
+      EndDo
+      CALL close_restartphy
+
+!
+      RETURN
+      END
+      SUBROUTINE gr_fi_dyn(nfield,ngrid,im,jm,pfi,pdyn)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER i,j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      DO ifield=1,nfield
+!   traitement des poles
+         DO i=1,im
+            pdyn(i,1,ifield)=pfi(1,ifield)
+            pdyn(i,jm,ifield)=pfi(ngrid,ifield)
+         ENDDO
+ 
+!   traitement des point normaux
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pfi(ig,ifield),1,pdyn(1,j,ifield),1)
+            pdyn(im,j,ifield)=pdyn(1,j,ifield)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+ 
+
+      SUBROUTINE abort_gcm(modname, message, ierr)
+ 
+      USE IOIPSL
+!
+! Stops the simulation cleanly, closing files and printing various
+! comments
+!
+!  Input: modname = name of calling program
+!         message = stuff to print
+!         ierr    = severity of situation ( = 0 normal )
+ 
+      character(len=*) modname
+      integer ierr
+      character(len=*) message
+ 
+      write(*,*) 'in abort_gcm'
+      call histclo
+!     call histclo(2)
+!     call histclo(3)
+!     call histclo(4)
+!     call histclo(5)
+      write(*,*) 'out of histclo'
+      write(*,*) 'Stopping in ', modname
+      write(*,*) 'Reason = ',message
+      call getin_dump
+!
+      if (ierr .eq. 0) then
+        write(*,*) 'Everything is cool'
+      else
+        write(*,*) 'Houston, we have a problem ', ierr
+      endif
+      STOP
+      END
+      REAL FUNCTION fq_sat(kelvin, millibar)
+!
+      IMPLICIT none
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! fq_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      REAL kelvin, millibar
+!
+      REAL r2es
+      PARAMETER (r2es=611.14 *18.0153/28.9644)
+!
+      REAL r3les, r3ies, r3es
+      PARAMETER (R3LES=17.269)
+      PARAMETER (R3IES=21.875)
+!
+      REAL r4les, r4ies, r4es
+      PARAMETER (R4LES=35.86)
+      PARAMETER (R4IES=7.66)
+!
+      REAL rtt
+      PARAMETER (rtt=273.16)
+!
+      REAL retv
+      PARAMETER (retv=28.9644/18.0153 - 1.0)
+!
+      REAL zqsat
+      REAL temp, pres
+!     ------------------------------------------------------------------
+!
+!
+      temp = kelvin
+      pres = millibar * 100.0
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!      write(*,*)'temp,pres=',temp,pres
+!
+      IF (temp .LE. rtt) THEN
+         r3es = r3ies
+         r4es = r4ies
+      ELSE
+         r3es = r3les
+         r4es = r4les
+      ENDIF
+!
+      zqsat=r2es/pres * EXP ( r3es*(temp-rtt) / (temp-r4es) )
+      zqsat=MIN(0.5,ZQSAT)
+      zqsat=zqsat/(1.-retv  *zqsat)
+!
+      fq_sat = zqsat
+!
+      RETURN
+      END
+ 
+      SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi)
+      IMPLICIT NONE
+!=======================================================================
+!   passage d'un champ de la grille scalaire a la grille physique
+!=======================================================================
+ 
+!-----------------------------------------------------------------------
+!   declarations:
+!   -------------
+ 
+      INTEGER im,jm,ngrid,nfield
+      REAL pdyn(im,jm,nfield)
+      REAL pfi(ngrid,nfield)
+ 
+      INTEGER j,ifield,ig
+ 
+!-----------------------------------------------------------------------
+!   calcul:
+!   -------
+ 
+      IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1)                          &
+     &    STOP 'probleme de dim'
+!   traitement des poles
+      CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid)
+      CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid)
+ 
+!   traitement des point normaux
+      DO ifield=1,nfield
+         DO j=2,jm-1
+            ig=2+(j-2)*(im-1)
+            CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1)
+         ENDDO
+      ENDDO
+ 
+      RETURN
+      END
+ 
+      SUBROUTINE disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+ 
+!    Ancienne version disvert dont on a modifie nom pour utiliser
+!    le disvert de dyn3d (qui permet d'utiliser grille avec ab,bp imposes)
+!    (MPL 18092012)
+!
+!    Auteur :  P. Le Van .
+!
+      IMPLICIT NONE
+ 
+      include "dimensions.h"
+      include "paramet.h"
+!
+!=======================================================================
+!
+!
+!    s = sigma ** kappa   :  coordonnee  verticale
+!    dsig(l)            : epaisseur de la couche l ds la coord.  s
+!    sig(l)             : sigma a l'interface des couches l et l-1
+!    ds(l)              : distance entre les couches l et l-1 en coord.s
+!
+!=======================================================================
+!
+      REAL pa,preff
+      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
+      REAL presnivs(llm)
+!
+!   declarations:
+!   -------------
+!
+      REAL sig(llm+1),dsig(llm)
+!
+      INTEGER l
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz,h
+      INTEGER np,ierr
+      REAL pi,x
+ 
+!-----------------------------------------------------------------------
+!
+      pi=2.*ASIN(1.)
+ 
+      OPEN(99,file='sigma.def',status='old',form='formatted',                   &
+     &   iostat=ierr)
+ 
+!-----------------------------------------------------------------------
+!   cas 1 on lit les options dans sigma.def:
+!   ----------------------------------------
+ 
+      IF (ierr.eq.0) THEN
+ 
+      print*,'WARNING!!! on lit les options dans sigma.def'
+      READ(99,*) deltaz
+      READ(99,*) h
+      READ(99,*) beta
+      READ(99,*) gama
+      READ(99,*) delta
+      READ(99,*) np
+      CLOSE(99)
+      alpha=deltaz/(llm*h)
+!
+ 
+       DO 1  l = 1, llm
+       dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))*                    &
+     &          ( (tanh(gama*l)/tanh(gama*llm))**np +                      &
+     &            (1.-l/FLOAT(llm))*delta )
+   1   CONTINUE
+ 
+       sig(1)=1.
+       DO 101 l=1,llm-1
+          sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l))
+101    CONTINUE
+       sig(llm+1)=0.
+ 
+       DO 2  l = 1, llm
+       dsig(l) = sig(l)-sig(l+1)
+   2   CONTINUE
+!
+ 
+      ELSE
+!-----------------------------------------------------------------------
+!   cas 2 ancienne discretisation (LMD5...):
+!   ----------------------------------------
+ 
+      PRINT*,'WARNING!!! Ancienne discretisation verticale'
+ 
+      h=7.
+      snorm  = 0.
+      DO l = 1, llm
+         x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1)
+         dsig(l) = 1.0 + 7.0 * SIN(x)**2
+         snorm = snorm + dsig(l)
+      ENDDO
+      snorm = 1./snorm
+      DO l = 1, llm
+         dsig(l) = dsig(l)*snorm
+      ENDDO
+      sig(llm+1) = 0.
+      DO l = llm, 1, -1
+         sig(l) = sig(l+1) + dsig(l)
+      ENDDO
+ 
+      ENDIF
+ 
+ 
+      DO l=1,llm
+        nivsigs(l) = FLOAT(l)
+      ENDDO
+ 
+      DO l=1,llmp1
+        nivsig(l)= FLOAT(l)
+      ENDDO
+ 
+!
+!    ....  Calculs  de ap(l) et de bp(l)  ....
+!    .........................................
+!
+!
+!   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
+!
+ 
+      bp(llmp1) =   0.
+ 
+      DO l = 1, llm
+!c
+!cc    ap(l) = 0.
+!cc    bp(l) = sig(l)
+ 
+      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
+      ap(l) = pa * ( sig(l) - bp(l) )
+!
+      ENDDO
+      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
+ 
+      PRINT *,' BP '
+      PRINT *,  bp
+      PRINT *,' AP '
+      PRINT *,  ap
+ 
+      DO l = 1, llm
+       dpres(l) = bp(l) - bp(l+1)
+       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+      ENDDO
+ 
+      PRINT *,' PRESNIVS '
+      PRINT *,presnivs
+ 
+      RETURN
+      END
+
+!======================================================================
+       SUBROUTINE read_tsurf1d(knon,sst_out)
+
+! This subroutine specifies the surface temperature to be used in 1D simulations
+
+      USE dimphy, ONLY : klon
+
+      INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+      REAL, DIMENSION(klon), INTENT(OUT)   :: sst_out  ! tsurf used to force the single-column model
+
+       INTEGER :: i
+! COMMON defined in lmdz1d.F:
+       real ts_cur
+       common /sst_forcing/ts_cur
+
+       DO i = 1, knon
+        sst_out(i) = ts_cur
+       ENDDO
+
+      END SUBROUTINE read_tsurf1d
+
+!===============================================================
+      subroutine advect_vert(llm,w,dt,q,plev)
+!===============================================================
+!   Schema amont pour l'advection verticale en 1D
+!   w est la vitesse verticale dp/dt en Pa/s
+!   Traitement en volumes finis 
+!   d / dt ( zm q ) = delta_z ( omega q )
+!   d / dt ( zm ) = delta_z ( omega )
+!   avec zm = delta_z ( p )
+!   si * designe la valeur au pas de temps t+dt
+!   zm*(l) q*(l) - zm(l) q(l) = w(l+1) q(l+1) - w(l) q(l)
+!   zm*(l) -zm(l) = w(l+1) - w(l)
+!   avec w=omega * dt
+!---------------------------------------------------------------
+      implicit none
+! arguments
+      integer llm
+      real w(llm+1),q(llm),plev(llm+1),dt
+
+! local
+      integer l
+      real zwq(llm+1),zm(llm+1),zw(llm+1)
+      real qold
+
+!---------------------------------------------------------------
+
+      do l=1,llm
+         zw(l)=dt*w(l)
+         zm(l)=plev(l)-plev(l+1)
+         zwq(l)=q(l)*zw(l)
+      enddo
+      zwq(llm+1)=0.
+      zw(llm+1)=0.
+ 
+      do l=1,llm
+         qold=q(l)
+         q(l)=(q(l)*zm(l)+zwq(l+1)-zwq(l))/(zm(l)+zw(l+1)-zw(l))
+         print*,'ADV Q ',zm(l),zw(l),zwq(l),qold,q(l)
+      enddo
+
+ 
+      return
+      end
+
+!===============================================================
+
+
+       SUBROUTINE advect_va(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,              &
+     &                q,temp,u,v,play)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,3)
+        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,3),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm)
+! interne
+        integer l
+        real alpha,omgdown,omgup
+
+      do l= 1,llm
+       if(l.eq.1) then
+!si omgup pour la couche 1, alors tendance nulle
+        omgdown=max(omega(2),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*(1.+q(l,1)))
+        d_t_va(l)= alpha*(omgdown)-omgdown*(temp(l)-temp(l+1))             &
+     &       /(play(l)-play(l+1))
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))/(play(l)-play(l+1))              
+
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))/(play(l)-play(l+1))              
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))/(play(l)-play(l+1))              
+
+        
+       elseif(l.eq.llm) then
+        omgup=min(omega(l),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*(1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup)-                                          &
+
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+        d_q_va(l,:)= -omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l))
+        d_u_va(l)= -omgup*(u(l-1)-u(l))/(play(l-1)-play(l))
+        d_v_va(l)= -omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+       else
+        omgup=min(omega(l),0.0)
+        omgdown=max(omega(l+1),0.0)
+        alpha = rkappa*temp(l)*(1.+q(l,1)*rv/rd)/(play(l)*(1.+q(l,1)))
+        d_t_va(l)= alpha*(omgup+omgdown)-omgdown*(temp(l)-temp(l+1))       &
+     &              /(play(l)-play(l+1))-                                  &
+!bug?     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-plev(l))
+     &              omgup*(temp(l-1)-temp(l))/(play(l-1)-play(l))
+!      print*, '  ??? '
+
+        d_q_va(l,:)= -omgdown*(q(l,:)-q(l+1,:))                            &
+     &              /(play(l)-play(l+1))-                                  &
+     &              omgup*(q(l-1,:)-q(l,:))/(play(l-1)-play(l)) 
+        d_u_va(l)= -omgdown*(u(l)-u(l+1))                                  &
+     &              /(play(l)-play(l+1))-                                  &
+     &              omgup*(u(l-1)-u(l))/(play(l-1)-play(l)) 
+        d_v_va(l)= -omgdown*(v(l)-v(l+1))                                  &
+     &              /(play(l)-play(l+1))-                                  &
+     &              omgup*(v(l-1)-v(l))/(play(l-1)-play(l))
+       
+      endif
+         
+      enddo
+!fin itlmd
+        return
+        end
+!       SUBROUTINE lstendH(llm,omega,d_t_va,d_q_va,d_u_va,d_v_va,
+       SUBROUTINE lstendH(llm,nqtot,omega,d_t_va,d_q_va,                        &
+     &                q,temp,u,v,play)
+!itlmd 
+!----------------------------------------------------------------------
+!   Calcul de l'advection verticale (ascendance et subsidence) de 
+!   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
+!   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou 
+!   sans WTG rajouter une advection horizontale 
+!----------------------------------------------------------------------  
+        implicit none
+#include "YOMCST.h"
+!        argument
+        integer llm,nqtot
+        real  omega(llm+1),d_t_va(llm), d_q_va(llm,nqtot)
+!        real  d_u_va(llm), d_v_va(llm)
+        real  q(llm,nqtot),temp(llm)
+        real  u(llm),v(llm)
+        real  play(llm)
+        real cor(llm)
+!        real dph(llm),dudp(llm),dvdp(llm),dqdp(llm),dtdp(llm)
+        real dph(llm),dqdp(llm),dtdp(llm)
+! interne
+        integer k
+        real omdn,omup
+
+!        dudp=0.
+!        dvdp=0.
+        dqdp=0.
+        dtdp=0.
+!        d_u_va=0.
+!        d_v_va=0.
+
+      cor(:) = rkappa*temp*(1.+q(:,1)*rv/rd)/(play*(1.+q(:,1)))
+
+
+      do k=2,llm-1
+
+       dph  (k-1) = (play(k  )- play(k-1  ))
+!       dudp (k-1) = (u   (k  )- u   (k-1  ))/dph(k-1)
+!       dvdp (k-1) = (v   (k  )- v   (k-1  ))/dph(k-1)
+       dqdp (k-1) = (q   (k,1)- q   (k-1,1))/dph(k-1)
+       dtdp (k-1) = (temp(k  )- temp(k-1  ))/dph(k-1)
+
+      enddo
+
+!      dudp (  llm  ) = dudp ( llm-1 )
+!      dvdp (  llm  ) = dvdp ( llm-1 )
+      dqdp (  llm  ) = dqdp ( llm-1 )
+      dtdp (  llm  ) = dtdp ( llm-1 )
+
+      do k=2,llm-1
+      omdn=max(0.0,omega(k+1))
+      omup=min(0.0,omega( k ))
+
+!      d_u_va(k)  = -omdn*dudp(k)-omup*dudp(k-1)
+!      d_v_va(k)  = -omdn*dvdp(k)-omup*dvdp(k-1)
+      d_q_va(k,1)= -omdn*dqdp(k)-omup*dqdp(k-1)
+      d_t_va(k)  = -omdn*dtdp(k)-omup*dtdp(k-1)+(omup+omdn)*cor(k)
+      enddo
+
+      omdn=max(0.0,omega( 2 ))
+      omup=min(0.0,omega(llm))
+!      d_u_va( 1 )   = -omdn*dudp( 1 )
+!      d_u_va(llm)   = -omup*dudp(llm)
+!      d_v_va( 1 )   = -omdn*dvdp( 1 )
+!      d_v_va(llm)   = -omup*dvdp(llm)
+      d_q_va( 1 ,1) = -omdn*dqdp( 1 )
+      d_q_va(llm,1) = -omup*dqdp(llm)
+      d_t_va( 1 )   = -omdn*dtdp( 1 )+omdn*cor( 1 )
+      d_t_va(llm)   = -omup*dtdp(llm)!+omup*cor(llm)
+
+!      if(abs(rlat(1))>10.) then
+!     Calculate the tendency due agestrophic motions
+!      du_age = fcoriolis*(v-vg)
+!      dv_age = fcoriolis*(ug-u)
+!      endif
+
+!       call writefield_phy('d_t_va',d_t_va,llm)
+
+          return
+         end
+
+!======================================================================
+      SUBROUTINE read_togacoare(fich_toga,nlev_toga,nt_toga                     &
+     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
+     &             ,ht_toga,vt_toga,hq_toga,vq_toga)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read TOGA-COARE forcing data 
+!-------------------------------------------------------------------------
+
+      integer nlev_toga,nt_toga
+      real ts_toga(nt_toga),plev_toga(nlev_toga,nt_toga)
+      real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+      real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+      real w_toga(nlev_toga,nt_toga)
+      real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+      real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+      character*80 fich_toga
+
+      integer k,ip
+      real bid
+
+      integer iy,im,id,ih
+      
+       real plev_min
+
+       plev_min = 55.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_toga),form='formatted')
+      read(21,'(a)') 
+      do ip = 1, nt_toga
+      read(21,'(a)') 
+      read(21,'(a)') 
+      read(21,223) iy, im, id, ih, bid, ts_toga(ip), bid,bid,bid,bid
+      read(21,'(a)') 
+      read(21,'(a)') 
+
+       do k = 1, nlev_toga
+         read(21,230) plev_toga(k,ip), t_toga(k,ip), q_toga(k,ip)          &
+     &       ,u_toga(k,ip), v_toga(k,ip), w_toga(k,ip)                     &
+     &       ,ht_toga(k,ip), vt_toga(k,ip), hq_toga(k,ip), vq_toga(k,ip)
+
+! conversion in SI units:
+         t_toga(k,ip)=t_toga(k,ip)+273.15     ! K
+         q_toga(k,ip)=q_toga(k,ip)*0.001      ! kg/kg
+         w_toga(k,ip)=w_toga(k,ip)*100./3600. ! Pa/s
+! no water vapour tendency above 55 hPa
+         if (plev_toga(k,ip) .lt. plev_min) then
+          q_toga(k,ip) = 0.
+          hq_toga(k,ip) = 0.
+          vq_toga(k,ip) =0.
+         endif
+       enddo
+
+         ts_toga(ip)=ts_toga(ip)+273.15       ! K
+       enddo
+       close(21)
+
+  223 format(4i3,6f8.2)
+  230 format(6f9.3,4e11.3)
+
+          return
+          end
+
+!-------------------------------------------------------------------------
+      SUBROUTINE read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read I.SANDU case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_sandu,nt_sandu
+      real ts_sandu(nt_sandu)
+      character*80 fich_sandu
+
+      integer ip
+      integer iy,im,id,ih
+
+      real plev_min
+
+      print*,'nlev_sandu',nlev_sandu
+      plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_sandu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_sandu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, ts_sandu(ip)
+      print *,'ts=',iy,im,id,ih,ip,ts_sandu(ip)
+      enddo
+      close(21)
+
+  223 format(4i3,f8.2)
+
+          return
+          end
+
+!=====================================================================
+!-------------------------------------------------------------------------
+      SUBROUTINE read_astex(fich_astex,nlev_astex,nt_astex,div_astex,      &
+     & ts_astex,ug_astex,vg_astex,ufa_astex,vfa_astex)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read Astex case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_astex,nt_astex
+      real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+      real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+      character*80 fich_astex
+
+      integer ip
+      integer iy,im,id,ih
+
+       real plev_min
+
+      print*,'nlev_astex',nlev_astex
+       plev_min = 55000.  ! pas de tendance de vap. d eau au-dessus de 55 hPa
+
+      open(21,file=trim(fich_astex),form='formatted')
+      read(21,'(a)')
+      read(21,'(a)')
+      do ip = 1, nt_astex
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, div_astex(ip),ts_astex(ip),             &
+     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vfa_astex(ip)
+      ts_astex(ip)=ts_astex(ip)+273.15
+      print *,'ts=',iy,im,id,ih,ip,div_astex(ip),ts_astex(ip),             &
+     &ug_astex(ip),vg_astex(ip),ufa_astex(ip),vg_astex(ip)
+      enddo
+      close(21)
+
+  223 format(4i3,e13.2,f7.2,f7.3,f7.2,f7.3,f7.2)
+
+          return
+          end
+!=====================================================================
+      subroutine read_twpice(fich_twpice,nlevel,ntime                       &
+     &     ,T_srf,plev,T,q,u,v,omega                                       &
+     &     ,T_adv_h,T_adv_v,q_adv_h,q_adv_v)
+
+!program reading forcings of the TWP-ICE experiment
+
+!      use netcdf
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_twpice
+      real*8 time(ntime)
+      real*8 lat, lon, alt, phis
+      real*8 lev(nlevel)
+      real*8 plev(nlevel,ntime)
+
+      real*8 T(nlevel,ntime)
+      real*8 q(nlevel,ntime),u(nlevel,ntime)
+      real*8 v(nlevel,ntime)
+      real*8 omega(nlevel,ntime), div(nlevel,ntime)
+      real*8 T_adv_h(nlevel,ntime)
+      real*8 T_adv_v(nlevel,ntime), q_adv_h(nlevel,ntime)
+      real*8 q_adv_v(nlevel,ntime)
+      real*8 s(nlevel,ntime), s_adv_h(nlevel,ntime)
+      real*8 s_adv_v(nlevel,ntime)
+      real*8 p_srf_aver(ntime), p_srf_center(ntime)
+      real*8 T_srf(ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=20)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_twpice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings cdf file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+      ierr=NF_INQ_VARID(nid,"lat",var3didin(1))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lat'
+         endif
+      
+       ierr=NF_INQ_VARID(nid,"lon",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lon'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"alt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'alt'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"phis",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'phis'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"div",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'div'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_h",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_adv_v",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_h",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_h'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"q_adv_v",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'q_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"s_adv_h",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_h'
+         endif
+    
+      ierr=NF_INQ_VARID(nid,"s_adv_v",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 's_adv_v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_aver",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_aver'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"p_srf_center",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'p_srf_center'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"T_srf",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'T_srf'
+         endif
+
+!dimensions lecture
+      call catchaxis(nid,ntime,nlevel,time,lev,ierr)
+
+!pressure 
+       do l=1,ntime
+       do k=1,nlevel
+          plev(k,l)=lev(k)
+       enddo
+       enddo
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),lat)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),lat)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lat ok',lat
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),lon)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),lon)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture lon ok',lon
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),alt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture alt ok',alt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),phis)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),phis)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture phis ok',phis
+          
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),T)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),T)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),q)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),q)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q ok'
+!q in kg/kg
+       do l=1,ntime
+       do k=1,nlevel
+          q(k,l)=q(k,l)/1000.
+       enddo
+       enddo
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture u ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture v ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture omega ok'
+!omega in mb/hour
+       do l=1,ntime
+       do k=1,nlevel
+          omega(k,l)=omega(k,l)*100./3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),div)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),div)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture div ok'
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),T_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),T_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_h ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_h(k,l)=T_adv_h(k,l)/3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),T_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),T_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_adv_v ok'
+!T adv in K/s
+       do l=1,ntime
+       do k=1,nlevel
+          T_adv_v(k,l)=T_adv_v(k,l)/3600.
+       enddo
+       enddo
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),q_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),q_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_h ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_h(k,l)=q_adv_h(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),q_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),q_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture q_adv_v ok'
+!q adv in kg/kg/s
+       do l=1,ntime
+       do k=1,nlevel
+          q_adv_v(k,l)=q_adv_v(k,l)/1000./3600.
+       enddo
+       enddo
+
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),s)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),s)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),s_adv_h)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),s_adv_h)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),s_adv_v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),s_adv_v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),p_srf_aver)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),p_srf_aver)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),p_srf_center)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),p_srf_center)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),T_srf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),T_srf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!         write(*,*)'lecture T_srf ok', T_srf
+
+         return 
+         end subroutine read_twpice
+!=====================================================================
+         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
+
+!         use netcdf
+
+         implicit none
+#include "netcdf.inc"
+         integer nid,ttm,llm
+         real*8 time(ttm)
+         real*8 lev(llm)
+         integer ierr
+
+         integer timevar,levvar
+         integer timelen,levlen
+         integer timedimin,levdimin
+
+! Control & lecture on dimensions
+! ===============================
+         ierr=NF_INQ_DIMID(nid,"time",timedimin)
+         ierr=NF_INQ_VARID(nid,"time",timevar)
+         if (ierr.NE.NF_NOERR) then
+            write(*,*) 'ERROR: Field <time> is missing'
+            stop ""  
+         endif
+         ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)
+
+         ierr=NF_INQ_DIMID(nid,"lev",levdimin)
+         ierr=NF_INQ_VARID(nid,"lev",levvar)
+         if (ierr.NE.NF_NOERR) then
+             write(*,*) 'ERROR: Field <lev> is lacking'
+             stop "" 
+         endif
+         ierr=NF_INQ_DIMLEN(nid,levdimin,levlen)
+
+         if((timelen/=ttm).or.(levlen/=llm)) then
+            write(*,*) 'ERROR: Not the good lenght for axis'
+            write(*,*) 'longitude: ',timelen,ttm+1
+            write(*,*) 'latitude: ',levlen,llm
+            stop ""  
+         endif
+
+!#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
+         ierr = NF_GET_VAR_DOUBLE(nid,levvar,lev)
+!#else
+!        ierr = NF_GET_VAR_REAL(nid,timevar,time)
+!        ierr = NF_GET_VAR_REAL(nid,levvar,lev)
+!#endif
+
+       return
+       end
+!=====================================================================
+
+       SUBROUTINE interp_sandu_vertical(play,nlev_sandu,plev_prof          &
+     &         ,t_prof,thl_prof,q_prof,u_prof,v_prof,w_prof                &
+     &         ,omega_prof,o3mmr_prof                                      &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                      &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+
+       implicit none
+
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of SANDUREF forcing data onto model levels
+!-------------------------------------------------------------------------
+
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_sandu,mxcalc
+!       real play(llm), plev_prof(nlevmax)
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+
+       real play(llm), plev_prof(nlev_sandu)
+       real t_prof(nlev_sandu),thl_prof(nlev_sandu),q_prof(nlev_sandu)
+       real u_prof(nlev_sandu),v_prof(nlev_sandu), w_prof(nlev_sandu)
+       real omega_prof(nlev_sandu),o3mmr_prof(nlev_sandu)
+
+       real t_mod(llm),thl_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real omega_mod(llm),o3mmr_mod(llm)
+
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_sandu)) then
+
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_sandu-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_sandu-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         omega_mod(l)=omega_prof(k2)-frac*(omega_prof(k2)-omega_prof(k1))
+         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
+
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
+         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+
+!jyg
+         fact=20.*(plev_prof(nlev_sandu)-play(l))/plev_prof(nlev_sandu) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_sandu)                                   !jyg
+         thl_mod(l)= thl_prof(nlev_sandu)                                   !jyg
+         q_mod(l)= q_prof(nlev_sandu)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_sandu)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_sandu)*fact                              !jyg
+         w_mod(l)= w_prof(nlev_sandu)*fact                              !jyg
+         omega_mod(l)= omega_prof(nlev_sandu)*fact                      !jyg
+         o3mmr_mod(l)= o3mmr_prof(nlev_sandu)*fact                      !jyg
+
+        endif ! play
+
+       enddo ! l
+
+       do l = 1,llm
+!      print *,'t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l) ',
+!    $        l,t_mod(l),thl_mod(l),q_mod(l),u_mod(l),v_mod(l)
+       enddo
+
+          return
+          end
+!=====================================================================
+       SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof          &
+     &         ,t_prof,thl_prof,qv_prof,ql_prof,qt_prof,u_prof,v_prof      &
+     &         ,w_prof,tke_prof,o3mmr_prof                                 &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod       &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+
+       implicit none
+
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of Astex forcing data onto model levels
+!-------------------------------------------------------------------------
+
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_astex,mxcalc
+!       real play(llm), plev_prof(nlevmax)
+!       real t_prof(nlevmax),qv_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+
+       real play(llm), plev_prof(nlev_astex)
+       real t_prof(nlev_astex),thl_prof(nlev_astex),qv_prof(nlev_astex)
+       real u_prof(nlev_astex),v_prof(nlev_astex), w_prof(nlev_astex)
+       real o3mmr_prof(nlev_astex),ql_prof(nlev_astex)
+       real qt_prof(nlev_astex),tke_prof(nlev_astex)
+
+       real t_mod(llm),thl_mod(llm),qv_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm),tke_mod(llm)
+       real o3mmr_mod(llm),ql_mod(llm),qt_mod(llm)
+
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_astex)) then
+
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_astex-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_astex-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         thl_mod(l)= thl_prof(k2) - frac*(thl_prof(k2)-thl_prof(k1))
+         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
+         ql_mod(l)= ql_prof(k2) - frac*(ql_prof(k2)-ql_prof(k1))
+         qt_mod(l)= qt_prof(k2) - frac*(qt_prof(k2)-qt_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         tke_mod(l)= tke_prof(k2) - frac*(tke_prof(k2)-tke_prof(k1))
+         o3mmr_mod(l)=o3mmr_prof(k2)-frac*(o3mmr_prof(k2)-o3mmr_prof(k1))
+
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         thl_mod(l)= frac1*thl_prof(k1) - frac2*thl_prof(k2)
+         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
+         ql_mod(l)= frac1*ql_prof(k1) - frac2*ql_prof(k2)
+         qt_mod(l)= frac1*qt_prof(k1) - frac2*qt_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         tke_mod(l)= frac1*tke_prof(k1) - frac2*tke_prof(k2)
+         o3mmr_mod(l)= frac1*o3mmr_prof(k1) - frac2*o3mmr_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+
+!jyg
+         fact=20.*(plev_prof(nlev_astex)-play(l))/plev_prof(nlev_astex) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_astex)                                   !jyg
+         thl_mod(l)= thl_prof(nlev_astex)                                   !jyg
+         qv_mod(l)= qv_prof(nlev_astex)*fact                              !jyg
+         ql_mod(l)= ql_prof(nlev_astex)*fact                              !jyg
+         qt_mod(l)= qt_prof(nlev_astex)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_astex)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_astex)*fact                              !jyg
+         w_mod(l)= w_prof(nlev_astex)*fact                              !jyg
+         tke_mod(l)= tke_prof(nlev_astex)*fact                              !jyg
+         o3mmr_mod(l)= o3mmr_prof(nlev_astex)*fact                      !jyg
+
+        endif ! play
+
+       enddo ! l
+
+       do l = 1,llm
+!      print *,'t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l) ',
+!    $        l,t_mod(l),thl_mod(l),qv_mod(l),u_mod(l),v_mod(l)
+       enddo
+
+          return
+          end
+
+!======================================================================
+      SUBROUTINE read_rico(fich_rico,nlev_rico,ps_rico,play                &
+     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico             &
+     &             ,dth_dyn,dqh_dyn)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read RICO forcing data 
+!-------------------------------------------------------------------------
+#include "dimensions.h"
+
+
+      integer nlev_rico
+      real ts_rico,ps_rico
+      real t_rico(llm),q_rico(llm)
+      real u_rico(llm),v_rico(llm)
+      real w_rico(llm)
+      real dth_dyn(llm)
+      real dqh_dyn(llm)
+      
+
+      real play(llm),zlay(llm)
+     
+
+      real prico(nlev_rico),zrico(nlev_rico)
+
+      character*80 fich_rico
+
+      integer k,l
+
+      
+      print*,fich_rico
+      open(21,file=trim(fich_rico),form='formatted')
+        do k=1,llm
+      zlay(k)=0.
+         enddo
+      
+        read(21,*) ps_rico,ts_rico
+        prico(1)=ps_rico
+        zrico(1)=0.0
+      do l=2,nlev_rico
+        read(21,*) k,prico(l),zrico(l)
+      enddo
+       close(21)
+
+      do k=1,llm
+        do l=1,80
+          if(prico(l)>play(k)) then
+              if(play(k)>prico(l+1)) then
+                zlay(k)=zrico(l)+(play(k)-prico(l)) *                      &
+     &              (zrico(l+1)-zrico(l))/(prico(l+1)-prico(l))
+              else 
+                zlay(k)=zrico(l)+(play(k)-prico(80))*                      &
+     &              (zrico(81)-zrico(80))/(prico(81)-prico(80))
+              endif
+          endif
+        enddo
+        print*,k,zlay(k)
+        ! U
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          u_rico(k)=-9.9 + (-1.9 + 9.9)*zlay(k)/4000
+        elseif(4000 < zlay(k) .and. zlay(k) < 12000) then
+       u_rico(k)=  -1.9 + (30.0 + 1.9) /                                   &
+     &          (12000 - 4000) * (zlay(k) - 4000)
+        elseif(12000 < zlay(k) .and. zlay(k) < 13000) then
+          u_rico(k)=30.0
+        elseif(13000 < zlay(k) .and. zlay(k) < 20000) then
+          u_rico(k)=30.0 - (30.0) /                                        &
+     & (20000 - 13000) * (zlay(k) - 13000)
+        else
+          u_rico(k)=0.0
+        endif
+
+!Q_v
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          q_rico(k)=16.0 + (13.8 - 16.0) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 3260) then
+          q_rico(k)=13.8 + (2.4 - 13.8) /                                   &
+     &          (3260 - 740) * (zlay(k) - 740)
+        elseif(3260 < zlay(k) .and. zlay(k) < 4000) then
+          q_rico(k)=2.4 + (1.8 - 2.4) /                                    &
+     &               (4000 - 3260) * (zlay(k) - 3260)
+        elseif(4000 < zlay(k) .and. zlay(k) < 9000) then
+          q_rico(k)=1.8 + (0 - 1.8) /                                      &
+     &             (9000 - 4000) * (zlay(k) - 4000)
+        else
+          q_rico(k)=0.0
+        endif
+
+!T
+        if(0 < zlay(k) .and. zlay(k) < 740) then
+          t_rico(k)=299.2 + (292.0 - 299.2) / (740) * zlay(k)
+        elseif(740 < zlay(k) .and. zlay(k) < 4000) then
+          t_rico(k)=292.0 + (278.0 - 292.0) /                              &                       
+     &       (4000 - 740) * (zlay(k) - 740)
+        elseif(4000 < zlay(k) .and. zlay(k) < 15000) then
+          t_rico(k)=278.0 + (203.0 - 278.0) /                              &
+     &       (15000 - 4000) * (zlay(k) - 4000)
+        elseif(15000 < zlay(k) .and. zlay(k) < 17500) then
+          t_rico(k)=203.0 + (194.0 - 203.0) /                              & 
+     &       (17500 - 15000)* (zlay(k) - 15000)
+        elseif(17500 < zlay(k) .and. zlay(k) < 20000) then
+          t_rico(k)=194.0 + (206.0 - 194.0) /                              &
+     &       (20000 - 17500)* (zlay(k) - 17500)
+        elseif(20000 < zlay(k) .and. zlay(k) < 60000) then
+          t_rico(k)=206.0 + (270.0 - 206.0) /                              & 
+     &        (60000 - 20000)* (zlay(k) - 20000)
+        endif
+
+! W
+        if(0 < zlay(k) .and. zlay(k) < 2260 ) then
+          w_rico(k)=- (0.005/2260) * zlay(k)
+        elseif(2260 < zlay(k) .and. zlay(k) < 4000 ) then
+          w_rico(k)=- 0.005
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000 ) then
+       w_rico(k)=- 0.005 + (0.005/ (5000 - 4000)) * (zlay(k) - 4000)
+        else
+          w_rico(k)=0.0
+        endif
+
+! dThrz+dTsw0+dTlw0
+        if(0 < zlay(k) .and. zlay(k) < 4000) then
+          dth_dyn(k)=- 2.51 / 86400 + (-2.18 + 2.51 )/                     &
+     &               (86400*4000) * zlay(k)
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dth_dyn(k)=- 2.18 / 86400 + ( 2.18 ) /                           &
+     &           (86400*(5000 - 4000)) * (zlay(k) - 4000)
+        else
+          dth_dyn(k)=0.0
+        endif
+! dQhrz
+        if(0 < zlay(k) .and. zlay(k) < 3000) then
+          dqh_dyn(k)=-1.0 / 86400 + (0.345 + 1.0)/                         &
+     &                    (86400*3000) * (zlay(k))
+        elseif(3000 < zlay(k) .and. zlay(k) < 4000) then
+          dqh_dyn(k)=0.345 / 86400
+        elseif(4000 < zlay(k) .and. zlay(k) < 5000) then
+          dqh_dyn(k)=0.345 / 86400 +                                       &
+     &   (-0.345)/(86400 * (5000 - 4000)) * (zlay(k)-4000)
+        else
+          dqh_dyn(k)=0.0
+        endif
+
+!?        if(play(k)>6e4) then
+!?          ratqs0(1,k)=ratqsbas*(plev(1)-play(k))/(plev(1)-6e4)
+!?        elseif((play(k)>3e4).and.(play(k)<6e4)) then
+!?          ratqs0(1,k)=ratqsbas+(ratqshaut-ratqsbas)&
+!?                          *(6e4-play(k))/(6e4-3e4)
+!?        else
+!?          ratqs0(1,k)=ratqshaut
+!?        endif
+
+      enddo
+
+      do k=1,llm
+      q_rico(k)=q_rico(k)/1e3 
+      dqh_dyn(k)=dqh_dyn(k)/1e3
+      v_rico(k)=-3.8
+      enddo
+
+          return
+          end
+
+!======================================================================
+        SUBROUTINE interp_sandu_time(day,day1,annee_ref                    &
+     &             ,year_ini_sandu,day_ini_sandu,nt_sandu,dt_sandu         &
+     &             ,nlev_sandu,ts_sandu,ts_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_sandu: total nb of data in the forcing (e.g. 13 for Sanduref)
+! dt_sandu: total time interval (in sec) between 2 forcing data (e.g. 6h for Sanduref)
+!---------------------------------------------------------------------------------------
+! inputs:
+        integer annee_ref
+        integer nt_sandu,nlev_sandu
+        integer year_ini_sandu
+        real day, day1,day_ini_sandu,dt_sandu
+        real ts_sandu(nt_sandu)
+! outputs:
+        real ts_prof
+! local:
+        integer it_sandu1, it_sandu2
+        real timeit,time_sandu1,time_sandu2,frac
+! Check that initial day of the simulation consistent with SANDU period:
+       if (annee_ref.ne.2006 ) then
+        print*,'Pour SANDUREF, annee_ref doit etre 2006 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+!      if (annee_ref.eq.2006 .and. day1.lt.day_ini_sandu) then
+!       print*,'SANDUREF debute le 15 Juillet 2006 (jour julien=196)'
+!       print*,'Changer dayref dans run.def'
+!       stop
+!      endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_sandu)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_sandu)*86400
+
+! Determine the closest observation times:
+       it_sandu1=INT(timeit/dt_sandu)+1
+       it_sandu2=it_sandu1 + 1
+       time_sandu1=(it_sandu1-1)*dt_sandu
+       time_sandu2=(it_sandu2-1)*dt_sandu
+       print *,'timeit day day_ini_sandu',timeit,day,day_ini_sandu
+       print *,'it_sandu1,it_sandu2,time_sandu1,time_sandu2',              &
+     &          it_sandu1,it_sandu2,time_sandu1,time_sandu2
+
+       if (it_sandu1 .ge. nt_sandu) then
+        write(*,*) 'PB-stop: day, it_sandu1, it_sandu2, timeit: '          &
+     &        ,day,it_sandu1,it_sandu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_sandu2-timeit)/(time_sandu2-time_sandu1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_sandu(it_sandu2)                                       &
+     &          -frac*(ts_sandu(it_sandu2)-ts_sandu(it_sandu1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_sandu,timeit,it_sandu1,it_sandu2,SST:',       &
+     &day,annee_ref,day_ini_sandu,timeit/86400.,it_sandu1,                  &
+     &it_sandu2,ts_prof
+
+        return
+        END
+!=====================================================================
+!-------------------------------------------------------------------------
+      SUBROUTINE read_armcu(fich_armcu,nlev_armcu,nt_armcu,                &
+     & sens,flat,adv_theta,rad_theta,adv_qt)
+      implicit none
+
+!-------------------------------------------------------------------------
+! Read ARM_CU case forcing data
+!-------------------------------------------------------------------------
+
+      integer nlev_armcu,nt_armcu
+      real sens(nt_armcu),flat(nt_armcu)
+      real adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
+      character*80 fich_armcu
+
+      integer ip
+
+      integer iy,im,id,ih,in
+
+      print*,'nlev_armcu',nlev_armcu
+
+      open(21,file=trim(fich_armcu),form='formatted')
+      read(21,'(a)')
+      do ip = 1, nt_armcu
+      read(21,'(a)')
+      read(21,'(a)')
+      read(21,223) iy, im, id, ih, in, sens(ip),flat(ip),                  &
+     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      print *,'forcages=',iy,im,id,ih,in, sens(ip),flat(ip),               &
+     &             adv_theta(ip),rad_theta(ip),adv_qt(ip)
+      enddo
+      close(21)
+
+  223 format(5i3,5f8.3)
+
+          return
+          end
+
+!=====================================================================
+       SUBROUTINE interp_toga_vertical(play,nlev_toga,plev_prof            &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                         &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                            &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                              &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of TOGA-COARE forcing data onto model levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_toga,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof(nlev_toga) 
+       real t_prof(nlev_toga),q_prof(nlev_toga)
+       real u_prof(nlev_toga),v_prof(nlev_toga), w_prof(nlev_toga)
+       real ht_prof(nlev_toga),vt_prof(nlev_toga)
+       real hq_prof(nlev_toga),vq_prof(nlev_toga)
+ 
+       real t_mod(llm),q_mod(llm)
+       real u_mod(llm),v_mod(llm), w_mod(llm)
+       real ht_mod(llm),vt_mod(llm)
+       real hq_mod(llm),vq_mod(llm)
+ 
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_toga)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_toga-1
+          if (play(l).le.plev_prof(k).and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_toga-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         t_mod(l)= t_prof(k2) - frac*(t_prof(k2)-t_prof(k1))
+         q_mod(l)= q_prof(k2) - frac*(q_prof(k2)-q_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         vt_mod(l)= vt_prof(k2) - frac*(vt_prof(k2)-vt_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         vq_mod(l)= vq_prof(k2) - frac*(vq_prof(k2)-vq_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         t_mod(l)= frac1*t_prof(k1) - frac2*t_prof(k2)
+         q_mod(l)= frac1*q_prof(k1) - frac2*q_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         vt_mod(l)= frac1*vt_prof(k1) - frac2*vt_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         vq_mod(l)= frac1*vq_prof(k1) - frac2*vq_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof(nlev_toga)-play(l))/plev_prof(nlev_toga) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod(l)= t_prof(nlev_toga)                                   !jyg
+         q_mod(l)= q_prof(nlev_toga)*fact                              !jyg
+         u_mod(l)= u_prof(nlev_toga)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_toga)*fact                              !jyg
+         w_mod(l)= 0.0                                                 !jyg
+         ht_mod(l)= ht_prof(nlev_toga)                                 !jyg
+         vt_mod(l)= vt_prof(nlev_toga)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_toga)*fact                            !jyg
+         vq_mod(l)= vq_prof(nlev_toga)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+ 
+!=====================================================================
+       SUBROUTINE interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of TOGA-COARE forcing data onto mod_casel levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_cas,mxcalc
+!       real play(llm), plev_prof(nlevmax) 
+!       real t_prof(nlevmax),q_prof(nlevmax)
+!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
+!       real ht_prof(nlevmax),vt_prof(nlevmax)
+!       real hq_prof(nlevmax),vq_prof(nlevmax)
+ 
+       real play(llm), plev_prof_cas(nlev_cas) 
+       real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas)
+       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
+       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas)
+       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
+       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
+       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
+       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
+ 
+       real t_mod_cas(llm),q_mod_cas(llm)
+       real u_mod_cas(llm),v_mod_cas(llm)
+       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm)
+       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
+       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
+       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
+       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
+ 
+       integer l,k,k1,k2
+       real frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof_cas(nlev_cas)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof_cas(1)) then
+
+         do k = 1, nlev_cas-1
+          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_cas-1
+          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
+         t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
+         q_mod_cas(l)= q_prof_cas(k2) - frac*(q_prof_cas(k2)-q_prof_cas(k1))
+         u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
+         v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
+         ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
+         vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
+         w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
+         du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
+         hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
+         vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
+         dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
+         hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
+         vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
+         dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
+         ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
+         vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
+         dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
+         hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
+         vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
+     
+         else !play>plev_prof_cas(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
+         t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
+         q_mod_cas(l)= frac1*q_prof_cas(k1) - frac2*q_prof_cas(k2)
+         u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
+         v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
+         ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
+         vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
+         w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
+         du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
+         hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
+         vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
+         dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
+         hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
+         vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
+         dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
+         ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
+         vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
+         dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
+         hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
+         vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
+
+         endif ! play.le.plev_prof_cas(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         t_mod_cas(l)= t_prof_cas(nlev_cas)                                   !jyg
+         q_mod_cas(l)= q_prof_cas(nlev_cas)*fact                              !jyg
+         u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                              !jyg
+         v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                              !jyg
+         ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact                              !jyg
+         vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact                              !jyg
+         w_mod_cas(l)= 0.0                                                 !jyg
+         du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 
+         hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                            !jyg
+         vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                            !jyg
+         dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 
+         hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                            !jyg
+         vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                            !jyg
+         dt_mod_cas(l)= dt_prof_cas(nlev_cas) 
+         ht_mod_cas(l)= ht_prof_cas(nlev_cas)                                 !jyg
+         vt_mod_cas(l)= vt_prof_cas(nlev_cas)                                 !jyg
+         dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 
+         hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                            !jyg
+         vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                            !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ',
+!     $        l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l)
+!       enddo
+ 
+          return
+          end
+!***************************************************************************** 
+!=====================================================================
+       SUBROUTINE interp_dice_vertical(play,nlev_dice,nt_dice,plev_prof   &
+     &         ,th_prof,qv_prof,u_prof,v_prof,o3_prof                     &
+     &         ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof         &
+     &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                          &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+ 
+       implicit none
+ 
+#include "dimensions.h"
+
+!-------------------------------------------------------------------------
+! Vertical interpolation of Dice forcing data onto model levels
+!-------------------------------------------------------------------------
+ 
+       integer nlevmax
+       parameter (nlevmax=41)
+       integer nlev_dice,mxcalc,nt_dice
+ 
+       real play(llm), plev_prof(nlev_dice) 
+       real th_prof(nlev_dice),qv_prof(nlev_dice)
+       real u_prof(nlev_dice),v_prof(nlev_dice) 
+       real o3_prof(nlev_dice)
+       real ht_prof(nlev_dice),hq_prof(nlev_dice)
+       real hu_prof(nlev_dice),hv_prof(nlev_dice)
+       real w_prof(nlev_dice),omega_prof(nlev_dice)
+ 
+       real th_mod(llm),qv_mod(llm)
+       real u_mod(llm),v_mod(llm), o3_mod(llm)
+       real ht_mod(llm),hq_mod(llm)
+       real hu_mod(llm),hv_mod(llm),w_mod(llm),omega_mod(llm)
+ 
+       integer l,k,k1,k2,kp
+       real aa,frac,frac1,frac2,fact
+ 
+       do l = 1, llm
+
+        if (play(l).ge.plev_prof(nlev_dice)) then
+ 
+        mxcalc=l
+         k1=0
+         k2=0
+
+         if (play(l).le.plev_prof(1)) then
+
+         do k = 1, nlev_dice-1
+          if (play(l).le.plev_prof(k) .and. play(l).gt.plev_prof(k+1)) then
+            k1=k
+            k2=k+1
+          endif
+         enddo
+
+         if (k1.eq.0 .or. k2.eq.0) then
+          write(*,*) 'PB! k1, k2 = ',k1,k2
+          write(*,*) 'l,play(l) = ',l,play(l)/100
+         do k = 1, nlev_dice-1
+          write(*,*) 'k,plev_prof(k) = ',k,plev_prof(k)/100
+         enddo
+         endif
+
+         frac = (plev_prof(k2)-play(l))/(plev_prof(k2)-plev_prof(k1))
+         th_mod(l)= th_prof(k2) - frac*(th_prof(k2)-th_prof(k1))
+         qv_mod(l)= qv_prof(k2) - frac*(qv_prof(k2)-qv_prof(k1))
+         u_mod(l)= u_prof(k2) - frac*(u_prof(k2)-u_prof(k1))
+         v_mod(l)= v_prof(k2) - frac*(v_prof(k2)-v_prof(k1))
+         o3_mod(l)= o3_prof(k2) - frac*(o3_prof(k2)-o3_prof(k1))
+         ht_mod(l)= ht_prof(k2) - frac*(ht_prof(k2)-ht_prof(k1))
+         hq_mod(l)= hq_prof(k2) - frac*(hq_prof(k2)-hq_prof(k1))
+         hu_mod(l)= hu_prof(k2) - frac*(hu_prof(k2)-hu_prof(k1))
+         hv_mod(l)= hv_prof(k2) - frac*(hv_prof(k2)-hv_prof(k1))
+         w_mod(l)= w_prof(k2) - frac*(w_prof(k2)-w_prof(k1))
+         omega_mod(l)= omega_prof(k2) - frac*(omega_prof(k2)-omega_prof(k1))
+     
+         else !play>plev_prof(1)
+
+         k1=1
+         k2=2
+         frac1 = (play(l)-plev_prof(k2))/(plev_prof(k1)-plev_prof(k2))
+         frac2 = (play(l)-plev_prof(k1))/(plev_prof(k1)-plev_prof(k2))
+         th_mod(l)= frac1*th_prof(k1) - frac2*th_prof(k2)
+         qv_mod(l)= frac1*qv_prof(k1) - frac2*qv_prof(k2)
+         u_mod(l)= frac1*u_prof(k1) - frac2*u_prof(k2)
+         v_mod(l)= frac1*v_prof(k1) - frac2*v_prof(k2)
+         o3_mod(l)= frac1*o3_prof(k1) - frac2*o3_prof(k2)
+         ht_mod(l)= frac1*ht_prof(k1) - frac2*ht_prof(k2)
+         hq_mod(l)= frac1*hq_prof(k1) - frac2*hq_prof(k2)
+         hu_mod(l)= frac1*hu_prof(k1) - frac2*hu_prof(k2)
+         hv_mod(l)= frac1*hv_prof(k1) - frac2*hv_prof(k2)
+         w_mod(l)= frac1*w_prof(k1) - frac2*w_prof(k2)
+         omega_mod(l)= frac1*omega_prof(k1) - frac2*omega_prof(k2)
+
+         endif ! play.le.plev_prof(1)
+
+        else ! above max altitude of forcing file
+ 
+!jyg
+         fact=20.*(plev_prof(nlev_dice)-play(l))/plev_prof(nlev_dice) !jyg
+         fact = max(fact,0.)                                           !jyg
+         fact = exp(-fact)                                             !jyg
+         th_mod(l)= th_prof(nlev_dice)                                 !jyg
+         qv_mod(l)= qv_prof(nlev_dice)*fact                            !jyg
+         u_mod(l)= u_prof(nlev_dice)*fact                              !jyg
+         v_mod(l)= v_prof(nlev_dice)*fact                              !jyg
+         o3_mod(l)= o3_prof(nlev_dice)*fact                            !jyg
+         ht_mod(l)= ht_prof(nlev_dice)                                 !jyg
+         hq_mod(l)= hq_prof(nlev_dice)*fact                            !jyg
+         hu_mod(l)= hu_prof(nlev_dice)                                 !jyg
+         hv_mod(l)= hv_prof(nlev_dice)                                 !jyg
+         w_mod(l)= 0.                                                  !jyg
+         omega_mod(l)= 0.                                              !jyg
+ 
+        endif ! play
+ 
+       enddo ! l
+
+!       do l = 1,llm
+!       print *,'t_mod(l),q_mod(l),ht_mod(l),hq_mod(l) ',
+!     $        l,t_mod(l),q_mod(l),ht_mod(l),hq_mod(l)
+!       enddo
+ 
+          return
+          end
+
+!======================================================================
+        SUBROUTINE interp_astex_time(day,day1,annee_ref                    &
+     &             ,year_ini_astex,day_ini_astex,nt_astex,dt_astex         &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex        &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof   &
+     &             ,ufa_prof,vfa_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_astex: total nb of data in the forcing (e.g. 41 for Astex)
+! dt_astex: total time interval (in sec) between 2 forcing data (e.g. 1h for Astex)
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_astex,nlev_astex
+        integer year_ini_astex
+        real day, day1,day_ini_astex,dt_astex
+        real div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
+        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+! outputs:
+        real div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+! local:
+        integer it_astex1, it_astex2
+        real timeit,time_astex1,time_astex2,frac
+
+! Check that initial day of the simulation consistent with ASTEX period:
+       if (annee_ref.ne.1992 ) then
+        print*,'Pour Astex, annee_ref doit etre 1992 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_astex) then
+        print*,'Astex debute le 13 Juin 1992 (jour julien=165)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_astex)*86400.
+!       else
+!        timeit=(day+2.-1.)*86400. ! 2 days between Jun13 and Jun15 1992
+!       endif
+      timeit=(day-day_ini_astex)*86400
+
+! Determine the closest observation times:
+       it_astex1=INT(timeit/dt_astex)+1
+       it_astex2=it_astex1 + 1
+       time_astex1=(it_astex1-1)*dt_astex
+       time_astex2=(it_astex2-1)*dt_astex
+       print *,'timeit day day_ini_astex',timeit,day,day_ini_astex
+       print *,'it_astex1,it_astex2,time_astex1,time_astex2',              &
+     &          it_astex1,it_astex2,time_astex1,time_astex2
+
+       if (it_astex1 .ge. nt_astex) then
+        write(*,*) 'PB-stop: day, it_astex1, it_astex2, timeit: '          &
+     &        ,day,it_astex1,it_astex2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_astex2-timeit)/(time_astex2-time_astex1)
+       frac=max(frac,0.0)
+
+       div_prof = div_astex(it_astex2)                                     &
+     &          -frac*(div_astex(it_astex2)-div_astex(it_astex1))
+       ts_prof = ts_astex(it_astex2)                                        &
+     &          -frac*(ts_astex(it_astex2)-ts_astex(it_astex1))
+       ug_prof = ug_astex(it_astex2)                                       &
+     &          -frac*(ug_astex(it_astex2)-ug_astex(it_astex1))
+       vg_prof = vg_astex(it_astex2)                                       &
+     &          -frac*(vg_astex(it_astex2)-vg_astex(it_astex1))
+       ufa_prof = ufa_astex(it_astex2)                                     &
+     &          -frac*(ufa_astex(it_astex2)-ufa_astex(it_astex1))
+       vfa_prof = vfa_astex(it_astex2)                                     &
+     &          -frac*(vfa_astex(it_astex2)-vfa_astex(it_astex1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_astex,timeit,it_astex1,it_astex2,SST:',       &
+     &day,annee_ref,day_ini_astex,timeit/86400.,it_astex1,                 &
+     &it_astex2,div_prof,ts_prof,ug_prof,vg_prof,ufa_prof,vfa_prof 
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_toga_time(day,day1,annee_ref                     &
+     &             ,year_ini_toga,day_ini_toga,nt_toga,dt_toga,nlev_toga   &
+     &             ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga   &
+     &             ,ht_toga,vt_toga,hq_toga,vq_toga                        &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof   &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_toga: total nb of data in the forcing (e.g. 480 for TOGA-COARE)
+! dt_toga: total time interval (in sec) between 2 forcing data (e.g. 6h for TOGA-COARE)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_toga,nlev_toga
+        integer year_ini_toga
+        real day, day1,day_ini_toga,dt_toga
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),t_toga(nlev_toga,nt_toga)
+        real q_toga(nlev_toga,nt_toga),u_toga(nlev_toga,nt_toga)
+        real v_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+! outputs:
+        real ts_prof
+        real plev_prof(nlev_toga),t_prof(nlev_toga)
+        real q_prof(nlev_toga),u_prof(nlev_toga)
+        real v_prof(nlev_toga),w_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+! local:
+        integer it_toga1, it_toga2,k
+        real timeit,time_toga1,time_toga2,frac
+
+
+        if (forcing_type.eq.2) then
+! Check that initial day of the simulation consistent with TOGA-COARE period:
+       if (annee_ref.ne.1992 .and. annee_ref.ne.1993) then
+        print*,'Pour TOGA-COARE, annee_ref doit etre 1992 ou 1993'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
+        print*,'TOGA-COARE a débuté le 1er Nov 1992 (jour julien=306)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1993 .and. day1.gt.day_ini_toga+119) then
+        print*,'TOGA-COARE a fini le 28 Feb 1993 (jour julien=59)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       else if (forcing_type.eq.4) then
+
+! Check that initial day of the simulation consistent with TWP-ICE period:
+       if (annee_ref.ne.2006) then
+        print*,'Pour TWP-ICE, annee_ref doit etre 2006'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.lt.day_ini_toga) then
+        print*,'TWP-ICE a debute le 17 Jan 2006 (jour julien=17)'
+        print*,'Changer dayref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.2006 .and. day1.gt.day_ini_toga+26) then
+        print*,'TWP-ICE a fini le 12 Feb 2006 (jour julien=43)'
+        print*,'Changer dayref ou nday dans run.def'
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_toga)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_toga)*86400
+
+! Determine the closest observation times:
+       it_toga1=INT(timeit/dt_toga)+1
+       it_toga2=it_toga1 + 1
+       time_toga1=(it_toga1-1)*dt_toga
+       time_toga2=(it_toga2-1)*dt_toga
+
+       if (it_toga1 .ge. nt_toga) then
+        write(*,*) 'PB-stop: day, it_toga1, it_toga2, timeit: '            &
+     &        ,day,it_toga1,it_toga2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_toga2-timeit)/(time_toga2-time_toga1)
+       frac=max(frac,0.0)
+
+       ts_prof = ts_toga(it_toga2)                                         &
+     &          -frac*(ts_toga(it_toga2)-ts_toga(it_toga1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_toga,timeit,it_toga1,it_toga2,SST:',
+!     :day,annee_ref,day_ini_toga,timeit/86400.,it_toga1,it_toga2,ts_prof
+
+       do k=1,nlev_toga
+        plev_prof(k) = 100.*(plev_toga(k,it_toga2)                         &
+     &          -frac*(plev_toga(k,it_toga2)-plev_toga(k,it_toga1)))
+        t_prof(k) = t_toga(k,it_toga2)                                     &
+     &          -frac*(t_toga(k,it_toga2)-t_toga(k,it_toga1))
+        q_prof(k) = q_toga(k,it_toga2)                                     &
+     &          -frac*(q_toga(k,it_toga2)-q_toga(k,it_toga1))
+        u_prof(k) = u_toga(k,it_toga2)                                     &
+     &          -frac*(u_toga(k,it_toga2)-u_toga(k,it_toga1))
+        v_prof(k) = v_toga(k,it_toga2)                                     &
+     &          -frac*(v_toga(k,it_toga2)-v_toga(k,it_toga1))
+        w_prof(k) = w_toga(k,it_toga2)                                     &
+     &          -frac*(w_toga(k,it_toga2)-w_toga(k,it_toga1))
+        ht_prof(k) = ht_toga(k,it_toga2)                                   &
+     &          -frac*(ht_toga(k,it_toga2)-ht_toga(k,it_toga1))
+        vt_prof(k) = vt_toga(k,it_toga2)                                   &
+     &          -frac*(vt_toga(k,it_toga2)-vt_toga(k,it_toga1))
+        hq_prof(k) = hq_toga(k,it_toga2)                                   &
+     &          -frac*(hq_toga(k,it_toga2)-hq_toga(k,it_toga1))
+        vq_prof(k) = vq_toga(k,it_toga2)                                   &
+     &          -frac*(vq_toga(k,it_toga2)-vq_toga(k,it_toga1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_dice_time(day,day1,annee_ref                    &
+     &             ,year_ini_dice,day_ini_dice,nt_dice,dt_dice            &
+     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice       &
+     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice         &
+     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice     &
+     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof         &
+     &             ,ustar_prof,psurf_prof,ug_prof,vg_prof                 &
+     &             ,ht_prof,hq_prof,hu_prof,hv_prof,w_prof,omega_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_dice: total nb of data in the forcing (e.g. 145 for Dice)
+! dt_dice: total time interval (in sec) between 2 forcing data (e.g. 30min. for Dice)
+!---------------------------------------------------------------------------------------
+
+#include "compar1d.h"
+
+! inputs:
+        integer annee_ref
+        integer nt_dice,nlev_dice
+        integer year_ini_dice
+        real day, day1,day_ini_dice,dt_dice
+        real shf_dice(nt_dice),lhf_dice(nt_dice),lwup_dice(nt_dice)
+        real swup_dice(nt_dice),tg_dice(nt_dice),ustar_dice(nt_dice)
+        real psurf_dice(nt_dice),ug_dice(nt_dice),vg_dice(nt_dice)
+        real ht_dice(nlev_dice,nt_dice),hq_dice(nlev_dice,nt_dice)
+        real hu_dice(nlev_dice,nt_dice),hv_dice(nlev_dice,nt_dice)
+        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+! outputs:
+        real tg_prof,shf_prof,lhf_prof,lwup_prof,swup_prof
+        real ustar_prof,psurf_prof,ug_prof,vg_prof
+        real ht_prof(nlev_dice),hq_prof(nlev_dice)
+        real hu_prof(nlev_dice),hv_prof(nlev_dice)
+        real w_prof(nlev_dice),omega_prof(nlev_dice)
+! local:
+        integer it_dice1, it_dice2,k
+        real timeit,time_dice1,time_dice2,frac
+
+
+        if (forcing_type.eq.7) then
+! Check that initial day of the simulation consistent with Dice period:
+       print *,'annee_ref=',annee_ref
+       print *,'day1=',day1
+       print *,'day_ini_dice=',day_ini_dice
+       if (annee_ref.ne.1999) then
+        print*,'Pour Dice, annee_ref doit etre 1999'
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice) then
+        print*,'Dice a debute le 23 Oct 1999 (jour julien=296)'
+        print*,'Changer dayref dans run.def',day1,day_ini_dice
+        stop
+       endif
+       if (annee_ref.eq.1999 .and. day1.gt.day_ini_dice+2) then
+        print*,'Dice a fini le 25 Oct 1999 (jour julien=298)'
+        print*,'Changer dayref ou nday dans run.def',day1,day_ini_dice
+        stop
+       endif
+
+       endif
+
+! Determine timestep relative to the 1st day of TOGA-COARE:
+!       timeit=(day-day1)*86400.
+!       if (annee_ref.eq.1992) then
+!        timeit=(day-day_ini_dice)*86400.
+!       else
+!        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
+!       endif
+      timeit=(day-day_ini_dice)*86400
+
+! Determine the closest observation times:
+       it_dice1=INT(timeit/dt_dice)+1
+       it_dice2=it_dice1 + 1
+       time_dice1=(it_dice1-1)*dt_dice
+       time_dice2=(it_dice2-1)*dt_dice
+
+       if (it_dice1 .ge. nt_dice) then
+        write(*,*) 'PB-stop: day, it_dice1, it_dice2, timeit: ',day,it_dice1,it_dice2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_dice2-timeit)/(time_dice2-time_dice1)
+       frac=max(frac,0.0)
+
+       shf_prof = shf_dice(it_dice2)-frac*(shf_dice(it_dice2)-shf_dice(it_dice1))
+       lhf_prof = lhf_dice(it_dice2)-frac*(lhf_dice(it_dice2)-lhf_dice(it_dice1))
+       lwup_prof = lwup_dice(it_dice2)-frac*(lwup_dice(it_dice2)-lwup_dice(it_dice1))
+       swup_prof = swup_dice(it_dice2)-frac*(swup_dice(it_dice2)-swup_dice(it_dice1))
+       tg_prof = tg_dice(it_dice2)-frac*(tg_dice(it_dice2)-tg_dice(it_dice1))
+       ustar_prof = ustar_dice(it_dice2)-frac*(ustar_dice(it_dice2)-ustar_dice(it_dice1))
+       psurf_prof = psurf_dice(it_dice2)-frac*(psurf_dice(it_dice2)-psurf_dice(it_dice1))
+       ug_prof = ug_dice(it_dice2)-frac*(ug_dice(it_dice2)-ug_dice(it_dice1))
+       vg_prof = vg_dice(it_dice2)-frac*(vg_dice(it_dice2)-vg_dice(it_dice1))
+
+!        print*,
+!     :'day,annee_ref,day_ini_dice,timeit,it_dice1,it_dice2,SST:',
+!     :day,annee_ref,day_ini_dice,timeit/86400.,it_dice1,it_dice2,ts_prof
+
+       do k=1,nlev_dice
+        ht_prof(k) = ht_dice(k,it_dice2)-frac*(ht_dice(k,it_dice2)-ht_dice(k,it_dice1))
+        hq_prof(k) = hq_dice(k,it_dice2)-frac*(hq_dice(k,it_dice2)-hq_dice(k,it_dice1))
+        hu_prof(k) = hu_dice(k,it_dice2)-frac*(hu_dice(k,it_dice2)-hu_dice(k,it_dice1))
+        hv_prof(k) = hv_dice(k,it_dice2)-frac*(hv_dice(k,it_dice2)-hv_dice(k,it_dice1))
+        w_prof(k) = w_dice(k,it_dice2)-frac*(w_dice(k,it_dice2)-w_dice(k,it_dice1))
+        omega_prof(k) = omega_dice(k,it_dice2)-frac*(omega_dice(k,it_dice2)-omega_dice(k,it_dice1))
+        enddo
+
+        return
+        END
+
+!======================================================================
+        SUBROUTINE interp_armcu_time(day,day1,annee_ref                    &
+     &             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu         &
+     &             ,nlev_armcu,fs_armcu,fl_armcu,at_armcu,rt_armcu         &
+     &             ,aqt_armcu,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof)
+        implicit none
+
+!---------------------------------------------------------------------------------------
+! Time interpolation of a 2D field to the timestep corresponding to day
+!
+! day: current julian day (e.g. 717538.2)
+! day1: first day of the simulation
+! nt_armcu: total nb of data in the forcing (e.g. 31 for armcu)
+! dt_armcu: total time interval (in sec) between 2 forcing data (e.g. 1/2h for armcu)
+! fs= sensible flux
+! fl= latent flux
+! at,rt,aqt= advective and radiative tendencies
+!---------------------------------------------------------------------------------------
+
+! inputs:
+        integer annee_ref
+        integer nt_armcu,nlev_armcu
+        integer year_ini_armcu
+        real day, day1,day_ini_armcu,dt_armcu
+        real fs_armcu(nt_armcu),fl_armcu(nt_armcu),at_armcu(nt_armcu)
+        real rt_armcu(nt_armcu),aqt_armcu(nt_armcu)
+! outputs:
+        real fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+! local:
+        integer it_armcu1, it_armcu2,k
+        real timeit,time_armcu1,time_armcu2,frac
+
+! Check that initial day of the simulation consistent with ARMCU period:
+       if (annee_ref.ne.1997 ) then
+        print*,'Pour ARMCU, annee_ref doit etre 1997 '
+        print*,'Changer annee_ref dans run.def'
+        stop
+       endif
+
+      timeit=(day-day_ini_armcu)*86400
+
+! Determine the closest observation times:
+       it_armcu1=INT(timeit/dt_armcu)+1
+       it_armcu2=it_armcu1 + 1
+       time_armcu1=(it_armcu1-1)*dt_armcu
+       time_armcu2=(it_armcu2-1)*dt_armcu
+       print *,'timeit day day_ini_armcu',timeit,day,day_ini_armcu
+       print *,'it_armcu1,it_armcu2,time_armcu1,time_armcu2',              &
+     &          it_armcu1,it_armcu2,time_armcu1,time_armcu2
+
+       if (it_armcu1 .ge. nt_armcu) then
+        write(*,*) 'PB-stop: day, it_armcu1, it_armcu2, timeit: '          &
+     &        ,day,it_armcu1,it_armcu2,timeit/86400.
+        stop
+       endif
+
+! time interpolation:
+       frac=(time_armcu2-timeit)/(time_armcu2-time_armcu1)
+       frac=max(frac,0.0)
+
+       fs_prof = fs_armcu(it_armcu2)                                       &
+     &          -frac*(fs_armcu(it_armcu2)-fs_armcu(it_armcu1))
+       fl_prof = fl_armcu(it_armcu2)                                       &
+     &          -frac*(fl_armcu(it_armcu2)-fl_armcu(it_armcu1))
+       at_prof = at_armcu(it_armcu2)                                       &
+     &          -frac*(at_armcu(it_armcu2)-at_armcu(it_armcu1))
+       rt_prof = rt_armcu(it_armcu2)                                       &
+     &          -frac*(rt_armcu(it_armcu2)-rt_armcu(it_armcu1))
+       aqt_prof = aqt_armcu(it_armcu2)                                       &
+     &          -frac*(aqt_armcu(it_armcu2)-aqt_armcu(it_armcu1))
+
+         print*,                                                           &
+     &'day,annee_ref,day_ini_armcu,timeit,it_armcu1,it_armcu2,SST:',       &
+     &day,annee_ref,day_ini_armcu,timeit/86400.,it_armcu1,                 &
+     &it_armcu2,fs_prof,fl_prof,at_prof,rt_prof,aqt_prof
+
+        return
+        END
+
+!=====================================================================
+      subroutine readprofiles(nlev_max,kmax,ntrac,height,                  &
+     &           thlprof,qtprof,uprof,                                     &
+     &           vprof,e12prof,ugprof,vgprof,                              &
+     &           wfls,dqtdxls,dqtdyls,dqtdtls,                             &
+     &           thlpcar,tracer,nt1,nt2)
+      implicit none
+
+        integer nlev_max,kmax,kmax2,ntrac
+        logical :: llesread = .true.
+
+        real height(nlev_max),thlprof(nlev_max),qtprof(nlev_max),          &
+     &       uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max),            &
+     &       ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max),             &
+     &       dqtdxls(nlev_max),dqtdyls(nlev_max),dqtdtls(nlev_max),        &
+     &           thlpcar(nlev_max),tracer(nlev_max,ntrac)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,k,itrac,nt1,nt2
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),thlprof(k),qtprof (k),               &
+     &                      uprof (k),vprof  (k),e12prof(k)
+        enddo
+        close(ilesfile)
+
+       open(ilesfile,file='lscale.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Lscale.inp does not exist'
+        read (ilesfile,*) kmax2
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),ugprof(k),vgprof(k),wfls(k),         &
+     &                      dqtdxls(k),dqtdyls(k),dqtdtls(k),thlpcar(k)
+        end do
+        close(ilesfile)
+
+       open(ilesfile,file='trac.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) then
+            print*,'WARNING : trac.inp does not exist'
+        else
+        read (ilesfile,*) kmax2,nt1,nt2
+        if (nt2>ntrac) then
+          stop'Augmenter le nombre de traceurs dans traceur.def'
+        endif
+        if (kmax .ne. kmax2) then
+          print *, 'fichiers prof.inp et lscale.inp incompatibles :'
+          print *, 'nbre de niveaux : ',kmax,' et ',kmax2
+          stop 'lecture profiles'
+        endif
+        do k=1,kmax
+          read (ilesfile,*) height(k),(tracer(k,itrac),itrac=nt1,nt2)
+        end do
+        close(ilesfile)
+        endif
+
+        return
+        end
+!======================================================================
+      subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof,       &
+     &       thlprof,qprof,uprof,vprof,wprof,omega,o3mmr)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        real thlprof(nlev_max)
+        real qprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        real wprof(nlev_max),omega(nlev_max),o3mmr(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: k,ierr
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
+     &                      qprof (k),uprof(k),  vprof(k),  wprof(k),      &
+     &                      omega (k),o3mmr(k)
+        enddo
+        close(ilesfile)
+
+        return
+        end
+
+!======================================================================
+      subroutine readprofile_astex(nlev_max,kmax,height,pprof,tprof,       &
+     &    thlprof,qvprof,qlprof,qtprof,uprof,vprof,wprof,tkeprof,o3mmr)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max),             &
+     &  thlprof(nlev_max),qlprof(nlev_max),qtprof(nlev_max),               &
+     &  qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max),                  &
+     &  wprof(nlev_max),tkeprof(nlev_max),o3mmr(nlev_max)
+
+        integer, parameter :: ilesfile=1
+        integer :: ierr,k
+
+        if(.not.(llesread)) return
+
+       open (ilesfile,file='prof.inp.001',status='old',iostat=ierr)
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k),pprof(k),  tprof(k),thlprof(k),      &
+     &                qvprof (k),qlprof (k),qtprof (k),                    &
+     &                uprof(k),  vprof(k),  wprof(k),tkeprof(k),o3mmr(k)
+        enddo
+        close(ilesfile)
+
+        return
+        end
+
+
+
+!======================================================================
+      subroutine readprofile_armcu(nlev_max,kmax,height,pprof,uprof,       &
+     &       vprof,thetaprof,tprof,qvprof,rvprof,aprof,bprof)
+!======================================================================
+      implicit none
+
+        integer nlev_max,kmax
+        logical :: llesread = .true.
+
+        real height(nlev_max),pprof(nlev_max),tprof(nlev_max)
+        real thetaprof(nlev_max),rvprof(nlev_max)
+        real qvprof(nlev_max),uprof(nlev_max),vprof(nlev_max)
+        real aprof(nlev_max+1),bprof(nlev_max+1)
+
+        integer, parameter :: ilesfile=1
+        integer, parameter :: ifile=2
+        integer :: ierr,jtot,k
+
+        if(.not.(llesread)) return
+
+! Read profiles at full levels
+       IF(nlev_max.EQ.19) THEN
+       open (ilesfile,file='prof.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.19'
+       ELSE
+       open (ilesfile,file='prof.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre prof.inp.40'
+       ENDIF
+        if (ierr /= 0) stop 'ERROR:Prof.inp does not exist'
+        read (ilesfile,*) kmax
+        do k=1,kmax
+          read (ilesfile,*) height(k)    ,pprof(k),  uprof(k), vprof(k),   &
+     &                      thetaprof(k) ,tprof(k), qvprof(k),rvprof(k)
+        enddo
+        close(ilesfile)
+
+! Vertical coordinates half levels for eta-coordinates (plev = alpha + beta * psurf) 
+       IF(nlev_max.EQ.19) THEN
+       open (ifile,file='proh.inp.19',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.19'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.19 does not exist'
+       ELSE
+       open (ifile,file='proh.inp.40',status='old',iostat=ierr)
+       print *,'On ouvre proh.inp.40'
+       if (ierr /= 0) stop 'ERROR:Proh.inp.40 does not exist'
+       ENDIF
+        read (ifile,*) kmax
+        do k=1,kmax
+          read (ifile,*) jtot,aprof(k),bprof(k)
+        enddo
+        close(ifile)
+
+        return
+        end
+
+!=====================================================================
+      subroutine read_fire(fich_fire,nlevel,ntime                          &
+     &     ,zz,thl,qt,u,v,tke                                              &
+     &     ,ug,vg,wls,dqtdx,dqtdy,dqtdt,thl_rad)
+
+!program reading forcings of the FIRE case study
+
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      character*80 :: fich_fire
+      real*8 zz(nlevel)
+
+      real*8 thl(nlevel)
+      real*8 qt(nlevel),u(nlevel)
+      real*8 v(nlevel),tke(nlevel)
+      real*8 ug(nlevel,ntime),vg(nlevel,ntime),wls(nlevel,ntime)
+      real*8 dqtdx(nlevel,ntime),dqtdy(nlevel,ntime)
+      real*8 dqtdt(nlevel,ntime),thl_rad(nlevel,ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=30)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_fire,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+
+       ierr=NF_INQ_VARID(nid,"zz",var3didin(1)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lev'
+         endif
+
+
+      ierr=NF_INQ_VARID(nid,"thetal",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'temp'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"qt",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'qv'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"tke",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'tke'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"ugeo",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'ug'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"vgeo",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'vg'
+         endif
+      
+      ierr=NF_INQ_VARID(nid,"wls",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'wls'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdx",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdx'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdy",var3didin(11))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdy'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"dqtdt",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdt'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"thl_rad",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'thl_rad'
+      endif
+!dimensions lecture
+!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture z ok',zz
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),thl)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),thl)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture thl ok',thl
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture qt ok',qt
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture u ok',u
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture v ok',v
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tke)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tke)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture tke ok',tke
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ug)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ug)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ug ok',ug
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),vg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),vg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture vg ok',vg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),wls)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),wls)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture wls ok',wls
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),dqtdx)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),dqtdx)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdx ok',dqtdx
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),dqtdy)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),dqtdy)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdy ok',dqtdy
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),dqtdt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),dqtdt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture dqtdt ok',dqtdt
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),thl_rad)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),thl_rad)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture thl_rad ok',thl_rad
+
+         return 
+         end subroutine read_fire
+!=====================================================================
+      subroutine read_dice(fich_dice,nlevel,ntime                         &
+     &     ,zz,pres,th,qv,u,v,o3                                          &
+     &     ,shf,lhf,lwup,swup,tg,ustar,psurf,ug,vg                        &
+     &     ,hadvt,hadvq,hadvu,hadvv,w,omega)
+
+!program reading initial profils and forcings of the Dice case study
+
+
+      implicit none
+
+#include "netcdf.inc"
+
+      integer ntime,nlevel
+      integer l,k
+      character*80 :: fich_dice
+      real*8 time(ntime)
+      real*8 zz(nlevel)
+
+      real*8 th(nlevel),pres(nlevel)
+      real*8 qv(nlevel),u(nlevel),v(nlevel),o3(nlevel)
+      real*8 shf(ntime),lhf(ntime),lwup(ntime),swup(ntime),tg(ntime)
+      real*8 ustar(ntime),psurf(ntime),ug(ntime),vg(ntime)
+      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime),hadvu(nlevel,ntime)
+      real*8 hadvv(nlevel,ntime),w(nlevel,ntime),omega(nlevel,ntime)
+
+      integer nid, ierr
+      integer nbvar3d
+      parameter(nbvar3d=30)
+      integer var3didin(nbvar3d)
+
+      ierr = NF_OPEN(fich_dice,NF_NOWRITE,nid)
+      if (ierr.NE.NF_NOERR) then
+         write(*,*) 'ERROR: Pb opening forcings nc file '
+         write(*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+
+       ierr=NF_INQ_VARID(nid,"height",var3didin(1)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'height'
+         endif
+
+       ierr=NF_INQ_VARID(nid,"pf",var3didin(11)) 
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'pf'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"theta",var3didin(12))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'theta'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"qv",var3didin(13))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'qv'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"u",var3didin(14))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'u'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"v",var3didin(15))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'v'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"o3mmr",var3didin(16))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'o3'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"shf",var3didin(2))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'shf'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"lhf",var3didin(3))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lhf'
+         endif
+      
+      ierr=NF_INQ_VARID(nid,"lwup",var3didin(4))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'lwup'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"swup",var3didin(5))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'dqtdx'
+         endif
+
+      ierr=NF_INQ_VARID(nid,"Tg",var3didin(6))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Tg'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"ustar",var3didin(7))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'ustar'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"psurf",var3didin(8))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'psurf'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Ug",var3didin(9))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Ug'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"Vg",var3didin(10))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'Vg'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(17))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvT'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvq",var3didin(18))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvq'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvu",var3didin(19))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvu'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"hadvv",var3didin(20))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'hadvv'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"w",var3didin(21))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'w'
+      endif
+
+      ierr=NF_INQ_VARID(nid,"omega",var3didin(22))
+         if(ierr/=NF_NOERR) then
+           write(*,*) NF_STRERROR(ierr)
+           stop 'omega'
+      endif
+!dimensions lecture
+!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture zz ok',zz
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pres)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(11),pres)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture pres ok',pres
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),th)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(12),th)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture th ok',th
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),qv)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(13),qv)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture qv ok',qv
+ 
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),u)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(14),u)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture u ok',u
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),v)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(15),v)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture v ok',v
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),o3)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(16),o3)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture o3 ok',o3
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),shf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(2),shf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture shf ok',shf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),lhf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(3),lhf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture lhf ok',lhf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),lwup)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(4),lwup)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture lwup ok',lwup
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),swup)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(5),swup)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture swup ok',swup
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),tg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(6),tg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture tg ok',tg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),ustar)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(7),ustar)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ustar ok',ustar
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),psurf)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(8),psurf)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture psurf ok',psurf
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),ug)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(9),ug)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture ug ok',ug
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),vg)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(10),vg)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture vg ok',vg
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hadvt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(17),hadvt)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvt ok',hadvt
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),hadvq)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(18),hadvq)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvq ok',hadvq
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),hadvu)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(19),hadvu)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvu ok',hadvu
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),hadvv)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(20),hadvv)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture hadvv ok',hadvv
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),w)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(21),w)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture w ok',w
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),omega)
+#else
+         ierr = NF_GET_VAR_REAL(nid,var3didin(22),omega)
+#endif
+         if(ierr/=NF_NOERR) then
+            write(*,*) NF_STRERROR(ierr)
+            stop "getvarup"
+         endif
+!          write(*,*)'lecture omega ok',omega
+
+         return 
+         end subroutine read_dice
+!=====================================================================
+!     Reads CIRC input files      
+
+      SUBROUTINE read_circ(nlev_circ,cf,lwp,iwp,reliq,reice,t,z,p,pm,h2o,o3,sza)
+      
+      parameter (ncm_1=49180)
+#include "YOMCST.h"
+
+      real albsfc(ncm_1), albsfc_w(ncm_1)
+      real cf(nlev_circ), icefra(nlev_circ), deice(nlev_circ), &
+           reliq(nlev_circ), reice(nlev_circ), lwp(nlev_circ), iwp(nlev_circ)
+      real t(nlev_circ+1), z(nlev_circ+1), dz(nlev_circ), p(nlev_circ+1)
+      real aer_beta(nlev_circ), waer(nlev_circ), gaer(nlev_circ)
+      real pm(nlev_circ), tm(nlev_circ), h2o(nlev_circ), o3(nlev_circ)
+      real co2(nlev_circ), n2o(nlev_circ), co(nlev_circ), ch4(nlev_circ), &
+           o2(nlev_circ), ccl4(nlev_circ), f11(nlev_circ), f12(nlev_circ)
+!     za= zenital angle
+!     sza= cosinus angle zenital
+      real wavn(ncm_1), ssf(ncm_1),za,sza
+      integer nlev
+
+
+!     Open the files
+
+      open (11, file='Tsfc_sza_nlev_case.txt', status='old')
+      open (12, file='level_input_case.txt', status='old')
+      open (13, file='layer_input_case.txt', status='old')
+      open (14, file='aerosol_input_case.txt', status='old')
+      open (15, file='cloud_input_case.txt', status='old')
+      open (16, file='sfcalbedo_input_case.txt', status='old')
+      
+!     Read scalar information
+      do iskip=1,5
+         read (11, *)
+      enddo
+      read (11, '(i8)') nlev
+      read (11, '(f10.2)') tsfc
+      read (11, '(f10.2)') za
+      read (11, '(f10.4)') sw_dn_toa
+      sza=cos(za/180.*RPI)
+      print *,'nlev,tsfc,sza,sw_dn_toa,RPI',nlev,tsfc,sza,sw_dn_toa,RPI
+      close(11)
+
+!     Read level information
+      read (12, *)
+      do il=1,nlev
+         read (12, 302) ilev, z(il), p(il), t(il)
+         z(il)=z(il)*1000.    ! z donne en km
+         p(il)=p(il)*100.     ! p donne en mb
+      enddo
+302   format (i8, f8.3, 2f9.2)
+      close(12)
+
+!     Read layer information (midpoint values)
+      do iskip=1,3
+         read (13, *)
+      enddo
+      do il=1,nlev-1
+         read (13, 303) ilev,pm(il),tm(il),h2o(il),co2(il),o3(il), &
+                        n2o(il),co(il),ch4(il),o2(il),ccl4(il), &
+                        f11(il),f12(il)
+         pm(il)=pm(il)*100.
+      enddo
+303   format (i8, 2f9.2, 10(2x,e13.7))      
+      close(13)
+      
+!     Read aerosol layer information
+      do iskip=1,3
+         read (14, *)
+      enddo
+      read (14, '(f10.2)') aer_alpha
+      read (14, *)
+      read (14, *)
+      do il=1,nlev-1
+         read (14, 304) ilev, aer_beta(il), waer(il), gaer(il)
+      enddo
+304   format (i8, f9.5, 2f8.3)
+      close(14)
+      
+!     Read cloud information
+      do iskip=1,3
+         read (15, *)
+      enddo
+      do il=1,nlev-1
+         read (15, 305) ilev, cf(il), lwp(il), iwp(il), reliq(il), reice(il)
+         lwp(il)=lwp(il)/1000.          ! lwp donne en g/kg
+         iwp(il)=iwp(il)/1000.          ! iwp donne en g/kg
+         reliq(il)=reliq(il)/1000000.   ! reliq donne en microns
+         reice(il)=reice(il)/1000000.   ! reice donne en microns
+      enddo
+305   format (i8, f8.3, 4f9.2)
+      close(15)
+
+!     Read surface albedo (weighted & unweighted) and spectral solar irradiance
+      do iskip=1,6
+         read (16, *)
+      enddo
+      do icm_1=1,ncm_1
+         read (16, 306) wavn(icm_1), albsfc(icm_1), albsfc_w(icm_1), ssf(icm_1)
+      enddo
+306   format(f10.1, 2f12.5, f14.8)
+      close(16)
+ 
+      return 
+      end subroutine read_circ
+!=====================================================================
+!     Reads RTMIP input files      
+
+      SUBROUTINE read_rtmip(nlev_rtmip,play,plev,t,h2o,o3)
+      
+#include "YOMCST.h"
+
+      real t(nlev_rtmip), pt(nlev_rtmip),pb(nlev_rtmip),h2o(nlev_rtmip), o3(nlev_rtmip)
+      real temp(nlev_rtmip), play(nlev_rtmip),ovap(nlev_rtmip), oz(nlev_rtmip),plev(nlev_rtmip+1)
+      integer nlev
+
+
+!     Open the files
+
+      open (11, file='low_resolution_profile.txt', status='old')
+      
+!     Read level information
+      read (11, *)
+      do il=1,nlev_rtmip
+         read (11, 302) pt(il), pb(il), t(il),h2o(il),o3(il)
+      enddo
+      do il=1,nlev_rtmip
+         play(il)=pt(nlev_rtmip-il+1)*100.     ! p donne en mb
+         temp(il)=t(nlev_rtmip-il+1)
+         ovap(il)=h2o(nlev_rtmip-il+1)
+         oz(il)=o3(nlev_rtmip-il+1)
+      enddo
+      do il=1,39
+         plev(il)=play(il)+(play(il+1)-play(il))/2.
+         print *,'il p t ovap oz=',il,plev(il),temp(il),ovap(il),oz(il)
+      enddo
+      plev(41)=101300.
+302   format (e16.10,3x,e16.10,3x,e16.10,3x,e12.6,3x,e12.6)
+      close(12)
+ 
+      return 
+      end subroutine read_rtmip
+!=====================================================================
+
+!  Subroutines for nudging
+
+      Subroutine Nudge_RHT_init (paprs,pplay,t,q,t_targ,rh_targ)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL t(klon,klev)
+      REAL q(klon,klev)
+!
+!   Profiles cible
+      REAL t_targ(klon,klev)
+      REAL rh_targ(klon,klev)
+!
+   INTEGER k,i
+   REAL zx_qs
+
+! Declaration des constantes et des fonctions thermodynamiques
+!
+include "YOMCST.h"
+include "YOETHF.h"
+!
+!  ----------------------------------------
+!  Statement functions
+include "FCTTRE.h"
+!  ----------------------------------------
+!
+        DO k = 1,klev
+         DO i = 1,klon
+           t_targ(i,k) = t(i,k)
+           IF (t(i,k).LT.RTT) THEN
+              zx_qs = qsats(t(i,k))/(pplay(i,k))
+           ELSE
+              zx_qs = qsatl(t(i,k))/(pplay(i,k))
+           ENDIF
+           rh_targ(i,k) = q(i,k)/zx_qs
+         ENDDO
+        ENDDO
+      print *, 't_targ',t_targ
+      print *, 'rh_targ',rh_targ
+!
+!
+      RETURN
+      END
+
+      Subroutine Nudge_UV_init (paprs,pplay,u,v,u_targ,v_targ)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+!
+!   Profiles cible
+      REAL u_targ(klon,klev)
+      REAL v_targ(klon,klev)
+!
+   INTEGER k,i
+!
+        DO k = 1,klev
+         DO i = 1,klon
+           u_targ(i,k) = u(i,k)
+           v_targ(i,k) = v(i,k)
+         ENDDO
+        ENDDO
+      print *, 'u_targ',u_targ
+      print *, 'v_targ',v_targ
+!
+!
+      RETURN
+      END
+
+      Subroutine Nudge_RHT (dtime,paprs,pplay,t_targ,rh_targ,t,q,          &
+     &                      d_t,d_q)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL dtime
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL t(klon,klev)
+      REAL q(klon,klev)
+!
+! Tendances
+      REAL d_t(klon,klev)
+      REAL d_q(klon,klev)
+!
+!   Profiles cible
+      REAL t_targ(klon,klev)
+      REAL rh_targ(klon,klev)
+!
+!   Temps de relaxation
+      REAL tau
+!c      DATA tau /3600./
+!!      DATA tau /5400./
+      DATA tau /1800./
+!
+   INTEGER k,i
+   REAL zx_qs, rh, tnew, d_rh
+
+! Declaration des constantes et des fonctions thermodynamiques
+!
+include "YOMCST.h"
+include "YOETHF.h"
+!
+!  ----------------------------------------
+!  Statement functions
+include "FCTTRE.h"
+!  ----------------------------------------
+!
+        print *,'dtime, tau ',dtime,tau
+        print *, 't_targ',t_targ
+        print *, 'rh_targ',rh_targ
+        print *,'temp ',t
+        print *,'hum ',q
+        DO k = 1,klev
+         DO i = 1,klon
+!!           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
+            IF (t(i,k).LT.RTT) THEN
+               zx_qs = qsats(t(i,k))/(pplay(i,k))
+            ELSE
+               zx_qs = qsatl(t(i,k))/(pplay(i,k))
+            ENDIF
+            rh = q(i,k)/zx_qs
+!
+            d_t(i,k) = d_t(i,k) + 1./tau*(t_targ(i,k)-t(i,k))
+            d_rh = 1./tau*(rh_targ(i,k)-rh)
+!
+            tnew = t(i,k)+d_t(i,k)
+            IF (tnew.LT.RTT) THEN
+               zx_qs = qsats(tnew)/(pplay(i,k))
+            ELSE
+               zx_qs = qsatl(tnew)/(pplay(i,k))
+            ENDIF
+            d_q(i,k) = d_q(i,k) + d_rh*zx_qs
+!
+            print *,' k,d_t,rh,d_rh,d_q ',    &
+                      k,d_t(i,k),rh,d_rh,d_q(i,k)
+!!           ENDIF
+!
+         ENDDO
+        ENDDO
+!
+      RETURN
+      END
+
+      Subroutine Nudge_UV (dtime,paprs,pplay,u_targ,v_targ,u,v,          &
+     &                      d_u,d_v)
+! ========================================================
+  USE dimphy
+
+  implicit none
+
+! ========================================================
+      REAL dtime
+      REAL paprs(klon,klevp1)
+      REAL pplay(klon,klev)
+!
+!      Variables d'etat
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+!
+! Tendances
+      REAL d_u(klon,klev)
+      REAL d_v(klon,klev)
+!
+!   Profiles cible
+      REAL u_targ(klon,klev)
+      REAL v_targ(klon,klev)
+!
+!   Temps de relaxation
+      REAL tau
+!c      DATA tau /3600./
+      DATA tau /5400./
+!
+   INTEGER k,i
+
+!
+        print *,'dtime, tau ',dtime,tau
+        print *, 'u_targ',u_targ
+        print *, 'v_targ',v_targ
+        print *,'zonal velocity ',u
+        print *,'meridional velocity ',v
+        DO k = 1,klev
+         DO i = 1,klon
+           IF (paprs(i,1)-pplay(i,k) .GT. 10000.) THEN
+!
+            d_u(i,k) = d_u(i,k) + 1./tau*(u_targ(i,k)-u(i,k))
+            d_v(i,k) = d_v(i,k) + 1./tau*(v_targ(i,k)-v(i,k))
+!
+            print *,' k,u,d_u,v,d_v ',    &
+                      k,u(i,k),d_u(i,k),v(i,k),d_v(i,k)
+           ENDIF
+!
+         ENDDO
+        ENDDO
+!
+      RETURN
+      END
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_decl_cases.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_decl_cases.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_decl_cases.h	(revision 3815)
@@ -0,0 +1,254 @@
+#include "netcdf.inc"
+
+! Declarations specifiques au cas Toga
+        character*80 :: fich_toga
+!        integer nlev_prof
+!        parameter (nlev_prof = 41)
+        integer nlev_toga, nt_toga
+        parameter (nlev_toga=41, nt_toga=480)
+        integer year_ini_toga, day_ini_toga, mth_ini_toga
+        real day_ju_ini_toga   ! Julian day of toga coare first day
+        parameter (year_ini_toga=1992) 
+        parameter (mth_ini_toga=11)
+        parameter (day_ini_toga=1)  !  1erNov1992
+        real dt_toga
+        parameter (dt_toga=6.*3600.)
+!!
+        integer year_print, month_print, day_print
+        real    sec_print
+!!
+        real ts_toga(nt_toga)
+        real plev_toga(nlev_toga,nt_toga),w_toga(nlev_toga,nt_toga)
+        real t_toga(nlev_toga,nt_toga),q_toga(nlev_toga,nt_toga)
+        real u_toga(nlev_toga,nt_toga),v_toga(nlev_toga,nt_toga)
+        real ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
+        real hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
+
+        real ts_prof
+        real plev_prof(nlev_toga),w_prof(nlev_toga)
+        real t_prof(nlev_toga),q_prof(nlev_toga)
+        real u_prof(nlev_toga),v_prof(nlev_toga)
+        real ht_prof(nlev_toga),vt_prof(nlev_toga)
+        real hq_prof(nlev_toga),vq_prof(nlev_toga)
+
+        real w_mod(llm), t_mod(llm),q_mod(llm)
+        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm)
+        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
+        real th_mod(llm)
+
+        real ts_cur
+        common /sst_forcing/ts_cur ! also in read_tsurf1d.F
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas RICO
+        character*80 :: fich_rico
+        integer nlev_rico
+
+        parameter (nlev_rico=81)
+        real ts_rico,ps_rico
+        real w_rico(llm)
+        real t_rico(llm),q_rico(llm)
+        real u_rico(llm),v_rico(llm)
+        real dth_rico(llm)
+        real dqh_rico(llm)
+        real du_age(llm),dv_age(llm)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas TWPice
+        character*80 :: fich_twpice
+        integer nlev_twpi, nt_twpi
+        parameter (nlev_twpi=40, nt_twpi=215)
+        integer year_ini_twpi, day_ini_twpi, mth_ini_twpi
+        real heure_ini_twpi
+        real day_ju_ini_twpi   ! Julian day of twpice first day
+        parameter (year_ini_twpi=2006) 
+        parameter (mth_ini_twpi=1)
+        parameter (day_ini_twpi=17)  ! 17 = 17Jan2006
+        parameter (heure_ini_twpi=10800.) !3h en secondes
+        real dt_twpi
+        parameter (dt_twpi=3.*3600.)
+
+        real ts_twpi(nt_twpi)
+        real plev_twpi(nlev_twpi,nt_twpi),w_twpi(nlev_twpi,nt_twpi)
+        real t_twpi(nlev_twpi,nt_twpi),q_twpi(nlev_twpi,nt_twpi)
+        real u_twpi(nlev_twpi,nt_twpi),v_twpi(nlev_twpi,nt_twpi)
+        real ht_twpi(nlev_twpi,nt_twpi),vt_twpi(nlev_twpi,nt_twpi)
+        real hq_twpi(nlev_twpi,nt_twpi),vq_twpi(nlev_twpi,nt_twpi)
+
+        real ts_proftwp
+        real plev_proftwp(nlev_twpi),w_proftwp(nlev_twpi)
+        real t_proftwp(nlev_twpi),q_proftwp(nlev_twpi)
+        real u_proftwp(nlev_twpi),v_proftwp(nlev_twpi)
+        real ht_proftwp(nlev_twpi),vt_proftwp(nlev_twpi)
+        real hq_proftwp(nlev_twpi),vq_proftwp(nlev_twpi)
+
+
+
+!Declarations specifiques au cas FIRE
+        character*80 :: fich_fire
+        integer nlev_fire, nt_fire
+        parameter (nlev_fire=120, nt_fire=1)  
+        integer year_ini_fire, day_ini_fire, mth_ini_fire
+        real heure_ini_fire
+        parameter (year_ini_fire=1987) 
+        parameter (mth_ini_fire=7)
+        parameter (day_ini_fire=14)  ! 14 = 14Juil1987
+        parameter (heure_ini_fire=0.) !0h en secondes
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!Declarations specifiques au cas DICE     (MPL 02072013)
+        character*80 :: fich_dice
+        integer nlev_dice, nt_dice
+        parameter (nlev_dice=70, nt_dice=145)  
+        integer year_ini_dice, day_ini_dice, mth_ini_dice
+        real heure_ini_dice
+        real day_ju_ini_dice   ! Julian day of dice first day
+        parameter (year_ini_dice=1999) 
+        parameter (mth_ini_dice=10)
+        parameter (day_ini_dice=23)  ! 23 = 23 october 1999
+        parameter (heure_ini_dice=68400.) !19UTC en secondes
+        real dt_dice
+        parameter (dt_dice=0.5*3600.) ! 1 forcage ttes les demi-heures
+
+!profils initiaux:
+        real plev_dice(nlev_dice)
+        
+        real zz_dice(nlev_dice)
+        real th_dice(nlev_dice),qv_dice(nlev_dice)
+        real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
+        real ht_dice(nlev_dice,nt_dice)
+        real hq_dice(nlev_dice,nt_dice), hu_dice(nlev_dice,nt_dice)
+        real hv_dice(nlev_dice,nt_dice)
+        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
+        real o3_mod(llm),hu_mod(llm),hv_mod(llm)
+        real th_dicei(nlev_dice),qv_dicei(nlev_dice)
+        real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
+        real ht_dicei(nlev_dice)
+        real hq_dicei(nlev_dice), hu_dicei(nlev_dice)
+        real hv_dicei(nlev_dice)
+        real w_dicei(nlev_dice),omega_dicei(nlev_dice)
+
+        
+!forcings
+        real shf_dice(nt_dice),lhf_dice(nt_dice)
+        real lwup_dice(nt_dice),swup_dice(nt_dice)
+        real tg_dice(nt_dice),ustar_dice(nt_dice),psurf_dice(nt_dice)
+        real ug_dice(nt_dice),vg_dice(nt_dice)
+
+        real shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+        real ustar_prof,psurf_prof,cdrag
+        real ht_profd(nlev_dice),hq_profd(nlev_dice),hu_profd(nlev_dice)
+        real hv_profd(nlev_dice),w_profd(nlev_dice)
+        real omega_profd(nlev_dice),ug_profd,vg_profd
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas GCSSold
+        character*80 :: fich_gcssold_ctl
+        character*80 :: fich_gcssold_dat
+        real  ht_gcssold(llm),hq_gcssold(llm),hw_gcssold(llm)
+        real  hu_gcssold(llm)
+        real  hv_gcssold(llm)
+        real  hthturb_gcssold(llm)
+        real  hqturb_gcssold(llm)
+        real  Ts_gcssold
+        real  dtime_frcg
+        logical :: Turb_fcg_gcssold
+
+        common /turb_forcing/                                                   &
+     &  dtime_frcg,hthturb_gcssold, hqturb_gcssold,Turb_fcg_gcssold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas Arm_cu
+        character*80 :: fich_armcu
+
+
+        integer nlev_armcu, nt_armcu
+        parameter (nlev_armcu=40, nt_armcu=31)
+        integer year_ini_armcu, day_ini_armcu, mth_ini_armcu
+        real  heure_ini_armcu
+        real day_ju_ini_armcu                                ! Julian day of armcu case first day
+        parameter (year_ini_armcu=1997) 
+        parameter (mth_ini_armcu=6)
+        parameter (day_ini_armcu=21)  ! 172 = 21 juin 1997
+        parameter (heure_ini_armcu=41400)   ! 11:30 en secondes
+        real dt_armcu
+        parameter (dt_armcu=1.*1800.)   ! forcages donnes ttes les demi-heures par ifa_armcu.txt
+        real sens_armcu(nt_armcu),flat_armcu(nt_armcu)
+        real adv_theta_armcu(nt_armcu),rad_theta_armcu(nt_armcu)
+        real adv_qt_armcu(nt_armcu)
+        real theta_mod(llm),rv_mod(llm),play_mod(llm)
+! profc comme "profil armcu"
+        
+! forcages interpoles dans le temps
+        real adv_theta_prof,rad_theta_prof,adv_qt_prof
+        real sens_prof,flat_prof,fact
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! declarations specifiques au cas Sandu
+        character*80 :: fich_sandu
+!        integer nlev_prof
+!        parameter (nlev_prof = 41)
+        integer nlev_sandu, nt_sandu
+        parameter (nlev_sandu=87, nt_sandu=13)
+        integer year_ini_sandu, day_ini_sandu, mth_ini_sandu
+        real day_ju_ini_sandu                                ! Julian day of sandu case first day
+        parameter (year_ini_sandu=2006)
+        parameter (mth_ini_sandu=7)
+        parameter (day_ini_sandu=15)  ! 196 = 15 juillet 2006
+        real dt_sandu, tau_sandu
+        logical  :: trouve_700=.true.
+        parameter (dt_sandu=6.*3600.)   ! forcages donnes ttes les 6 heures par ifa_sandu.txt
+        parameter (tau_sandu=3600.)  ! temps de relaxation u,v,thetal,qt vers profil init et au dessus 700hPa
+!!
+        real ts_sandu(nt_sandu)
+! profs comme "profil sandu"
+        real plev_profs(nlev_sandu)
+        real t_profs(nlev_sandu),thl_profs(nlev_sandu)
+        real q_profs(nlev_sandu)
+        real u_profs(nlev_sandu),v_profs(nlev_sandu),w_profs(nlev_sandu)
+        real omega_profs(nlev_sandu),o3mmr_profs(nlev_sandu)
+
+        real, dimension(llm) :: relax_u,relax_v,relax_thl
+        real, dimension(llm,2) :: relax_q
+
+        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
+!vertical advection computation
+        real d_t_z(llm), d_q_z(llm)
+        real d_t_dyn_z(llm), d_q_dyn_z(llm)
+        real d_u_z(llm),d_v_z(llm)
+        real d_u_dyn(llm),d_v_dyn(llm)
+        real d_u_dyn_z(llm),d_v_dyn_z(llm)
+        real d_u_adv(llm),d_v_adv(llm)
+        real zz(llm)
+        real zfact
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Declarations specifiques au cas Astex
+        character*80 :: fich_astex
+        integer nlev_astex, nt_astex
+        parameter (nlev_astex=34, nt_astex=49)
+        integer year_ini_astex, day_ini_astex, mth_ini_astex
+        real day_ju_ini_astex                                ! Julian day of astex case first day
+        parameter (year_ini_astex=1992)
+        parameter (mth_ini_astex=6)
+        parameter (day_ini_astex=13)  ! 165 = 13 juin 1992
+        real dt_astex
+        parameter (dt_astex=3600.)    ! forcages donnes ttes les heures par ifa_astex.txt
+        real ts_astex(nt_astex),div_astex(nt_astex),ug_astex(nt_astex)
+        real vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
+        real div_prof,ug_prof,vg_prof,ufa_prof,vfa_prof
+! profa comme "profil astex"
+        real plev_profa(nlev_astex)
+        real t_profa(nlev_astex),thl_profa(nlev_astex)
+        real qv_profa(nlev_astex),ql_profa(nlev_astex)
+        real qt_profa(nlev_astex),o3mmr_profa(nlev_astex)
+        real u_profa(nlev_astex),v_profa(nlev_astex),w_profa(nlev_astex)
+        real tke_profa(nlev_astex)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!Declarations specifiques au cas standard
+
+        real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
+        real ug_mod_cas(llm),vg_mod_cas(llm)
+        real u_mod_cas(llm),v_mod_cas(llm)
+        real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
+        real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
+        real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
+        real hv_mod_cas(llm),vv_mod_cas(llm),dv_mod_cas(llm)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_interp_cases.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_interp_cases.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_interp_cases.h	(revision 3815)
@@ -0,0 +1,757 @@
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+
+       call get_uvd(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,              &
+     &               ht_gcssold,hq_gcssold,hw_gcssold,                          &
+     &               hu_gcssold,hv_gcssold,                                     &
+     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,                 &
+     &               imp_fcg_gcssold,ts_fcg_gcssold,                            &
+     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       if (prt_level.ge.1) then
+         print *,' get_uvd -> hqturb_gcssold ',it,hqturb_gcssold
+       endif
+! large-scale forcing :
+!!!      tsurf = ts_gcssold
+      do l = 1, llm
+!       u(l) = hu_gcssold(l) !  on prescrit le vent
+!       v(l) = hv_gcssold(l)    !  on prescrit le vent
+!       omega(l) = hw_gcssold(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = hw_gcssold(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = ht_gcssold(l)
+       d_q_adv(l,1) = hq_gcssold(l)
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation Toga forcing 
+!---------------------------------------------------------------------
+      if (forcing_toga) then
+
+       if (prt_level.ge.1) then
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_toga=',     &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_toga
+       endif
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref                        &
+     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
+     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
+     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+! large-scale forcing :
+      tsurf = ts_prof
+      do l = 1, llm
+       u(l) = u_mod(l) ! sb: on prescrit le vent
+       v(l) = v_mod(l) ! sb: on prescrit le vent
+!       omega(l) = w_prof(l)
+!       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Interpolation DICE forcing 
+!---------------------------------------------------------------------
+      if (forcing_dice) then
+
+       if (prt_level.ge.1) then
+        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_dice=',&
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_dice
+       endif
+
+! time interpolation:
+      CALL interp_dice_time(daytime,day1,annee_ref                    &
+     &             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice     & 
+     &             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice   &
+     &             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice     &
+     &             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice &
+     &             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof     &
+     &             ,ustar_prof,psurf_prof,ug_profd,vg_profd           &
+     &             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd       &
+     &             ,omega_profd)
+!     do l = 1, llm
+!     print *,'llm l omega_profd',llm,l,omega_profd(l)
+!     enddo
+
+        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice        &
+     &         ,th_dice,qv_dice,u_dice,v_dice,o3_dice                   &
+     &         ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd,omega_profd &
+     &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                        &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+!     do l = 1, llm
+!      print *,'llm l omega_mod',llm,l,omega_mod(l)
+!     enddo
+
+! Les forcages DICE sont donnes /jour et non /seconde !
+      ht_mod(:)=ht_mod(:)/86400.
+      hq_mod(:)=hq_mod(:)/86400.
+      hu_mod(:)=hu_mod(:)/86400.
+      hv_mod(:)=hv_mod(:)/86400.
+
+!calcul de l'advection verticale a partir du omega (repris cas TWPICE, MPL 05082013)
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_u_z(:)=0.
+      d_v_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1)) /(play(l+1)-play(l-1))
+       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+!     d_u_z(1)=u(2)/(play(2)-psurf)/5.
+!     d_v_z(1)=v(2)/(play(2)-psurf)/5.
+      d_u_z(1)=0.
+      d_v_z(1)=0.
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+      d_u_z(llm)=d_u_z(llm-1)
+      d_v_z(llm)=d_v_z(llm-1)
+
+!Calcul de l advection verticale: 
+! utiliser omega (Pa/s) et non w (m/s) !! MP 20131108
+      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
+      d_u_dyn_z(:)=omega_mod(:)*d_u_z(:)
+      d_v_dyn_z(:)=omega_mod(:)*d_v_z(:)
+
+! large-scale forcing :
+!     tsurf = tg_prof    MPL 20130925 commente
+      psurf = psurf_prof
+! For this case, fluxes are imposed
+      fsens=-1*shf_prof
+      flat=-1*lhf_prof
+      ust=ustar_prof
+      tg=tg_prof
+      print *,'ust= ',ust
+      do l = 1, llm
+       ug(l)= ug_profd
+       vg(l)= vg_profd
+!       omega(l) = w_prof(l)
+!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!       omega2(l)=-rho(l)*omega(l)
+!      omega(l) = w_mod(l)*(-rg*rho(l))
+       omega(l) = omega_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
+       d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
+       d_u_adv(l) = hu_mod(l)-d_u_dyn_z(l)
+       d_v_adv(l) = hv_mod(l)-d_v_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_dice
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing TWPice
+!---------------------------------------------------------------------
+      if (forcing_twpice) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_twpi=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/dt_twpi
+
+! time interpolation:
+        CALL interp_toga_time(daytime,day1,annee_ref                        &
+     &       ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi       &
+     &       ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi          &
+     &       ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                               &
+     &       ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp,u_proftwp         &
+     &       ,v_proftwp,w_proftwp                                           &
+     &       ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
+     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
+     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!Calcul de l advection verticale
+      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
+
+!wind nudging above 500m with a 2h time scale
+        do l=1,llm
+        if (nudge_wind) then
+!           if (phi(l).gt.5000.) then
+        if (phi(l).gt.0.) then
+        u(l)=u(l)+timestep*(u_mod(l)-u(l))/(2.*3600.)
+        v(l)=v(l)+timestep*(v_mod(l)-v(l))/(2.*3600.)
+           endif    
+        else
+        u(l) = u_mod(l) 
+        v(l) = v_mod(l)
+        endif
+        enddo
+
+!CR:nudging of q and theta with a 6h time scale above 15km
+        if (nudge_thermo) then
+        do l=1,llm
+           zz(l)=phi(l)/9.8
+           if ((zz(l).le.16000.).and.(zz(l).gt.15000.)) then
+             zfact=(zz(l)-15000.)/1000.
+        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)*zfact
+        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)*zfact
+           else if (zz(l).gt.16000.) then 
+        q(l,1)=q(l,1)+timestep*(q_mod(l)-q(l,1))/(6.*3600.)
+        temp(l)=temp(l)+timestep*(t_mod(l)-temp(l))/(6.*3600.)
+           endif
+        enddo    
+        endif
+
+      do l = 1, llm
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!calcul de l'advection totale
+        if (cptadvw) then
+        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-d_t_dyn_z(l)
+!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
+        d_q_adv(l,1) = hq_mod(l)-d_q_dyn_z(l)
+!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
+        else
+        d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+        d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+        endif
+       dt_cooling(l) = 0.0
+      enddo
+
+      endif ! forcing_twpice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing AMMA
+!---------------------------------------------------------------------
+
+       if (forcing_amma) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_amma=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/dt_amma
+
+! time interpolation using TOGA interpolation routine
+        CALL interp_amma_time(daytime,day1,annee_ref                        &
+     &       ,year_ini_amma,day_ju_ini_amma,nt_amma,dt_amma,nlev_amma       &
+     &       ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma                  &
+     &       ,vitw_profamma,ht_profamma,hq_profamma,lat_profamma            &
+     &       ,sens_profamma)
+
+      print*,'apres interpolation temporelle AMMA'
+
+      do k=1,nlev_amma
+         th_profamma(k)=0.
+         q_profamma(k)=0.
+         u_profamma(k)=0.
+         v_profamma(k)=0.
+         vt_profamma(k)=0.
+         vq_profamma(k)=0.
+       enddo
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_amma,plev_amma                      &
+     &         ,th_profamma,q_profamma,u_profamma,v_profamma                 &
+     &         ,vitw_profamma                                               &
+     &         ,ht_profamma,vt_profamma,hq_profamma,vq_profamma             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+       write(*,*) 'Profil initial forcing AMMA interpole'
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      do l=1,llm
+      d_t_z(l)=0.
+      d_q_z(l)=0.
+      enddo
+
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+
+      do l = 1, llm
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+       omega(l) = w_mod(l)*(-rg*rho(l))
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!calcul de l'advection totale
+!        d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)-omega(l)*d_t_z(l)
+!attention: on impose dth
+        d_th_adv(l) = alpha*omega(l)/rcpd+                                  &
+     &         ht_mod(l)*(play(l)/pzero)**rkappa-omega(l)*d_t_z(l)
+!        d_th_adv(l) = 0.
+!        print*,'temp vert adv',l,ht_mod(l),vt_mod(l),-d_t_dyn_z(l)
+        d_q_adv(l,1) = hq_mod(l)-omega(l)*d_q_z(l)
+!        d_q_adv(l,1) = 0.
+!        print*,'q vert adv',l,hq_mod(l),vq_mod(l),-d_q_dyn_z(l)
+   
+       dt_cooling(l) = 0.0
+      enddo
+
+
+!     ok_flux_surf=.false.
+      fsens=-1.*sens_profamma
+      flat=-1.*lat_profamma
+
+      endif ! forcing_amma
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Rico
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+!       call lstendH(llm,omega,dt_dyn,dq_dyn,du_dyn, dv_dyn,
+!     :  q,temp,u,v,play)
+       call lstendH(llm,nqtot,omega,dt_dyn,dq_dyn,q,temp,u,v,play)
+
+        do l=1,llm
+       d_th_adv(l) =  (dth_rico(l) +  dt_dyn(l))
+       d_q_adv(l,1) = (dqh_rico(l) +  dq_dyn(l,1))
+       d_q_adv(l,2) = 0.
+        enddo
+      endif  ! forcing_rico
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing Arm_cu
+!---------------------------------------------------------------------
+      if (forcing_armcu) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_armcu=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_armcu
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_armcu_time(daytime,day1,annee_ref                         &
+     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
+     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu          &
+     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
+     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+
+! vertical interpolation:
+! No vertical interpolation if nlev imposed to 19 or 40
+
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+! Advective forcings are given in K or g/kg ... BY HOUR
+      do l = 1, llm
+       ug(l)= u_mod(l)
+       vg(l)= v_mod(l)
+       IF((phi(l)/RG).LT.1000) THEN
+         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+         d_q_adv(l,1) = adv_qt_prof/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'INF1000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSEIF ((phi(l)/RG).GE.1000.AND.(phi(l)/RG).lt.3000) THEN
+         fact=((phi(l)/RG)-1000.)/2000.
+         fact=1-fact
+         d_th_adv(l) = (adv_theta_prof + rad_theta_prof)*fact/3600.
+         d_q_adv(l,1) = adv_qt_prof*fact/1000./3600.
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP1000: phi fact dth dq1 dq2',
+!    :  phi(l)/RG,fact,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ELSE
+         d_th_adv(l) = 0.0
+         d_q_adv(l,1) = 0.0
+         d_q_adv(l,2) = 0.0
+!        print *,'SUP3000: phi dth dq1 dq2',
+!    :  phi(l)/RG,d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+       ENDIF
+      dt_cooling(l) = 0.0  
+!     print *,'Interp armcu: phi dth dq1 dq2',
+!    :  l,phi(l),d_th_adv(l),d_q_adv(l,1),d_q_adv(l,2)
+      enddo
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_sandu) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_sandu=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_sandu 
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_sandu_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
+     &             ,nlev_sandu                                              &
+     &             ,ts_sandu,ts_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
+     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
+     &         ,omega_profs,o3mmr_profs                                     &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+!calcul de l'advection verticale
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+! schema centre
+!     DO l=2,llm-1
+!      d_t_z(l)=(temp(l+1)-temp(l-1))
+!    &          /(play(l+1)-play(l-1))
+!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
+!    &          /(play(l+1)-play(l-1))
+! schema amont
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
+       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
+!     print *,'l temp2 temp0 play2 play0 omega_mod',
+!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!  calcul de l advection verticale
+! Confusion w (m/s) et omega (Pa/s) !!
+      d_t_dyn_z(:)=omega_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=omega_mod(:)*d_q_z(:)
+!     do l=1,llm
+!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
+!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
+!     enddo
+
+
+! large-scale forcing : pour le cas Sandu ces forcages sont la SST
+! et une divergence constante -> profil de omega
+      tsurf = ts_prof
+      write(*,*) 'SST suivante: ',tsurf
+      do l = 1, llm
+       omega(l) = omega_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!
+!      d_th_adv(l) = 0.0
+!      d_q_adv(l,1) = 0.0
+!CR:test advection=0
+!calcul de l'advection verticale
+        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
+!        print*,'temp adv',l,-d_t_dyn_z(l)
+        d_q_adv(l,1) = -d_q_dyn_z(l)
+!        print*,'q adv',l,-d_q_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+      endif ! forcing_sandu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing in time and onto model levels
+!---------------------------------------------------------------------
+      if (forcing_astex) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_astex=',    &
+     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_astex
+
+! time interpolation:
+! ATTENTION, cet appel ne convient pas pour TOGA !!
+! revoir 1DUTILS.h et les arguments
+      CALL interp_astex_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
+     &             ,ufa_prof,vfa_prof)
+
+        if (type_ts_forcing.eq.1) ts_cur = ts_prof ! SST used in read_tsurf1d
+
+! vertical interpolation:
+      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
+     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
+     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+!calcul de l'advection verticale
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+! schema centre
+!     DO l=2,llm-1
+!      d_t_z(l)=(temp(l+1)-temp(l-1))
+!    &          /(play(l+1)-play(l-1))
+!      d_q_z(l)=(q(l+1,1)-q(l-1,1))
+!    &          /(play(l+1)-play(l-1))
+! schema amont
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l))/(play(l+1)-play(l))
+       d_q_z(l)=(q(l+1,1)-q(l,1))/(play(l+1)-play(l))
+!     print *,'l temp2 temp0 play2 play0 omega_mod',
+!    & temp(l+1),temp(l-1),play(l+1),play(l-1),omega_mod(l)
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+
+!  calcul de l advection verticale
+! Confusion w (m/s) et omega (Pa/s) !!
+      d_t_dyn_z(:)=w_mod(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod(:)*d_q_z(:)
+!     do l=1,llm
+!      print *,'d_t_dyn omega_mod d_t_z d_q_dyn d_q_z',
+!    :l,d_t_dyn_z(l),omega_mod(l),d_t_z(l),d_q_dyn_z(l),d_q_z(l)
+!     enddo
+
+
+! large-scale forcing : pour le cas Astex ces forcages sont la SST
+! la divergence,ug,vg,ufa,vfa
+      tsurf = ts_prof
+      write(*,*) 'SST suivante: ',tsurf
+      do l = 1, llm
+       omega(l) = w_mod(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!
+!      d_th_adv(l) = 0.0
+!      d_q_adv(l,1) = 0.0
+!CR:test advection=0
+!calcul de l'advection verticale
+        d_th_adv(l) = alpha*omega(l)/rcpd-d_t_dyn_z(l)
+!        print*,'temp adv',l,-d_t_dyn_z(l)
+        d_q_adv(l,1) = -d_q_dyn_z(l)
+!        print*,'q adv',l,-d_q_dyn_z(l)
+       dt_cooling(l) = 0.0
+      enddo
+      endif ! forcing_astex
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Interpolation forcing standard case
+!---------------------------------------------------------------------
+      if (forcing_case) then
+
+        print*,                                                             &
+     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
+     &    daytime,day1,(daytime-day1)*86400.,                               &
+     &    (daytime-day1)*86400/pdt_cas
+
+! time interpolation:
+        CALL interp_case_time(daytime,day1,annee_ref                        &
+     &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas       &
+     &       ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas,ug_cas,vg_cas    &
+     &       ,vitw_cas,du_cas,hu_cas,vu_cas           &
+     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas             &
+     &       ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas                 &
+     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas         &
+     &       ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
+     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
+     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas               &
+     &       ,sens_prof_cas)
+
+             ts_cur = ts_prof_cas 
+             psurf=plev_prof_cas(1)
+
+! vertical interpolation:
+      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas                         &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas                              &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+
+
+!calcul de l'advection verticale a partir du omega
+!Calcul des gradients verticaux
+!initialisation
+      d_t_z(:)=0.
+      d_q_z(:)=0.
+      d_u_z(:)=0.
+      d_v_z(:)=0.
+      d_t_dyn_z(:)=0.
+      d_q_dyn_z(:)=0.
+      d_u_dyn_z(:)=0.
+      d_v_dyn_z(:)=0.
+      DO l=2,llm-1
+       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
+       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
+       d_u_z(l)=(u(l+1)-u(l-1))/(play(l+1)-play(l-1))
+       d_v_z(l)=(v(l+1)-v(l-1))/(play(l+1)-play(l-1))
+      ENDDO
+      d_t_z(1)=d_t_z(2)
+      d_q_z(1)=d_q_z(2)
+      d_u_z(1)=d_u_z(2)
+      d_v_z(1)=d_v_z(2)
+      d_t_z(llm)=d_t_z(llm-1)
+      d_q_z(llm)=d_q_z(llm-1)
+      d_u_z(llm)=d_u_z(llm-1)
+      d_v_z(llm)=d_v_z(llm-1)
+
+!Calcul de l advection verticale
+      d_t_dyn_z(:)=w_mod_cas(:)*d_t_z(:)
+      d_q_dyn_z(:)=w_mod_cas(:)*d_q_z(:)
+      d_u_dyn_z(:)=w_mod_cas(:)*d_u_z(:)
+      d_v_dyn_z(:)=w_mod_cas(:)*d_v_z(:)
+
+!wind nudging 
+      if (nudge_u.gt.0.) then
+        do l=1,llm
+           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
+        enddo
+      else
+        do l=1,llm
+        u(l) = u_mod_cas(l) 
+        enddo
+      endif
+
+      if (nudge_v.gt.0.) then
+        do l=1,llm
+           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
+        enddo
+      else
+        do l=1,llm
+        v(l) = v_mod_cas(l) 
+        enddo
+      endif
+
+      if (nudge_w.gt.0.) then
+        do l=1,llm
+           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
+        enddo
+      else
+        do l=1,llm
+        w(l) = w_mod_cas(l) 
+        enddo
+      endif
+
+!nudging of q and temp 
+      if (nudge_t.gt.0.) then
+        do l=1,llm
+           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
+        enddo
+      endif
+      if (nudge_q.gt.0.) then
+        do l=1,llm
+           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
+        enddo
+      endif
+
+      do l = 1, llm
+       omega(l) = w_mod_cas(l)
+       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+
+!calcul advection
+        if ((tend_u.eq.1).and.(tend_w.eq.0)) then
+           d_u_adv(l)=du_mod_cas(l)
+        else if ((tend_u.eq.1).and.(tend_w.eq.1)) then
+           d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
+        endif
+
+        if ((tend_v.eq.1).and.(tend_w.eq.0)) then
+           d_v_adv(l)=dv_mod_cas(l)
+        else if ((tend_v.eq.1).and.(tend_w.eq.1)) then
+           d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
+        endif
+
+        if ((tend_t.eq.1).and.(tend_w.eq.0)) then
+!           d_th_adv(l)=alpha*omega(l)/rcpd+dt_mod_cas(l)
+           d_th_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
+        else if ((tend_t.eq.1).and.(tend_w.eq.1)) then
+!           d_th_adv(l)=alpha*omega(l)/rcpd+ht_mod_cas(l)-d_t_dyn_z(l)
+           d_th_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
+        endif
+
+        if ((tend_q.eq.1).and.(tend_w.eq.0)) then
+!           d_q_adv(l,1)=dq_mod_cas(l)
+           d_q_adv(l,1)=-1*dq_mod_cas(l)
+        else if ((tend_q.eq.1).and.(tend_w.eq.1)) then
+!           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
+           d_q_adv(l,1)=-1*hq_mod_cas(l)-d_q_dyn_z(l)
+        endif
+         
+        if (tend_rayo.eq.1) then
+           dt_cooling(l) = dtrad_mod_cas(l)
+        else
+           dt_cooling(l) = 0.0
+        endif
+      enddo
+
+      endif ! forcing_case
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_nudge_sandu_astex.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_nudge_sandu_astex.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_nudge_sandu_astex.h	(revision 3815)
@@ -0,0 +1,34 @@
+      do l = 1, llm
+!
+! au dessus de 700hPa, on relaxe vers profil init
+!      on fait l'hypothese que dans ce cas, il n'y a plus d'eau liq. au dessus 700hpa
+!      donc la relaxation en thetal et qt devient relaxation en tempe et qv
+       relax_u(l)=(u(l)-u_mod(l))/tau_sandu  ! pour u et v on relaxe sur tte la colonne
+       relax_v(l)=(v(l)-v_mod(l))/tau_sandu
+       relax_q(l,1)=0.
+       relax_q(l,2)=0.
+       relax_thl(l)=0.
+!      print *,'nudge: l tau_sandu u u_mod',l,tau_sandu,u(l),u_mod(l)
+!
+       if (l.ge.llm700) then 
+         relax_q(l,1)=(q(l,1)-q_mod(l))/tau_sandu
+         relax_q(l,2)=0.
+         relax_thl(l)=(temp(l)-t_mod(l))/tau_sandu
+       endif
+!     print *,'l dq1 relax dqadv',l,dq(l,1),relax_q(l,1),d_q_adv(l,1)
+!     print *,'l dq2 relax dqadv',l,dq(l,2),relax_q(l,2),d_q_adv(l,2)
+!     print *,'l dt  relax dtadv',l,dt_phys(l),relax_thl(l),d_th_adv(l)
+      enddo
+        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &          
+     &              du_phys(1:mxcalc) - relax_u(1:mxcalc))
+        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                &
+     &               dv_phys(1:mxcalc) - relax_v(1:mxcalc))
+!       q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(
+!    .              dq(1:mxcalc,:) - relax_q(1:mxcalc,:)+
+!    .              d_q_adv(1:mxcalc,:))
+        q(1:mxcalc,1)=q(1:mxcalc,1)+timestep*(                              &
+     &      dq(1:mxcalc,1) - relax_q(1:mxcalc,1)+d_q_adv(1:mxcalc,1))
+        q(1:mxcalc,2)=q(1:mxcalc,2)+timestep*(                              &
+     &      dq(1:mxcalc,2) - relax_q(1:mxcalc,2)+d_q_adv(1:mxcalc,2))
+        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
+     &      dt_phys(1:mxcalc)-relax_thl(1:mxcalc)+d_th_adv(1:mxcalc))
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_read_forc_cases.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_read_forc_cases.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1D_read_forc_cases.h	(revision 3815)
@@ -0,0 +1,782 @@
+!----------------------------------------------------------------------
+! forcing_les = .T. : Impose a constant cooling 
+! forcing_radconv = .T. : Pure radiative-convective equilibrium:
+!----------------------------------------------------------------------
+
+
+      nq1=0
+      nq2=0
+
+      if (forcing_les .or. forcing_radconv                                      &
+     &    .or. forcing_GCSSold .or. forcing_fire) then
+
+      if (forcing_fire) then
+!----------------------------------------------------------------------
+!read fire forcings from fire.nc
+!----------------------------------------------------------------------
+      fich_fire='fire.nc'
+      call read_fire(fich_fire,nlev_fire,nt_fire                                &
+     &     ,height,tttprof,qtprof,uprof,vprof,e12prof                           &
+     &     ,ugprof,vgprof,wfls,dqtdxls                                          &
+     &     ,dqtdyls,dqtdtls,thlpcar)
+      write(*,*) 'Forcing FIRE lu'
+      kmax=120            ! nombre de niveaux dans les profils et forcages
+      else 
+!----------------------------------------------------------------------
+! Read profiles from files: prof.inp.001 and lscale.inp.001
+! (repris de readlesfiles)
+!----------------------------------------------------------------------
+
+      call readprofiles(nlev_max,kmax,nqtot,height,                             &
+     &           tttprof,qtprof,uprof,vprof,                                    &
+     &           e12prof,ugprof,vgprof,                                         &
+     &           wfls,dqtdxls,dqtdyls,dqtdtls,                                  &
+     &           thlpcar,qprof,nq1,nq2)
+      endif
+
+! compute altitudes of play levels.
+      zlay(1) =zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l = 2,llm
+        zlay(l) = zlay(l-1)+rd*tsurf*(psurf-play(1))/(rg*psurf)
+      enddo
+
+!----------------------------------------------------------------------
+! Interpolation of the profiles given on the input file to
+! model levels
+!----------------------------------------------------------------------
+      zlay(1) = zsurf +  rd*tsurf*(psurf-play(1))/(rg*psurf)
+      do l=1,llm
+        ! Above the max altutide of the input file
+
+        if (zlay(l)<height(kmax)) mxcalc=l
+
+        frac = (height(kmax)-zlay(l))/(height (kmax)-height(kmax-1))
+        ttt =tttprof(kmax)-frac*(tttprof(kmax)-tttprof(kmax-1))
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+        q(l,1)  = qtprof(kmax)-frac*( qtprof(kmax)- qtprof(kmax-1))
+        u(l)    =  uprof(kmax)-frac*(  uprof(kmax)-  uprof(kmax-1))
+        v(l)    =  vprof(kmax)-frac*(  vprof(kmax)-  vprof(kmax-1))
+        ug(l)   = ugprof(kmax)-frac*( ugprof(kmax)- ugprof(kmax-1))
+        vg(l)   = vgprof(kmax)-frac*( vgprof(kmax)- vgprof(kmax-1))
+        IF (nq2>0) q(l,nq1:nq2)=qprof(kmax,nq1:nq2)                         &
+     &               -frac*(qprof(kmax,nq1:nq2)-qprof(kmax-1,nq1:nq2))
+        omega(l)=   wfls(kmax)-frac*(   wfls(kmax)-   wfls(kmax-1))
+
+        dq_dyn(l,1) = dqtdtls(kmax)-frac*(dqtdtls(kmax)-dqtdtls(kmax-1))
+        dt_cooling(l)=thlpcar(kmax)-frac*(thlpcar(kmax)-thlpcar(kmax-1))
+        do k=2,kmax
+          frac = (height(k)-zlay(l))/(height(k)-height(k-1))
+          if(l==1) print*,'k, height, tttprof',k,height(k),tttprof(k)
+          if(zlay(l)>height(k-1).and.zlay(l)<height(k)) then
+            ttt =tttprof(k)-frac*(tttprof(k)-tttprof(k-1))
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+          print *,' temp,teta ',l,temp(l),teta(l)
+            q(l,1)  = qtprof(k)-frac*( qtprof(k)- qtprof(k-1))
+            u(l)    =  uprof(k)-frac*(  uprof(k)-  uprof(k-1))
+            v(l)    =  vprof(k)-frac*(  vprof(k)-  vprof(k-1))
+            ug(l)   = ugprof(k)-frac*( ugprof(k)- ugprof(k-1))
+            vg(l)   = vgprof(k)-frac*( vgprof(k)- vgprof(k-1))
+            IF (nq2>0) q(l,nq1:nq2)=qprof(k,nq1:nq2)                        &
+     &                   -frac*(qprof(k,nq1:nq2)-qprof(k-1,nq1:nq2))
+            omega(l)=   wfls(k)-frac*(   wfls(k)-   wfls(k-1))
+            dq_dyn(l,1)=dqtdtls(k)-frac*(dqtdtls(k)-dqtdtls(k-1))
+            dt_cooling(l)=thlpcar(k)-frac*(thlpcar(k)-thlpcar(k-1))
+          elseif(zlay(l)<height(1)) then ! profils uniformes pour z<height(1)
+            ttt =tttprof(1)
+       if ((forcing_GCSSold .AND. tp_ini_GCSSold) .OR. forcing_fire)then ! pot. temp. in initial profile
+          temp(l) = ttt*(play(l)/pzero)**rkappa
+          teta(l) = ttt
+       else
+          temp(l) = ttt
+          teta(l) = ttt*(pzero/play(l))**rkappa
+       endif
+            q(l,1)  = qtprof(1)
+            u(l)    =  uprof(1)
+            v(l)    =  vprof(1)
+            ug(l)   = ugprof(1)
+            vg(l)   = vgprof(1)
+            omega(l)=   wfls(1)
+            IF (nq2>0) q(l,nq1:nq2)=qprof(1,nq1:nq2)
+            dq_dyn(l,1)  =dqtdtls(1)
+            dt_cooling(l)=thlpcar(1)
+          endif
+        enddo 
+
+        temp(l)=max(min(temp(l),350.),150.)
+        rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+        if (l .lt. llm) then
+          zlay(l+1) = zlay(l) + (play(l)-play(l+1))/(rg*rho(l))
+        endif
+        omega2(l)=-rho(l)*omega(l)
+        omega(l)= omega(l)*(-rg*rho(l)) !en Pa/s
+        if (l>1) then
+        if(zlay(l-1)>height(kmax)) then
+           omega(l)=0.0
+           omega2(l)=0.0
+        endif   
+        endif
+        if(q(l,1)<0.) q(l,1)=0.0
+        q(l,2)  = 0.0
+      enddo
+
+      endif ! forcing_les .or. forcing_GCSSold .or. forcing_fire
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for GCSSold:
+!---------------------------------------------------------------------
+      if (forcing_GCSSold) then
+       fich_gcssold_ctl = './forcing.ctl'
+       fich_gcssold_dat = './forcing8.dat'
+       call copie(llm,play,psurf,fich_gcssold_ctl)
+       call get_uvd2(it,timestep,fich_gcssold_ctl,fich_gcssold_dat,         &
+     &               ht_gcssold,hq_gcssold,hw_gcssold,                      &
+     &               hu_gcssold,hv_gcssold,                                 &
+     &               hthturb_gcssold,hqturb_gcssold,Ts_gcssold,             &
+     &               imp_fcg_gcssold,ts_fcg_gcssold,                        &
+     &               Tp_fcg_gcssold,Turb_fcg_gcssold)
+       print *,' get_uvd2 -> hqturb_gcssold ',hqturb_gcssold
+      endif ! forcing_GCSSold
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing for RICO:
+!---------------------------------------------------------------------
+      if (forcing_rico) then
+
+!       call writefield_phy('omega', omega,llm+1)
+      fich_rico = 'rico.txt'
+       call read_rico(fich_rico,nlev_rico,ps_rico,play                      &
+     &             ,ts_rico,t_rico,q_rico,u_rico,v_rico,w_rico              &
+     &             ,dth_rico,dqh_rico)
+        print*, ' on a lu et prepare RICO'
+
+       mxcalc=llm
+       print *, airefi, ' airefi '
+       do l = 1, llm
+       rho(l)  = play(l)/(rd*t_rico(l)*(1.+(rv/rd-1.)*q_rico(l)))
+       temp(l) = t_rico(l)
+       q(l,1) = q_rico(l)
+       q(l,2) = 0.0
+       u(l) = u_rico(l)
+       v(l) = v_rico(l)
+       ug(l)=u_rico(l)
+       vg(l)=v_rico(l)
+       omega(l) = -w_rico(l)*rg
+       omega2(l) = omega(l)/rg*airefi
+       enddo
+      endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TOGA-COARE experiment (Ciesielski et al. 2002) :
+!---------------------------------------------------------------------
+
+      if (forcing_toga) then
+
+! read TOGA-COARE forcing (native vertical grid, nt_toga timesteps):
+      fich_toga = './d_toga/ifa_toga_coare_v21_dime.txt'
+      CALL read_togacoare(fich_toga,nlev_toga,nt_toga                       &
+     &         ,ts_toga,plev_toga,t_toga,q_toga,u_toga,v_toga,w_toga        &
+     &         ,ht_toga,vt_toga,hq_toga,vq_toga)
+
+       write(*,*) 'Forcing TOGA lu'
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+      CALL interp_toga_time(daytime,day1,annee_ref                          &
+     &             ,year_ini_toga,day_ju_ini_toga,nt_toga,dt_toga           &
+     &             ,nlev_toga,ts_toga,plev_toga,t_toga,q_toga,u_toga        &
+     &             ,v_toga,w_toga,ht_toga,vt_toga,hq_toga,vq_toga           &
+     &             ,ts_prof,plev_prof,t_prof,q_prof,u_prof,v_prof,w_prof    &
+     &             ,ht_prof,vt_prof,hq_prof,vq_prof)
+
+! vertical interpolation:
+      CALL interp_toga_vertical(play,nlev_toga,plev_prof                    &
+     &         ,t_prof,q_prof,u_prof,v_prof,w_prof                          &
+     &         ,ht_prof,vt_prof,hq_prof,vq_prof                             &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+       write(*,*) 'Profil initial forcing TOGA interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!?       omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd-(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = -(hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_toga
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from TWPICE experiment (Shaocheng et al. 2010) :
+!---------------------------------------------------------------------
+
+      if (forcing_twpice) then
+!read TWP-ICE forcings
+     fich_twpice='d_twpi/twp180iopsndgvarana_v2.1_C3.c1.20060117.000000.cdf'
+      call read_twpice(fich_twpice,nlev_twpi,nt_twpi                        &
+     &     ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi            &
+     &     ,ht_twpi,vt_twpi,hq_twpi,vq_twpi)
+
+      write(*,*) 'Forcing TWP-ICE lu'
+!Time interpolation for initial conditions using TOGA interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+      CALL interp_toga_time(daytime,day1,annee_ref                          &
+     &          ,year_ini_twpi,day_ju_ini_twpi,nt_twpi,dt_twpi,nlev_twpi    &
+     &             ,ts_twpi,plev_twpi,t_twpi,q_twpi,u_twpi,v_twpi,w_twpi    &
+     &             ,ht_twpi,vt_twpi,hq_twpi,vq_twpi                         &
+     &             ,ts_proftwp,plev_proftwp,t_proftwp,q_proftwp             &
+     &             ,u_proftwp,v_proftwp,w_proftwp                           &
+     &             ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp)
+
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_twpi,plev_proftwp                 &
+     &         ,t_proftwp,q_proftwp,u_proftwp,v_proftwp,w_proftwp           &
+     &         ,ht_proftwp,vt_proftwp,hq_proftwp,vq_proftwp                 &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_proftwp
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       omega(l) = w_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod(l)+vt_mod(l))
+       d_q_adv(l,1) = (hq_mod(l)+vq_mod(l))
+       d_q_adv(l,2) = 0.0
+      enddo     
+       
+      endif !forcing_twpice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from AMMA experiment (Couvreux et al. 2010) :
+!---------------------------------------------------------------------
+
+      if (forcing_amma) then
+
+      call read_1D_cases
+
+      write(*,*) 'Forcing AMMA lu'
+
+!champs initiaux:
+      do k=1,nlev_amma
+         th_ammai(k)=th_amma(k)
+         q_ammai(k)=q_amma(k)
+         u_ammai(k)=u_amma(k)
+         v_ammai(k)=v_amma(k)
+         vitw_ammai(k)=vitw_amma(k,12)
+         ht_ammai(k)=ht_amma(k,12)
+         hq_ammai(k)=hq_amma(k,12)
+         vt_ammai(k)=0.
+         vq_ammai(k)=0.
+      enddo   
+      omega(:)=0.      
+      omega2(:)=0.
+      rho(:)=0.
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+      CALL interp_toga_vertical(play,nlev_amma,plev_amma                    &
+     &         ,th_ammai,q_ammai,u_ammai,v_ammai,vitw_ammai                 &
+     &         ,ht_ammai,vt_ammai,hq_ammai,vq_ammai                         &
+     &         ,t_mod,q_mod,u_mod,v_mod,w_mod                               &
+     &         ,ht_mod,vt_mod,hq_mod,vq_mod,mxcalc)
+!       write(*,*) 'Profil initial forcing TWP-ICE interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_proftwp
+      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      do l = 1, llm
+! Ligne du dessous à decommenter si on lit theta au lieu de temp
+!      temp(l) = t_mod(l)*(play(l)/pzero)**rkappa 
+       temp(l) = t_mod(l) 
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+       omega(l) = w_mod(l)*(-rg*rho(l))
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
+!forcage en th
+!       d_th_adv(l) = ht_mod(l)
+       d_q_adv(l,1) = hq_mod(l)
+       d_q_adv(l,2) = 0.0
+       dt_cooling(l)=0.
+      enddo     
+       write(*,*) 'Prof initeforcing AMMA interpole temp39',temp(39)
+      
+
+!     ok_flux_surf=.false.
+      fsens=-1.*sens_amma(12)
+      flat=-1.*lat_amma(12)
+       
+      endif !forcing_amma
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from DICE experiment (see file DICE_protocol_vn2-3.pdf)
+!---------------------------------------------------------------------
+
+      if (forcing_dice) then
+!read DICE forcings
+      fich_dice='dice_driver.nc'
+      call read_dice(fich_dice,nlev_dice,nt_dice                    &
+     &     ,zz_dice,plev_dice,th_dice,qv_dice,u_dice,v_dice,o3_dice &
+     &     ,shf_dice,lhf_dice,lwup_dice,swup_dice,tg_dice,ustar_dice& 
+     &     ,psurf_dice,ug_dice,vg_dice,ht_dice,hq_dice              &
+     &     ,hu_dice,hv_dice,w_dice,omega_dice)
+
+      write(*,*) 'Forcing DICE lu'
+
+!champs initiaux:
+      do k=1,nlev_dice
+         th_dicei(k)=th_dice(k)
+         qv_dicei(k)=qv_dice(k)
+         u_dicei(k)=u_dice(k)
+         v_dicei(k)=v_dice(k)
+         o3_dicei(k)=o3_dice(k)
+         ht_dicei(k)=ht_dice(k,1)
+         hq_dicei(k)=hq_dice(k,1)
+         hu_dicei(k)=hu_dice(k,1)
+         hv_dicei(k)=hv_dice(k,1)
+         w_dicei(k)=w_dice(k,1)
+         omega_dicei(k)=omega_dice(k,1)
+      enddo   
+      omega(:)=0.      
+      omega2(:)=0.
+      rho(:)=0.
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_proftwp
+!
+!     CALL interp_dice_time(daytime,day1,annee_ref
+!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
+!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
+!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
+!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
+!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
+!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
+!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
+!    o             ,omega_profd)
+
+      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice       &
+     &         ,th_dicei,qv_dicei,u_dicei,v_dicei,o3_dicei             &
+     &         ,ht_dicei,hq_dicei,hu_dicei,hv_dicei,w_dicei,omega_dicei&
+     &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                       &
+     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
+
+! Pour tester les advections horizontales de T et Q, on met w_mod et omega_mod à zero (MPL 20131108)
+!     w_mod(:,:)=0.
+!     omega_mod(:,:)=0.
+
+!       write(*,*) 'Profil initial forcing DICE interpole',t_mod
+! Les forcages DICE sont donnes /jour et non /seconde !
+      ht_mod(:)=ht_mod(:)/86400.
+      hq_mod(:)=hq_mod(:)/86400.
+      hu_mod(:)=hu_mod(:)/86400.
+      hv_mod(:)=hv_mod(:)/86400.
+
+! initial and boundary conditions :
+      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
+      do l = 1, llm
+! Ligne du dessous à decommenter si on lit theta au lieu de temp
+       temp(l) = th_mod(l)*(play(l)/pzero)**rkappa 
+!      temp(l) = t_mod(l) 
+       q(l,1) = qv_mod(l)
+       q(l,2) = 0.0
+!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       ug(l)=ug_dice(1)
+       vg(l)=vg_dice(1)
+       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!      omega(l) = w_mod(l)*(-rg*rho(l))
+       omega(l) = omega_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
+!forcage en th
+!       d_th_adv(l) = ht_mod(l)
+       d_q_adv(l,1) = hq_mod(l)
+       d_q_adv(l,2) = 0.0
+       dt_cooling(l)=0.
+      enddo     
+       write(*,*) 'Profil initial forcing DICE interpole temp39',temp(39)
+      
+
+!     ok_flux_surf=.false.
+      fsens=-1.*shf_dice(1)
+      flat=-1.*lhf_dice(1)
+! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par 
+! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
+! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
+! MPL 05082013
+      ust=ustar_dice(1)
+      tg=tg_dice(1)
+      print *,'ust= ',ust
+      IF (tsurf .LE. 0.) THEN
+       tsurf= tg_dice(1)
+      ENDIF
+      psurf= psurf_dice(1)
+      solsw_in = (1.-albedo)/albedo*swup_dice(1)
+      sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
+      PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
+      endif !forcing_dice
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from Arm_Cu case                   
+! For this case, ifa_armcu.txt contains sensible, latent heat fluxes
+! large scale advective forcing,radiative forcing 
+! and advective tendency of theta and qt to be applied 
+!---------------------------------------------------------------------
+
+      if (forcing_armcu) then
+! read armcu forcing :
+       write(*,*) 'Avant lecture Forcing Arm_Cu'
+      fich_armcu = './ifa_armcu.txt'
+      CALL read_armcu(fich_armcu,nlev_armcu,nt_armcu,                       &
+     & sens_armcu,flat_armcu,adv_theta_armcu,                               &
+     & rad_theta_armcu,adv_qt_armcu)
+       write(*,*) 'Forcing Arm_Cu lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.19 or prof.inp.40 
+! For this case, profiles are given for two vertical resolution
+! 19 or 40 levels
+!
+! Comment from: http://www.knmi.nl/samenw/eurocs/ARM/profiles.html
+! Note that the initial profiles contain no liquid water! 
+! (so potential temperature can be interpreted as liquid water 
+! potential temperature and water vapor as total water)
+! profiles are given at full levels
+!----------------------------------------------------------------------
+
+      call readprofile_armcu(nlev_max,kmax,height,play_mod,u_mod,           &
+     &           v_mod,theta_mod,t_mod,qv_mod,rv_mod,ap,bp)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+
+      print *,'Avant interp_armcu_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_armcu=',year_ini_armcu
+      print *,'day_ju_ini_armcu=',day_ju_ini_armcu
+      print *,'nt_armcu=',nt_armcu
+      print *,'dt_armcu=',dt_armcu
+      print *,'nlev_armcu=',nlev_armcu
+      CALL interp_armcu_time(daytime,day1,annee_ref                         &
+     &            ,year_ini_armcu,day_ju_ini_armcu,nt_armcu,dt_armcu        &
+     &            ,nlev_armcu,sens_armcu,flat_armcu,adv_theta_armcu         &
+     &            ,rad_theta_armcu,adv_qt_armcu,sens_prof,flat_prof         &
+     &            ,adv_theta_prof,rad_theta_prof,adv_qt_prof)
+       write(*,*) 'Forcages interpoles dans temps'
+
+! No vertical interpolation if nlev imposed to 19 or 40
+! The vertical grid stops at 4000m # 600hPa
+      mxcalc=llm
+
+! initial and boundary conditions :
+!     tsurf = ts_prof
+! tsurf read in lmdz1d.def
+      write(*,*) 'Tsurf initiale: ',tsurf
+      do l = 1, llm
+       play(l)=play_mod(l)*100.
+       presnivs(l)=play(l)
+       zlay(l)=height(l)
+       temp(l) = t_mod(l)
+       teta(l)=theta_mod(l)
+       q(l,1) = qv_mod(l)/1000.
+! No liquid water in the initial profil
+       q(l,2) = 0.
+       u(l) = u_mod(l)
+       ug(l)= u_mod(l)
+       v(l) = v_mod(l)
+       vg(l)= v_mod(l)
+! Advective forcings are given in K or g/kg ... per HOUR
+!      IF(height(l).LT.1000) THEN
+!        d_th_adv(l) = (adv_theta_prof + rad_theta_prof)/3600.
+!        d_q_adv(l,1) = adv_qt_prof/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSEIF (height(l).GE.1000.AND.height(l).LT.3000) THEN
+!        d_th_adv(l) = (adv_theta_prof + rad_theta_prof)*
+!    :               (1-(height(l)-1000.)/2000.)
+!        d_th_adv(l) = d_th_adv(l)/3600.
+!        d_q_adv(l,1) = adv_qt_prof*(1-(height(l)-1000.)/2000.)
+!        d_q_adv(l,1) = d_q_adv(l,1)/1000./3600.
+!        d_q_adv(l,2) = 0.0
+!      ELSE
+!        d_th_adv(l) = 0.0
+!        d_q_adv(l,1) = 0.0
+!        d_q_adv(l,2) = 0.0
+!      ENDIF
+      enddo
+! plev at half levels is given in proh.inp.19 or proh.inp.40 files
+      plev(1)= ap(llm+1)+bp(llm+1)*psurf
+      do l = 1, llm
+      plev(l+1) = ap(llm-l+1)+bp(llm-l+1)*psurf
+      print *,'Read_forc: l height play plev zlay temp',                    &
+     &   l,height(l),play(l),plev(l),zlay(l),temp(l)
+      enddo
+! For this case, fluxes are imposed
+       fsens=-1*sens_prof
+       flat=-1*flat_prof
+
+      endif ! forcing_armcu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from transition case of Irina Sandu                  
+!---------------------------------------------------------------------
+
+      if (forcing_sandu) then
+       write(*,*) 'Avant lecture Forcing SANDU'
+
+! read sanduref forcing :
+      fich_sandu = './ifa_sanduref.txt'
+      CALL read_sandu(fich_sandu,nlev_sandu,nt_sandu,ts_sandu)
+
+       write(*,*) 'Forcing SANDU lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.001 
+!----------------------------------------------------------------------
+
+      call readprofile_sandu(nlev_max,kmax,height,plev_profs,t_profs,       &
+     &           thl_profs,q_profs,u_profs,v_profs,                         &
+     &           w_profs,omega_profs,o3mmr_profs)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
+! revoir 1DUTILS.h et les arguments
+
+      print *,'Avant interp_sandu_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_sandu=',year_ini_sandu
+      print *,'day_ju_ini_sandu=',day_ju_ini_sandu
+      print *,'nt_sandu=',nt_sandu
+      print *,'dt_sandu=',dt_sandu
+      print *,'nlev_sandu=',nlev_sandu
+      CALL interp_sandu_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_sandu,day_ju_ini_sandu,nt_sandu,dt_sandu       &
+     &             ,nlev_sandu                                              &
+     &             ,ts_sandu,ts_prof)
+
+! vertical interpolation:
+      print *,'Avant interp_vertical: nlev_sandu=',nlev_sandu
+      CALL interp_sandu_vertical(play,nlev_sandu,plev_profs                 &
+     &         ,t_profs,thl_profs,q_profs,u_profs,v_profs,w_profs           &
+     &         ,omega_profs,o3mmr_profs                                     &
+     &         ,t_mod,thl_mod,q_mod,u_mod,v_mod,w_mod                       &
+     &         ,omega_mod,o3mmr_mod,mxcalc)
+       write(*,*) 'Profil initial forcing SANDU interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       tetal(l)=thl_mod(l)
+       q(l,1) = q_mod(l)
+       q(l,2) = 0.0
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       w(l) = w_mod(l)
+       omega(l) = omega_mod(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!?       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!?       omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!      d_th_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
+!      d_q_adv(l,1) = vq_mod(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd
+       d_q_adv(l,1) = 0.0
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_sandu
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from Astex case
+!---------------------------------------------------------------------
+
+      if (forcing_astex) then
+       write(*,*) 'Avant lecture Forcing Astex'
+
+! read astex forcing :
+      fich_astex = './ifa_astex.txt'
+      CALL read_astex(fich_astex,nlev_astex,nt_astex,div_astex,ts_astex,    &
+     &  ug_astex,vg_astex,ufa_astex,vfa_astex)
+
+       write(*,*) 'Forcing Astex lu'
+
+!----------------------------------------------------------------------
+! Read profiles from file: prof.inp.001
+!----------------------------------------------------------------------
+
+      call readprofile_astex(nlev_max,kmax,height,plev_profa,t_profa,       &
+     &           thl_profa,qv_profa,ql_profa,qt_profa,u_profa,v_profa,      &
+     &           w_profa,tke_profa,o3mmr_profa)
+
+! time interpolation for initial conditions:
+      write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',day,day1
+! ATTENTION, cet appel ne convient pas pour le cas SANDU !!
+! revoir 1DUTILS.h et les arguments
+
+      print *,'Avant interp_astex_time'
+      print *,'daytime=',daytime
+      print *,'day1=',day1
+      print *,'annee_ref=',annee_ref
+      print *,'year_ini_astex=',year_ini_astex
+      print *,'day_ju_ini_astex=',day_ju_ini_astex
+      print *,'nt_astex=',nt_astex
+      print *,'dt_astex=',dt_astex
+      print *,'nlev_astex=',nlev_astex
+      CALL interp_astex_time(daytime,day1,annee_ref                         &
+     &             ,year_ini_astex,day_ju_ini_astex,nt_astex,dt_astex       &
+     &             ,nlev_astex,div_astex,ts_astex,ug_astex,vg_astex         &
+     &             ,ufa_astex,vfa_astex,div_prof,ts_prof,ug_prof,vg_prof    &
+     &             ,ufa_prof,vfa_prof)
+
+! vertical interpolation:
+      print *,'Avant interp_vertical: nlev_astex=',nlev_astex
+      CALL interp_astex_vertical(play,nlev_astex,plev_profa                 &
+     &         ,t_profa,thl_profa,qv_profa,ql_profa,qt_profa                &
+     &         ,u_profa,v_profa,w_profa,tke_profa,o3mmr_profa               &
+     &         ,t_mod,thl_mod,qv_mod,ql_mod,qt_mod,u_mod,v_mod,w_mod        &
+     &         ,tke_mod,o3mmr_mod,mxcalc)
+       write(*,*) 'Profil initial forcing Astex interpole'
+
+! initial and boundary conditions :
+      tsurf = ts_prof
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod(l)
+       tetal(l)=thl_mod(l)
+       q(l,1) = qv_mod(l)
+       q(l,2) = ql_mod(l)
+       u(l) = u_mod(l)
+       v(l) = v_mod(l)
+       w(l) = w_mod(l)
+       omega(l) = w_mod(l)
+!      omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+!      rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
+!      omega2(l)=-rho(l)*omega(l)
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!      d_th_adv(l) = alpha*omega(l)/rcpd+vt_mod(l)
+!      d_q_adv(l,1) = vq_mod(l)
+       d_th_adv(l) = alpha*omega(l)/rcpd
+       d_q_adv(l,1) = 0.0
+       d_q_adv(l,2) = 0.0
+      enddo
+
+      endif ! forcing_astex
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!---------------------------------------------------------------------
+! Forcing from standard case :
+!---------------------------------------------------------------------
+
+      if (forcing_case) then
+
+         write(*,*),'avant call read_1D_cas'
+         call read_1D_cas
+         write(*,*) 'Forcing read'
+
+!Time interpolation for initial conditions using TOGA interpolation routine
+         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
+      CALL interp_case_time(day,day1,annee_ref                &
+     &         ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas       &
+     &         ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas               &
+     &         ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas           &
+     &         ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas             &
+     &         ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas                 &
+     &         ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas         &
+     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas     &
+     &         ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas       &
+     &         ,dq_prof_cas,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas)
+
+! vertical interpolation using TOGA interpolation routine:
+!      write(*,*)'avant interp vert', t_prof
+      CALL interp_case_vertical(play,nlev_cas,plev_prof_cas            &
+     &         ,t_prof_cas,q_prof_cas,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas    &
+     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas           &
+     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas           &
+     &         ,t_mod_cas,q_mod_cas,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas           &
+     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas               &
+     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas,mxcalc)
+!       write(*,*) 'Profil initial forcing case interpole',t_mod
+
+! initial and boundary conditions :
+!      tsurf = ts_prof_cas
+      ts_cur = ts_prof_cas 
+      psurf=plev_prof_cas(1)
+      write(*,*) 'SST initiale: ',tsurf
+      do l = 1, llm
+       temp(l) = t_mod_cas(l)
+       q(l,1) = q_mod_cas(l)
+       q(l,2) = 0.0
+       u(l) = u_mod_cas(l)
+       v(l) = v_mod_cas(l)
+       omega(l) = w_mod_cas(l)
+       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
+
+       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
+!on applique le forcage total au premier pas de temps
+!attention: signe different de toga
+       d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
+       d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
+       d_q_adv(l,2) = 0.0
+       d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
+       d_u_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
+      enddo     
+       
+      endif !forcing_case
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1Dconv.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1Dconv.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/1Dconv.h	(revision 3815)
@@ -0,0 +1,872 @@
+        subroutine get_uvd(itap,dtime,file_forctl,file_fordat,                  &
+     &       ht,hq,hw,hu,hv,hthturb,hqturb,                                     &
+     &       Ts,imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)                                 
+!
+        implicit none
+ 
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! cette routine permet d obtenir u_convg,v_convg,ht,hq et ainsi de
+! pouvoir calculer la convergence et le cisaillement dans la physiq
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+#include "YOMCST.h"
+
+      INTEGER klev
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100) !pression en Pa au milieu de chaque couche GCM
+      REAL coef1(100) !coefficient d interpolation
+      REAL coef2(100) !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100)  !pression en Pa au milieu de chaque couche Meso-NH
+      REAL hplaym(100) !pression en hPa milieux des couches Meso-NH
+
+      integer i,j,k,ll,in
+
+      CHARACTER*80 file_forctl,file_fordat
+
+      COMMON/com1_phys_gcss/play,coef1,coef2,JM,klev
+      COMMON/com2_phys_gcss/playm,hplaym,nblvlm
+
+!======================================================================
+! methode: on va chercher les donnees du mesoNH de meteo france, on y
+!          a acces a tout pas detemps grace a la routine rdgrads qui
+!          est une boucle lisant dans ces fichiers.
+!          Puis on interpole ces donnes sur les 11 niveaux du gcm et
+!          et sur les pas de temps de ce meme gcm
+!----------------------------------------------------------------------
+! input:
+!       pasmax     :nombre de pas de temps maximum du mesoNH
+!       dt         :pas de temps du meso_NH (en secondes)
+!----------------------------------------------------------------------
+      integer pasmax,dt
+      save pasmax,dt
+!----------------------------------------------------------------------
+! arguments:
+!           itap   :compteur de la physique(le nombre de ces pas est
+!                   fixe dans la subroutine calcul_ini_gcm de interpo
+!                   -lation
+!           dtime  :pas detemps du gcm (en secondes)
+!           ht     :convergence horizontale de temperature(K/s)
+!           hq     :    "         "       d humidite (kg/kg/s)
+!           hw     :vitesse verticale moyenne (m/s**2)
+!           hu     :convergence horizontale d impulsion le long de x
+!                  (kg/(m^2 s^2)
+!           hv     : idem le long de y.
+!           Ts     : Temperature de surface (K)
+!           imp_fcg: var. logical .eq. T si forcage en impulsion
+!           ts_fcg: var. logical .eq. T si forcage en Ts present dans fichier
+!           Tp_fcg: var. logical .eq. T si forcage donne en Temp potentielle
+!           Turb_fcg: var. logical .eq. T si forcage turbulent present dans fichier
+!----------------------------------------------------------------------
+        integer itap
+        real dtime
+        real ht(100)
+        real hq(100)
+        real hu(100)
+        real hv(100)
+        real hw(100)
+        real hthturb(100)
+        real hqturb(100)
+        real Ts, Ts_subr
+        logical imp_fcg
+        logical ts_fcg
+        logical Tp_fcg
+        logical Turb_fcg
+!----------------------------------------------------------------------
+! Variables internes de get_uvd (note : l interpolation temporelle
+! est faite entre les pas de temps before et after, sur les variables
+! definies sur la grille du SCM; on atteint exactement les valeurs Meso
+! aux milieux des pas de temps Meso)
+!     time0     :date initiale en secondes
+!     time      :temps associe a chaque pas du SCM
+!     pas       :numero du pas du meso_NH (on lit en pas : le premier pas
+!                 des donnees est duplique)
+!     pasprev   :numero du pas de lecture precedent
+!     htaft     :advection horizontale de temp. au pas de temps after
+!     hqaft     :    "         "      d humidite        "
+!     hwaft     :vitesse verticalle moyenne  au pas de temps after
+!     huaft,hvaft :advection horizontale d impulsion au pas de temps after
+!     tsaft     : surface temperature 'after time step'
+!     htbef     :idem htaft, mais pour le pas de temps before
+!     hqbef     :voir hqaft
+!     hwbef     :voir hwaft
+!     hubef,hvbef : idem huaft,hvaft, mais pour before
+!     tsbef     : surface temperature 'before time step'
+!----------------------------------------------------------------------
+        integer time0,pas,pasprev
+        save time0,pas,pasprev
+        real time
+        real htaft(100),hqaft(100),hwaft(100),huaft(100),hvaft(100)
+        real hthturbaft(100),hqturbaft(100)
+        real Tsaft
+        save htaft,hqaft,hwaft,huaft,hvaft,hthturbaft,hqturbaft
+        real htbef(100),hqbef(100),hwbef(100),hubef(100),hvbef(100)
+        real hthturbbef(100),hqturbbef(100)
+        real Tsbef
+        save htbef,hqbef,hwbef,hubef,hvbef,hthturbbef,hqturbbef
+!
+        real timeaft,timebef
+        save timeaft,timebef
+        integer temps
+        character*4 string
+!----------------------------------------------------------------------
+! variables arguments de la subroutine rdgrads
+!---------------------------------------------------------------------
+        integer icompt,icomp1 !compteurs de rdgrads
+        real z(100)         ! altitude (grille Meso)
+        real ht_mes(100)    !convergence horizontale de temperature
+                            !-(grille Meso)
+        real hq_mes(100)    !convergence horizontale d humidite
+                            !(grille Meso)
+        real hw_mes(100)    !vitesse verticale moyenne
+                            !(grille Meso)
+        real hu_mes(100),hv_mes(100)    !convergence horizontale d impulsion
+                                        !(grille Meso)
+        real hthturb_mes(100) !tendance horizontale de T_pot, due aux
+                              !flux turbulents
+        real hqturb_mes(100) !tendance horizontale d humidite, due aux
+                              !flux turbulents
+!
+!---------------------------------------------------------------------
+! variable argument de la subroutine copie
+!---------------------------------------------------------------------
+! SB        real pplay(100)    !pression en milieu de couche du gcm
+! SB                            !argument de la physique
+!---------------------------------------------------------------------
+! variables destinees a la lecture du pas de temps du fichier de donnees
+!---------------------------------------------------------------------
+       character*80 aaa,atemps,spaces,apasmax
+       integer nch,imn,ipa
+!---------------------------------------------------------------------
+!  procedures appelees
+        external rdgrads    !lire en iterant dans forcing.dat
+!---------------------------------------------------------------------
+               print*,'le pas itap est:',itap
+!*** on determine le pas du meso_NH correspondant au nouvel itap ***
+!*** pour aller chercher les champs dans rdgrads                 ***
+!
+        time=time0+itap*dtime
+!c        temps=int(time/dt+1)
+!c        pas=min(temps,pasmax)
+        temps = 1 + int((dt + 2*time)/(2*dt))
+        pas=min(temps,pasmax-1)
+             print*,'le pas Meso est:',pas
+!
+!
+!===================================================================
+!
+!*** on remplit les champs before avec les champs after du pas   ***
+!*** precedent en format gcm                                     ***
+        if(pas.gt.pasprev)then
+          do i=1,klev
+             htbef(i)=htaft(i)
+             hqbef(i)=hqaft(i)
+             hwbef(i)=hwaft(i)
+             hubef(i)=huaft(i)
+             hvbef(i)=hvaft(i)
+             hThTurbbef(i)=hThTurbaft(i)
+             hqTurbbef(i)=hqTurbaft(i)
+          enddo
+          tsbef = tsaft
+          timebef=pasprev*dt
+          timeaft=timebef+dt
+          icomp1 = nblvlm*4
+          IF (ts_fcg) icomp1 = icomp1 + 1
+          IF (imp_fcg) icomp1 = icomp1 + nblvlm*2
+          IF (Turb_fcg) icomp1 = icomp1 + nblvlm*2
+          icompt = icomp1*pas
+         print *, 'imp_fcg,ts_fcg,Turb_fcg,pas,nblvlm,icompt'
+         print *, imp_fcg,ts_fcg,Turb_fcg,pas,nblvlm,icompt
+                       print*,'le pas pas est:',pas
+!*** on va chercher les nouveaux champs after dans toga.dat     ***
+!*** champs en format meso_NH                                   ***
+          open(99,FILE=file_fordat,FORM='UNFORMATTED',                        &
+     &             ACCESS='DIRECT',RECL=8)
+          call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes                &
+     &                  ,hu_mes,hv_mes,hthturb_mes,hqturb_mes                 &
+     &                  ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
+!
+
+               if(Tp_fcg) then
+!     (le forcage est donne en temperature potentielle)
+         do i = 1,nblvlm
+           ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
+         enddo
+               endif ! Tp_fcg
+        if(Turb_fcg) then
+         do i = 1,nblvlm
+           hThTurb_mes(i) = hThTurb_mes(i)*(hplaym(i)/1000.)**rkappa
+         enddo
+        endif  ! Turb_fcg
+!
+               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
+               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
+               print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
+                  if(imp_fcg) then
+               print*,'hu_mes ',(hu_mes(i),i=1,nblvlm)
+               print*,'hv_mes ',(hv_mes(i),i=1,nblvlm)
+                  endif
+                  if(Turb_fcg) then
+               print*,'hThTurb_mes ',(hThTurb_mes(i),i=1,nblvlm)
+               print*,'hqTurb_mes ',(hqTurb_mes(i),i=1,nblvlm)
+                  endif
+          IF (ts_fcg) print*,'ts_subr', ts_subr
+!*** on interpole les champs meso_NH sur les niveaux de pression***
+!*** gcm . on obtient le nouveau champ after                    ***
+            do k=1,klev
+             if (JM(k) .eq. 0) then
+         htaft(k)=              ht_mes(jm(k)+1)
+         hqaft(k)=              hq_mes(jm(k)+1)
+         hwaft(k)=              hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=              hu_mes(jm(k)+1)
+           hvaft(k)=              hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=         hThTurb_mes(jm(k)+1)
+           hqTurbaft(k)=          hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             else ! JM(k) .eq. 0
+           htaft(k)=coef1(k)*ht_mes(jm(k))+coef2(k)*ht_mes(jm(k)+1)
+           hqaft(k)=coef1(k)*hq_mes(jm(k))+coef2(k)*hq_mes(jm(k)+1)
+           hwaft(k)=coef1(k)*hw_mes(jm(k))+coef2(k)*hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=coef1(k)*hu_mes(jm(k))+coef2(k)*hu_mes(jm(k)+1)
+           hvaft(k)=coef1(k)*hv_mes(jm(k))+coef2(k)*hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=coef1(k)*hThTurb_mes(jm(k))                            &
+     &               +coef2(k)*hThTurb_mes(jm(k)+1)
+           hqTurbaft(k) =coef1(k)*hqTurb_mes(jm(k))                             &
+     &               +coef2(k)*hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             endif ! JM(k) .eq. 0
+            enddo
+            tsaft = ts_subr
+            pasprev=pas
+         else ! pas.gt.pasprev
+            print*,'timebef est:',timebef
+         endif ! pas.gt.pasprev    fin du bloc relatif au passage au pas
+                                  !de temps (meso) suivant
+!*** si on atteint le pas max des donnees experimentales ,on     ***
+!*** on conserve les derniers champs calcules                    ***
+      if(temps.ge.pasmax)then
+          do ll=1,klev
+               ht(ll)=htaft(ll)
+               hq(ll)=hqaft(ll)
+               hw(ll)=hwaft(ll)
+               hu(ll)=huaft(ll)
+               hv(ll)=hvaft(ll)
+               hThTurb(ll)=hThTurbaft(ll)
+               hqTurb(ll)=hqTurbaft(ll)
+          enddo
+          ts_subr = tsaft
+      else ! temps.ge.pasmax
+!*** on interpole sur les pas de temps de 10mn du gcm a partir   ***
+!** des pas de temps de 1h du meso_NH                            ***
+         do j=1,klev
+         ht(j)=((timeaft-time)*htbef(j)+(time-timebef)*htaft(j))/dt
+         hq(j)=((timeaft-time)*hqbef(j)+(time-timebef)*hqaft(j))/dt
+         hw(j)=((timeaft-time)*hwbef(j)+(time-timebef)*hwaft(j))/dt
+             if(imp_fcg) then
+         hu(j)=((timeaft-time)*hubef(j)+(time-timebef)*huaft(j))/dt
+         hv(j)=((timeaft-time)*hvbef(j)+(time-timebef)*hvaft(j))/dt
+             endif ! imp_fcg
+             if(Turb_fcg) then
+         hThTurb(j)=((timeaft-time)*hThTurbbef(j)                           &
+     &           +(time-timebef)*hThTurbaft(j))/dt
+         hqTurb(j)= ((timeaft-time)*hqTurbbef(j)                            &
+     &           +(time-timebef)*hqTurbaft(j))/dt
+             endif ! Turb_fcg
+         enddo
+         ts_subr = ((timeaft-time)*tsbef + (time-timebef)*tsaft)/dt
+       endif ! temps.ge.pasmax
+!
+        print *,' time,timebef,timeaft',time,timebef,timeaft
+        print *,' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
+        do j= 1,klev
+           print *, j,ht(j),htbef(j),htaft(j),                              &
+     &             hthturb(j),hthturbbef(j),hthturbaft(j)
+        enddo
+        print *,' hq,hqbef,hqaft,hqturb,hqturbbef,hqturbaft'
+        do j= 1,klev
+           print *, j,hq(j),hqbef(j),hqaft(j),                              &
+     &             hqturb(j),hqturbbef(j),hqturbaft(j)
+        enddo
+!
+!-------------------------------------------------------------------
+!
+         IF (Ts_fcg) Ts = Ts_subr
+         return
+!
+!-----------------------------------------------------------------------
+! on sort les champs de "convergence" pour l instant initial 'in'
+! ceci se passe au pas temps itap=0 de la physique
+!-----------------------------------------------------------------------
+        entry get_uvd2(itap,dtime,file_forctl,file_fordat,                  &
+     &           ht,hq,hw,hu,hv,hThTurb,hqTurb,ts,                          &
+     &           imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)
+             print*,'le pas itap est:',itap
+!
+!===================================================================
+!
+       write(*,'(a)') 'OPEN '//file_forctl
+       open(97,FILE=file_forctl,FORM='FORMATTED')
+!
+!------------------
+      do i=1,1000
+      read(97,1000,end=999) string
+ 1000 format (a4)
+      if (string .eq. 'TDEF') go to 50
+      enddo
+ 50   backspace(97)
+!-------------------------------------------------------------------
+!   *** on lit le pas de temps dans le fichier de donnees ***
+!   *** "forcing.ctl" et pasmax                           ***
+!-------------------------------------------------------------------
+      read(97,2000) aaa
+ 2000  format (a80)
+         print*,'aaa est',aaa
+      aaa=spaces(aaa,1)
+         print*,'aaa',aaa
+      call getsch(aaa,' ',' ',5,atemps,nch)
+         print*,'atemps est',atemps
+        atemps=atemps(1:nch-2)
+         print*,'atemps',atemps
+        read(atemps,*) imn
+        dt=imn*60
+         print*,'le pas de temps dt',dt
+      call getsch(aaa,' ',' ',2,apasmax,nch)
+        apasmax=apasmax(1:nch)
+        read(apasmax,*) ipa
+        pasmax=ipa
+         print*,'pasmax est',pasmax
+      CLOSE(97)
+!------------------------------------------------------------------
+! *** on lit le pas de temps initial de la simulation ***
+!------------------------------------------------------------------
+                  in=itap
+!c                  pasprev=in
+!c                  time0=dt*(pasprev-1)
+                  pasprev=in-1
+                  time0=dt*pasprev
+!
+          close(98)
+!
+      write(*,'(a)') 'OPEN '//file_fordat
+      open(99,FILE=file_fordat,FORM='UNFORMATTED',                          &
+     &          ACCESS='DIRECT',RECL=8)
+          icomp1 = nblvlm*4
+          IF (ts_fcg) icomp1 = icomp1 + 1
+          IF (imp_fcg) icomp1 = icomp1 + nblvlm*2
+          IF (Turb_fcg) icomp1 = icomp1 + nblvlm*2
+          icompt = icomp1*(in-1)
+          call rdgrads(99,icompt,nblvlm,z,ht_mes,hq_mes,hw_mes              &
+     &                   ,hu_mes,hv_mes,hthturb_mes,hqturb_mes              &
+     &                   ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
+          print *, 'get_uvd : rdgrads ->'
+          print *, tp_fcg
+!
+! following commented out because we have temperature already in ARM case
+!   (otherwise this is the potential temperature )
+!------------------------------------------------------------------------
+               if(Tp_fcg) then
+          do i = 1,nblvlm
+            ht_mes(i) = ht_mes(i)*(hplaym(i)/1000.)**rkappa
+          enddo
+               endif ! Tp_fcg
+           print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
+           print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
+           print*,'hw_mes ',(hw_mes(i),i=1,nblvlm)
+              if(imp_fcg) then
+           print*,'hu_mes ',(hu_mes(i),i=1,nblvlm)
+           print*,'hv_mes ',(hv_mes(i),i=1,nblvlm)
+           print*,'t',ts_subr
+              endif ! imp_fcg
+              if(Turb_fcg) then
+                 print*,'hThTurb_mes ',(hThTurb_mes(i),i=1,nblvlm)
+                 print*,'hqTurb ',     (hqTurb_mes(i),i=1,nblvlm)
+              endif ! Turb_fcg
+!----------------------------------------------------------------------
+! on a obtenu des champs initiaux sur les niveaux du meso_NH
+! on interpole sur les niveaux du gcm(niveau pression bien sur!)
+!-----------------------------------------------------------------------
+            do k=1,klev
+             if (JM(k) .eq. 0) then
+!FKC bug? ne faut il pas convertir tsol en tendance ????
+!RT bug taken care of by removing the stuff
+           htaft(k)=              ht_mes(jm(k)+1)
+           hqaft(k)=              hq_mes(jm(k)+1)
+           hwaft(k)=              hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=              hu_mes(jm(k)+1)
+           hvaft(k)=              hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=         hThTurb_mes(jm(k)+1)
+           hqTurbaft(k)=          hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             else ! JM(k) .eq. 0
+           htaft(k)=coef1(k)*ht_mes(jm(k))+coef2(k)*ht_mes(jm(k)+1)
+           hqaft(k)=coef1(k)*hq_mes(jm(k))+coef2(k)*hq_mes(jm(k)+1)
+           hwaft(k)=coef1(k)*hw_mes(jm(k))+coef2(k)*hw_mes(jm(k)+1)
+               if(imp_fcg) then
+           huaft(k)=coef1(k)*hu_mes(jm(k))+coef2(k)*hu_mes(jm(k)+1)
+           hvaft(k)=coef1(k)*hv_mes(jm(k))+coef2(k)*hv_mes(jm(k)+1)
+               endif ! imp_fcg
+               if(Turb_fcg) then
+           hThTurbaft(k)=coef1(k)*hThTurb_mes(jm(k))                        &
+     &                  +coef2(k)*hThTurb_mes(jm(k)+1)
+           hqTurbaft(k) =coef1(k)*hqTurb_mes(jm(k))                         &
+     &                  +coef2(k)*hqTurb_mes(jm(k)+1)
+               endif ! Turb_fcg
+             endif ! JM(k) .eq. 0
+            enddo
+            tsaft = ts_subr
+! valeurs initiales des champs de convergence
+          do k=1,klev
+             ht(k)=htaft(k)
+             hq(k)=hqaft(k)
+             hw(k)=hwaft(k)
+                if(imp_fcg) then
+             hu(k)=huaft(k)
+             hv(k)=hvaft(k)
+                endif ! imp_fcg
+                if(Turb_fcg) then
+             hThTurb(k)=hThTurbaft(k)
+             hqTurb(k) =hqTurbaft(k)
+                endif ! Turb_fcg
+          enddo
+          ts_subr = tsaft
+          close(99)
+          close(98)
+!
+!-------------------------------------------------------------------
+!
+!
+ 100      IF (Ts_fcg) Ts = Ts_subr
+        return
+!
+999     continue
+        stop 'erreur lecture, file forcing.ctl'
+        end
+
+      SUBROUTINE advect_tvl(dtime,zt,zq,vu_f,vv_f,t_f,q_f                   &
+     &                     ,d_t_adv,d_q_adv)
+      use dimphy
+      implicit none
+
+#include "dimensions.h"
+!cccc#include "dimphy.h"
+
+      integer k
+      real dtime, fact, du, dv, cx, cy, alx, aly
+      real zt(klev), zq(klev,3)
+      real vu_f(klev), vv_f(klev), t_f(klev), q_f(klev,3)
+
+      real d_t_adv(klev), d_q_adv(klev,3)
+
+! Velocity of moving cell
+      data cx,cy /12., -2./
+
+! Dimensions of moving cell
+      data alx,aly /100000.,150000./
+
+      do k = 1, klev
+            du = abs(vu_f(k)-cx)/alx
+            dv = abs(vv_f(k)-cy)/aly
+            fact = dtime *(du+dv-du*dv*dtime)
+            d_t_adv(k) = fact * (t_f(k)-zt(k))
+            d_q_adv(k,1) = fact * (q_f(k,1)-zq(k,1))
+            d_q_adv(k,2) = fact * (q_f(k,2)-zq(k,2))
+            d_q_adv(k,3) = fact * (q_f(k,3)-zq(k,3))
+      enddo
+
+      return
+      end
+
+      SUBROUTINE copie(klevgcm,playgcm,psolgcm,file_forctl)
+      implicit none
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! cette routine remplit les COMMON com1_phys_gcss et com2_phys_gcss.h
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      INTEGER klev !nombre de niveau de pression du GCM
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100)
+      REAL coef1(100)   !coefficient d interpolation
+      REAL coef2(100)   !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100) !pression en Pa au milieu de chaque couche Meso-NH
+      REAL hplaym(100)!pression en hecto-Pa des milieux de couche Meso-NH
+
+      COMMON/com1_phys_gcss/play,coef1,coef2,JM,klev
+      COMMON/com2_phys_gcss/playm,hplaym,nblvlm
+
+      integer k,klevgcm
+      real playgcm(klevgcm) ! pression en milieu de couche du gcm
+      real psolgcm
+      character*80 file_forctl
+
+      klev = klevgcm
+
+!---------------------------------------------------------------------
+! pression au milieu des couches du gcm dans la physiq
+! (SB: remplace le call conv_lipress_gcm(playgcm) )
+!---------------------------------------------------------------------
+
+       do k = 1, klev
+        play(k) = playgcm(k)
+        print*,'la pression gcm est:',play(k)
+       enddo
+
+!----------------------------------------------------------------------
+! lecture du descripteur des donnees Meso-NH (forcing.ctl):
+!  -> nb niveaux du meso.NH (nblvlm) + pressions meso.NH
+! (on remplit le COMMON com2_phys_gcss)
+!----------------------------------------------------------------------
+
+      call mesolupbis(file_forctl)
+
+      print*,'la valeur de nblvlm est:',nblvlm
+
+!----------------------------------------------------------------------
+! etude de la correspondance entre les niveaux meso.NH et GCM;
+! calcul des coefficients d interpolation coef1 et coef2
+! (on remplit le COMMON com1_phys_gcss)
+!----------------------------------------------------------------------
+
+      call corresbis(psolgcm)
+
+!---------------------------------------------------------
+! TEST sur le remplissage de com1_phys_gcss et com2_phys_gcss:
+!---------------------------------------------------------
+ 
+      write(*,*) ' '
+      write(*,*) 'TESTS com1_phys_gcss et com2_phys_gcss dans copie.F'
+      write(*,*) '--------------------------------------'
+      write(*,*) 'GCM: nb niveaux:',klev,' et pression, coeffs:'
+      do k = 1, klev
+      write(*,*) play(k), coef1(k), coef2(k)
+      enddo
+      write(*,*) 'MESO-NH: nb niveaux:',nblvlm,' et pression:'
+      do k = 1, nblvlm
+      write(*,*) playm(k), hplaym(k)
+      enddo
+      write(*,*) ' '
+
+      end
+      SUBROUTINE mesolupbis(file_forctl)
+      implicit none 
+!
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!
+! Lecture descripteur des donnees MESO-NH (forcing.ctl):
+! -------------------------------------------------------
+!
+!     Cette subroutine lit dans le fichier de controle "essai.ctl"
+!     et affiche le nombre de niveaux du Meso-NH ainsi que les valeurs
+!     des pressions en milieu de couche du Meso-NH (en Pa puis en hPa).
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
+      REAL hplaym(100) !pression en hPa des milieux de couche Meso-NH
+      COMMON/com2_phys_gcss/playm,hplaym,nblvlm
+
+      INTEGER i,lu,mlz,mlzh
+ 
+      character*80 file_forctl
+
+      character*4 a
+      character*80 aaa,anblvl,spaces
+      integer nch
+
+      lu=9
+      open(lu,file=file_forctl,form='formatted')
+!
+      do i=1,1000
+      read(lu,1000,end=999) a
+      if (a .eq. 'ZDEF') go to 100
+      enddo
+!
+ 100  backspace(lu)
+      print*,'  DESCRIPTION DES 2 MODELES : '
+      print*,' '
+!
+      read(lu,2000) aaa
+ 2000  format (a80)
+       aaa=spaces(aaa,1)
+       call getsch(aaa,' ',' ',2,anblvl,nch)
+         read(anblvl,*) nblvlm
+
+!
+      print*,'nbre de niveaux de pression Meso-NH :',nblvlm
+      print*,' '
+      print*,'pression en Pa de chaque couche du meso-NH :'
+!
+      read(lu,*) (playm(mlz),mlz=1,nblvlm)
+!      Si la pression est en HPa, la multiplier par 100
+      if (playm(1) .lt. 10000.) then
+        do mlz = 1,nblvlm
+         playm(mlz) = playm(mlz)*100.
+        enddo
+      endif
+      print*,(playm(mlz),mlz=1,nblvlm)
+!
+ 1000 format (a4)
+ 1001 format(5x,i2)
+!
+      print*,' '
+      do mlzh=1,nblvlm
+      hplaym(mlzh)=playm(mlzh)/100.
+      enddo
+!
+      print*,'pression en hPa de chaque couche du meso-NH: '
+      print*,(hplaym(mlzh),mlzh=1,nblvlm)
+!
+      close (lu)
+      return
+!
+ 999  stop 'erreur lecture des niveaux pression des donnees'
+      end
+
+      SUBROUTINE rdgrads(itape,icount,nl,z,ht,hq,hw,hu,hv,hthtur,hqtur,     &
+     &  ts_fcg,ts,imp_fcg,Turb_fcg)
+      IMPLICIT none
+      INTEGER itape,icount,icomp, nl
+      real z(nl),ht(nl),hq(nl),hw(nl),hu(nl),hv(nl)
+      real hthtur(nl),hqtur(nl)
+      real ts
+!
+      INTEGER k
+!
+      LOGICAL imp_fcg,ts_fcg,Turb_fcg
+!
+      icomp = icount
+!
+!
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)z(k)
+            print *,'icomp,k,z(k) ',icomp,k,z(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hT(k)
+             print*, hT(k), k
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hQ(k)
+         enddo
+!
+             if(turb_fcg) then
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hThTur(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hqTur(k)
+         enddo
+             endif
+         print *,' apres lecture hthtur, hqtur'
+!
+          if(imp_fcg) then
+
+         do k=1,nl
+            icomp=icomp+1
+           read(itape,rec=icomp)hu(k)
+         enddo
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hv(k)
+         enddo
+
+          endif
+!
+         do k=1,nl
+            icomp=icomp+1
+            read(itape,rec=icomp)hw(k)
+         enddo
+!
+              if(ts_fcg) then
+         icomp=icomp+1
+         read(itape,rec=icomp)ts
+              endif
+!
+      print *,' rdgrads ->'
+
+      RETURN
+      END
+
+      SUBROUTINE corresbis(psol)
+      implicit none
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! Cette subroutine calcule et affiche les valeurs des coefficients
+! d interpolation qui serviront dans la formule d interpolation elle-
+! meme.
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+      INTEGER klev    !nombre de niveau de pression du GCM
+      REAL play(100)  !pression en Pa au milieu de chaque couche GCM
+      INTEGER JM(100)
+      REAL coef1(100) !coefficient d interpolation
+      REAL coef2(100) !coefficient d interpolation
+
+      INTEGER nblvlm !nombre de niveau de pression du mesoNH
+      REAL playm(100) !pression en Pa milieu de chaque couche Meso-NH
+      REAL hplaym(100)!pression en hPa des milieux de couche Meso-NH
+
+      COMMON/com1_phys_gcss/play,coef1,coef2,JM,klev
+      COMMON/com2_phys_gcss/playm,hplaym,nblvlm
+
+      REAL psol
+      REAL val
+      INTEGER k, mlz
+
+
+      do k=1,klev
+         val=play(k)
+       if (val .gt. playm(1)) then
+          mlz = 0
+          JM(1) = mlz
+          coef1(1)=(playm(mlz+1)-val)/(playm(mlz+1)-psol)
+          coef2(1)=(val-psol)/(playm(mlz+1)-psol)
+       else if (val .gt. playm(nblvlm)) then
+         do mlz=1,nblvlm
+          if (     val .le. playm(mlz).and. val .gt. playm(mlz+1))then
+           JM(k)=mlz
+           coef1(k)=(playm(mlz+1)-val)/(playm(mlz+1)-playm(mlz))
+           coef2(k)=(val-playm(mlz))/(playm(mlz+1)-playm(mlz))
+          endif
+         enddo
+       else
+         JM(k) = nblvlm-1
+         coef1(k) = 0.
+         coef2(k) = 0.
+       endif
+      enddo
+!
+!c      if (play(klev) .le. playm(nblvlm)) then
+!c         mlz=nblvlm-1
+!c         JM(klev)=mlz
+!c         coef1(klev)=(playm(mlz+1)-val)
+!c     *            /(playm(mlz+1)-playm(mlz))
+!c         coef2(klev)=(val-playm(mlz))
+!c     *            /(playm(mlz+1)-playm(mlz))
+!c      endif
+!
+      print*,' '
+      print*,'         INTERPOLATION  : '
+      print*,' '
+      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
+      print*,(JM(k),k=1,klev)
+      print*,'correspondance de 9 niveaux du GCM sur les 53 du meso-NH:'
+      print*,(JM(k),k=1,klev)
+      print*,' '
+      print*,'vals du premier coef d"interpolation pour les 9 niveaux: '
+      print*,(coef1(k),k=1,klev)
+      print*,' '
+      print*,'valeurs du deuxieme coef d"interpolation pour les 9 niveaux:'
+      print*,(coef2(k),k=1,klev)
+!
+      return
+      end
+      SUBROUTINE GETSCH(STR,DEL,TRM,NTH,SST,NCH)
+!***************************************************************
+!*                                                             *
+!*                                                             *
+!* GETSCH                                                      *
+!*                                                             *
+!*                                                             *
+!* modified by :                                               *
+!***************************************************************
+!*   Return in SST the character string found between the NTH-1 and NTH
+!*   occurence of the delimiter 'DEL' but before the terminator 'TRM' in
+!*   the input string 'STR'. If TRM=DEL then STR is considered unlimited.
+!*   NCH=Length of the string returned in SST or =-1 if NTH is <1 or if
+!*   NTH is greater than the number of delimiters in STR.
+      IMPLICIT INTEGER (A-Z)
+      CHARACTER STR*(*),DEL*1,TRM*1,SST*(*)
+      NCH=-1
+      SST=' '
+      IF(NTH.GT.0) THEN
+        IF(TRM.EQ.DEL) THEN
+          LENGTH=LEN(STR)
+        ELSE
+          LENGTH=INDEX(STR,TRM)-1
+          IF(LENGTH.LT.0) LENGTH=LEN(STR)
+        ENDIF
+!*     Find beginning and end of the NTH DEL-limited substring in STR
+        END=-1
+        DO 1,N=1,NTH
+        IF(END.EQ.LENGTH) RETURN
+        BEG=END+2
+        END=BEG+INDEX(STR(BEG:LENGTH),DEL)-2
+        IF(END.EQ.BEG-2) END=LENGTH
+!*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
+    1   CONTINUE
+        NCH=END-BEG+1
+        IF(NCH.GT.0) SST=STR(BEG:END)
+      ENDIF
+      END
+      CHARACTER*(*) FUNCTION SPACES(STR,NSPACE)
+!
+! CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
+! ORIG.  6/05/86 M.GOOSSENS/DD
+!
+!-    The function value SPACES returns the character string STR with
+!-    leading blanks removed and each occurence of one or more blanks
+!-    replaced by NSPACE blanks inside the string STR
+!
+      CHARACTER*(*) STR
+!
+      LENSPA = LEN(SPACES)
+      SPACES = ' '
+      IF (NSPACE.LT.0) NSPACE = 0
+      IBLANK = 1
+      ISPACE = 1
+  100 INONBL = INDEXC(STR(IBLANK:),' ')
+      IF (INONBL.EQ.0) THEN
+          SPACES(ISPACE:) = STR(IBLANK:)
+                                                    GO TO 999
+      ENDIF
+      INONBL = INONBL + IBLANK - 1
+      IBLANK = INDEX(STR(INONBL:),' ')
+      IF (IBLANK.EQ.0) THEN
+          SPACES(ISPACE:) = STR(INONBL:)
+                                                    GO TO 999
+      ENDIF
+      IBLANK = IBLANK + INONBL - 1
+      SPACES(ISPACE:) = STR(INONBL:IBLANK-1)
+      ISPACE = ISPACE + IBLANK - INONBL + NSPACE
+      IF (ISPACE.LE.LENSPA)                         GO TO 100
+  999 END
+      FUNCTION INDEXC(STR,SSTR)
+!
+! CERN PROGLIB# M433    INDEXC          .VERSION KERNFOR  4.14  860211
+! ORIG. 26/03/86 M.GOOSSENS/DD
+!
+!-    Find the leftmost position where substring SSTR does not match
+!-    string STR scanning forward
+!
+      CHARACTER*(*) STR,SSTR
+!
+      LENS   = LEN(STR)
+      LENSS  = LEN(SSTR)
+!
+      DO 10 I=1,LENS-LENSS+1
+          IF (STR(I:I+LENSS-1).NE.SSTR) THEN
+              INDEXC = I
+                                         GO TO 999
+          ENDIF
+   10 CONTINUE
+      INDEXC = 0
+!
+  999 END
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comconst.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comconst.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comconst.h	(revision 3815)
@@ -0,0 +1,42 @@
+!
+! $Id: comconst.h 1952 2014-01-28 13:05:47Z lguez $
+!
+!-----------------------------------------------------------------------
+! INCLUDE comconst.h
+
+      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
+     &                 iflag_top_bound,mode_top_bound
+      COMMON/comconstr/dtvr,daysec,                                     &
+     & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
+     &                   ,dissip_factz,dissip_deltaz,dissip_zref        &
+     &                   ,tau_top_bound,                                &
+     & daylen,year_day,molmass, ihf
+
+
+      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
+      REAL dtvr ! dynamical time step (in s)
+      REAL daysec !length (in s) of a standard day
+      REAL pi    ! something like 3.14159....
+      REAL dtphys ! (s) time step for the physics
+      REAL dtdiss ! (s) time step for the dissipation
+      REAL rad ! (m) radius of the planet
+      REAL r ! Reduced Gas constant r=R/mu
+             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol)
+      REAL cpp   ! Specific heat Cp (J.kg-1.K-1)
+      REAL kappa ! kappa=R/Cp 
+      REAL cotot
+      REAL unsim ! = 1./iim
+      REAL g ! (m/s2) gravity
+      REAL omeg ! (rad/s) rotation rate of the planet
+      REAL dissip_factz,dissip_deltaz,dissip_zref
+! top_bound sponge:
+      INTEGER iflag_top_bound ! sponge type
+      INTEGER mode_top_bound  ! sponge mode
+      REAL tau_top_bound ! inverse of sponge characteristic time scale (Hz)
+      REAL daylen ! length of solar day, in 'standard' day length
+      REAL year_day ! Number of standard days in a year
+      REAL molmass ! (g/mol) molar mass of the atmosphere
+
+      REAL ihf ! (W/m2) Intrinsic heat flux (for giant planets)
+
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comdissnew.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comdissnew.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comdissnew.h	(revision 3815)
@@ -0,0 +1,30 @@
+!
+! $Id: comdissnew.h 1952 2014-01-28 13:05:47Z lguez $
+!
+!
+!  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 'comdissnew.h'
+
+      COMMON/comdissnew/ lstardis,nitergdiv,nitergrot,niterh,tetagdiv,  &
+     &                   tetagrot,tetatemp,coefdis, vert_prof_dissip
+
+      LOGICAL lstardis
+      INTEGER nitergdiv, nitergrot, niterh
+
+      integer vert_prof_dissip ! vertical profile of horizontal dissipation
+!     Allowed values:
+!     0: rational fraction, function of pressure
+!     1: tanh of altitude
+
+      REAL     tetagdiv, tetagrot,  tetatemp, coefdis
+
+!
+! ... Les parametres de ce common comdissnew sont  lues par defrun_new 
+!              sur le fichier  run.def    ....
+!
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom.h	(revision 3815)
@@ -0,0 +1,33 @@
+!
+! $Header$
+!
+!CDK comgeom
+      COMMON/comgeom/                                                   &
+     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
+     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
+     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
+     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
+     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
+     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
+     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
+     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
+     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
+     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
+     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
+     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
+     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
+     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
+     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
+     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
+
+!
+        REAL                                                            &
+     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
+     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
+     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
+     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
+     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
+     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
+     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
+     & , xprimv
+!
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom2.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom2.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comgeom2.h	(revision 3815)
@@ -0,0 +1,33 @@
+!
+! $Header$
+!
+!CDK comgeom2
+      COMMON/comgeom/                                                   &
+     & cu(iip1,jjp1),cv(iip1,jjm),unscu2(iip1,jjp1),unscv2(iip1,jjm)  , &
+     & aire(iip1,jjp1),airesurg(iip1,jjp1),aireu(iip1,jjp1)           , &
+     & airev(iip1,jjm),unsaire(iip1,jjp1),apoln,apols                 , &
+     & unsairez(iip1,jjm),airuscv2(iip1,jjm),airvscu2(iip1,jjm)       , &
+     & aireij1(iip1,jjp1),aireij2(iip1,jjp1),aireij3(iip1,jjp1)       , &
+     & aireij4(iip1,jjp1),alpha1(iip1,jjp1),alpha2(iip1,jjp1)         , &
+     & alpha3(iip1,jjp1),alpha4(iip1,jjp1),alpha1p2(iip1,jjp1)        , &
+     & alpha1p4(iip1,jjp1),alpha2p3(iip1,jjp1),alpha3p4(iip1,jjp1)    , &
+     & fext(iip1,jjm),constang(iip1,jjp1), rlatu(jjp1),rlatv(jjm),      &
+     & rlonu(iip1),rlonv(iip1),cuvsurcv(iip1,jjm),cvsurcuv(iip1,jjm)  , &
+     & cvusurcu(iip1,jjp1),cusurcvu(iip1,jjp1)                        , &
+     & cuvscvgam1(iip1,jjm),cuvscvgam2(iip1,jjm),cvuscugam1(iip1,jjp1), &
+     & cvuscugam2(iip1,jjp1),cvscuvgam(iip1,jjm),cuscvugam(iip1,jjp1) , &
+     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2                , &
+     & unsair_gam1(iip1,jjp1),unsair_gam2(iip1,jjp1)                  , &
+     & unsairz_gam(iip1,jjm),aivscu2gam(iip1,jjm),aiuscv2gam(iip1,jjm)  &
+     & , xprimu(iip1),xprimv(iip1)
+
+
+      REAL                                                               &
+     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,apoln,apols,unsaire &
+     & ,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4     , &
+     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 , &
+     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     , &
+     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1           , &
+     & unsapolnga2,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2     , &
+     & unsairz_gam,aivscu2gam,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu    , &
+     & cusurcvu,xprimu,xprimv
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comvert.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comvert.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/comvert.h	(revision 3815)
@@ -0,0 +1,38 @@
+!
+! $Id: comvert.h 1952 2014-01-28 13:05:47Z lguez $
+!
+!-----------------------------------------------------------------------
+!   INCLUDE 'comvert.h'
+
+      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
+     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
+     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
+
+      common/comverti/disvert_type, pressure_exner
+
+      real ap     ! hybrid pressure contribution at interlayers
+      real bp     ! hybrid sigma contribution at interlayer
+      real presnivs ! (reference) pressure at mid-layers
+      real dpres
+      real pa     ! reference pressure (Pa) at which hybrid coordinates
+                  ! become purely pressure
+      real preff  ! reference surface pressure (Pa)
+      real nivsigs
+      real nivsig
+      real aps    ! hybrid pressure contribution at mid-layers
+      real bps    ! hybrid sigma contribution at mid-layers
+      real scaleheight ! atmospheric (reference) scale height (km)
+      real pseudoalt ! pseudo-altitude of model levels (km), based on presnivs(),
+                     ! preff and scaleheight
+
+      integer disvert_type ! type of vertical discretization:
+                           ! 1: Earth (default for planet_type==earth),
+                           !     automatic generation
+                           ! 2: Planets (default for planet_type!=earth),
+                           !     using 'z2sig.def' (or 'esasig.def) file
+
+      logical pressure_exner
+!     compute pressure inside layers using Exner function, else use mean
+!     of pressure values at interfaces
+
+ !-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/conf_gcm.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/conf_gcm.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/conf_gcm.F90	(revision 3815)
@@ -0,0 +1,896 @@
+
+! $Id: conf_gcm.F90 2247 2015-03-25 17:24:15Z lguez $
+
+SUBROUTINE conf_gcm( tapedef, etatinit )
+
+  USE control_mod
+#ifdef CPP_IOIPSL
+  use IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  use ioipsl_getincom
+#endif
+  USE infotrac, ONLY : type_trac
+  use assert_m, only: assert
+
+  IMPLICIT NONE
+  !-----------------------------------------------------------------------
+  !     Auteurs :   L. Fairhead , P. Le Van  .
+
+  !     Arguments :
+
+  !     tapedef   :
+  !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
+  !     -metres  du zoom  avec  celles lues sur le fichier start .
+
+  LOGICAL,INTENT(IN) :: etatinit
+  INTEGER,INTENT(IN) :: tapedef
+
+  !   Declarations :
+  !   --------------
+  include "dimensions.h"
+  include "paramet.h"
+  include "logic.h"
+  include "serre.h"
+  include "comdissnew.h"
+  include "temps.h"
+  include "comconst.h"
+  include "iniprint.h"
+
+  !   local:
+  !   ------
+
+  CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+  REAL clonn,clatt,grossismxx,grossismyy
+  REAL dzoomxx,dzoomyy, tauxx,tauyy
+  LOGICAL  fxyhypbb, ysinuss
+  INTEGER i
+
+  !  -------------------------------------------------------------------
+
+  !       .........     Version  du 29/04/97       ..........
+
+  !   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
+  !      tetatemp   ajoutes  pour la dissipation   .
+
+  !   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb ** 
+
+  !  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
+  !    Sinon , choix de fxynew  , a derivee sinusoidale  ..
+
+  !   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
+  !         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
+  !                de limit.dat ( dic)                        ...........
+  !           Sinon  etatinit = . FALSE .
+
+  !   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
+  !    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
+  !   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
+  !    lectba .  
+  !   Ces parmetres definissant entre autres la grille et doivent etre
+  !   pareils et coherents , sinon il y aura  divergence du gcm .
+
+  !-----------------------------------------------------------------------
+  !   initialisations:
+  !   ----------------
+
+  !Config  Key  = lunout
+  !Config  Desc = unite de fichier pour les impressions
+  !Config  Def  = 6
+  !Config  Help = unite de fichier pour les impressions 
+  !Config         (defaut sortie standard = 6)
+  lunout=6
+  CALL getin('lunout', lunout)
+  IF (lunout /= 5 .and. lunout /= 6) THEN
+     OPEN(UNIT=lunout,FILE='lmdz.out',ACTION='write',                      &
+          STATUS='unknown',FORM='formatted')
+  ENDIF
+
+  !Config  Key  = prt_level
+  !Config  Desc = niveau d'impressions de d\'ebogage
+  !Config  Def  = 0
+  !Config  Help = Niveau d'impression pour le d\'ebogage
+  !Config         (0 = minimum d'impression)
+  prt_level = 0
+  CALL getin('prt_level',prt_level)
+
+  !-----------------------------------------------------------------------
+  !  Parametres de controle du run:
+  !-----------------------------------------------------------------------
+  !Config  Key  = planet_type
+  !Config  Desc = planet type ("earth", "mars", "venus", ...)
+  !Config  Def  = earth
+  !Config  Help = this flag sets the type of atymosphere that is considered
+  planet_type="earth"
+  CALL getin('planet_type',planet_type)
+
+  !Config  Key  = calend
+  !Config  Desc = type de calendrier utilise
+  !Config  Def  = earth_360d
+  !Config  Help = valeur possible: earth_360d, earth_365d, earth_366d
+  !Config         
+  calend = 'earth_360d'
+  CALL getin('calend', calend)
+
+  !Config  Key  = dayref
+  !Config  Desc = Jour de l'etat initial
+  !Config  Def  = 1
+  !Config  Help = Jour de l'etat initial ( = 350  si 20 Decembre ,
+  !Config         par expl. ,comme ici ) ... A completer
+  dayref=1
+  CALL getin('dayref', dayref)
+
+  !Config  Key  = anneeref
+  !Config  Desc = Annee de l'etat initial
+  !Config  Def  = 1998
+  !Config  Help = Annee de l'etat  initial 
+  !Config         (   avec  4  chiffres   ) ... A completer
+  anneeref = 1998
+  CALL getin('anneeref',anneeref)
+
+  !Config  Key  = raz_date
+  !Config  Desc = Remise a zero de la date initiale
+  !Config  Def  = 0 (pas de remise a zero)
+  !Config  Help = Remise a zero de la date initiale 
+  !Config         0 pas de remise a zero, on garde la date du fichier restart
+  !Config         1 prise en compte de la date de gcm.def avec remise a zero
+  !Config         des compteurs de pas de temps
+  raz_date = 0
+  CALL getin('raz_date', raz_date)
+
+  !Config  Key  = resetvarc
+  !Config  Desc = Reinit des variables de controle
+  !Config  Def  = n
+  !Config  Help = Reinit des variables de controle
+  resetvarc = .false.
+  CALL getin('resetvarc',resetvarc)
+
+  !Config  Key  = nday
+  !Config  Desc = Nombre de jours d'integration
+  !Config  Def  = 10
+  !Config  Help = Nombre de jours d'integration
+  !Config         ... On pourait aussi permettre des mois ou des annees !
+  nday = 10
+  CALL getin('nday',nday)
+
+  !Config  Key  = starttime
+  !Config  Desc = Heure de depart de la simulation
+  !Config  Def  = 0
+  !Config  Help = Heure de depart de la simulation
+  !Config         en jour
+  starttime = 0
+  CALL getin('starttime',starttime)
+
+  !Config  Key  = day_step
+  !Config  Desc = nombre de pas par jour
+  !Config  Def  = 240 
+  !Config  Help = nombre de pas par jour (multiple de iperiod) (
+  !Config          ici pour  dt = 1 min ) 
+  day_step = 240 
+  CALL getin('day_step',day_step)
+
+  !Config  Key  = nsplit_phys
+  nsplit_phys = 1 
+  CALL getin('nsplit_phys',nsplit_phys)
+
+  !Config  Key  = iperiod
+  !Config  Desc = periode pour le pas Matsuno
+  !Config  Def  = 5
+  !Config  Help = periode pour le pas Matsuno (en pas de temps)
+  iperiod = 5
+  CALL getin('iperiod',iperiod)
+
+  !Config  Key  = iapp_tracvl
+  !Config  Desc = frequence du groupement des flux 
+  !Config  Def  = iperiod
+  !Config  Help = frequence du groupement des flux (en pas de temps) 
+  iapp_tracvl = iperiod
+  CALL getin('iapp_tracvl',iapp_tracvl)
+
+  !Config  Key  = iconser
+  !Config  Desc = periode de sortie des variables de controle
+  !Config  Def  = 240  
+  !Config  Help = periode de sortie des variables de controle
+  !Config         (En pas de temps)
+  iconser = 240  
+  CALL getin('iconser', iconser)
+
+  !Config  Key  = iecri
+  !Config  Desc = periode d'ecriture du fichier histoire
+  !Config  Def  = 1
+  !Config  Help = periode d'ecriture du fichier histoire (en jour) 
+  iecri = 1
+  CALL getin('iecri',iecri)
+
+  !Config  Key  = periodav
+  !Config  Desc = periode de stockage fichier histmoy
+  !Config  Def  = 1
+  !Config  Help = periode de stockage fichier histmoy (en jour) 
+  periodav = 1.
+  CALL getin('periodav',periodav)
+
+  !Config  Key  = output_grads_dyn
+  !Config  Desc = output dynamics diagnostics in 'dyn.dat' file
+  !Config  Def  = n
+  !Config  Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file
+  output_grads_dyn=.false.
+  CALL getin('output_grads_dyn',output_grads_dyn)
+
+  !Config  Key  = dissip_period
+  !Config  Desc = periode de la dissipation 
+  !Config  Def  = 0
+  !Config  Help = periode de la dissipation 
+  !Config  dissip_period=0 => la valeur sera calcule dans inidissip       
+  !Config  dissip_period>0 => on prend cette valeur
+  dissip_period = 0
+  CALL getin('dissip_period',dissip_period)
+
+  !cc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+  !cc
+
+  !Config  Key  = lstardis
+  !Config  Desc = choix de l'operateur de dissipation
+  !Config  Def  = y
+  !Config  Help = choix de l'operateur de dissipation
+  !Config         'y' si on veut star et 'n' si on veut non-start !
+  !Config         Moi y en a pas comprendre ! 
+  lstardis = .TRUE.
+  CALL getin('lstardis',lstardis)
+
+  !Config  Key  = nitergdiv
+  !Config  Desc = Nombre d'iteration de gradiv
+  !Config  Def  = 1
+  !Config  Help = nombre d'iterations de l'operateur de dissipation 
+  !Config         gradiv
+  nitergdiv = 1
+  CALL getin('nitergdiv',nitergdiv)
+
+  !Config  Key  = nitergrot
+  !Config  Desc = nombre d'iterations de nxgradrot
+  !Config  Def  = 2
+  !Config  Help = nombre d'iterations de l'operateur de dissipation  
+  !Config         nxgradrot
+  nitergrot = 2
+  CALL getin('nitergrot',nitergrot)
+
+  !Config  Key  = niterh
+  !Config  Desc = nombre d'iterations de divgrad
+  !Config  Def  = 2
+  !Config  Help = nombre d'iterations de l'operateur de dissipation
+  !Config         divgrad
+  niterh = 2
+  CALL getin('niterh',niterh)
+
+  !Config  Key  = tetagdiv
+  !Config  Desc = temps de dissipation pour div
+  !Config  Def  = 7200
+  !Config  Help = temps de dissipation des plus petites longeur 
+  !Config         d'ondes pour u,v (gradiv)
+  tetagdiv = 7200.
+  CALL getin('tetagdiv',tetagdiv)
+
+  !Config  Key  = tetagrot
+  !Config  Desc = temps de dissipation pour grad
+  !Config  Def  = 7200
+  !Config  Help = temps de dissipation des plus petites longeur 
+  !Config         d'ondes pour u,v (nxgradrot)
+  tetagrot = 7200.
+  CALL getin('tetagrot',tetagrot)
+
+  !Config  Key  = tetatemp 
+  !Config  Desc = temps de dissipation pour h
+  !Config  Def  = 7200
+  !Config  Help =  temps de dissipation des plus petites longeur 
+  !Config         d'ondes pour h (divgrad)   
+  tetatemp  = 7200.
+  CALL getin('tetatemp',tetatemp )
+
+  ! Parametres controlant la variation sur la verticale des constantes de
+  ! dissipation.
+  ! Pour le moment actifs uniquement dans la version a 39 niveaux
+  ! avec ok_strato=y
+
+  dissip_factz=4.
+  dissip_deltaz=10.
+  dissip_zref=30.
+  CALL getin('dissip_factz',dissip_factz )
+  CALL getin('dissip_deltaz',dissip_deltaz )
+  CALL getin('dissip_zref',dissip_zref )
+
+  ! top_bound sponge: only active if ok_strato=.true. and iflag_top_bound!=0
+  !                   iflag_top_bound=0 for no sponge
+  !                   iflag_top_bound=1 for sponge over 4 topmost layers
+  !                   iflag_top_bound=2 for sponge from top to ~1% of top layer pressure
+  iflag_top_bound=1
+  CALL getin('iflag_top_bound',iflag_top_bound)
+
+  ! mode_top_bound : fields towards which sponge relaxation will be done:
+  !                  mode_top_bound=0: no relaxation
+  !                  mode_top_bound=1: u and v relax towards 0
+  !                  mode_top_bound=2: u and v relax towards their zonal mean
+  !                  mode_top_bound=3: u,v and pot. temp. relax towards their zonal mean
+  mode_top_bound=3
+  CALL getin('mode_top_bound',mode_top_bound)
+
+  ! top_bound sponge : inverse of charactericstic relaxation time scale for sponge
+  tau_top_bound=1.e-5
+  CALL getin('tau_top_bound',tau_top_bound)
+
+  !Config  Key  = coefdis
+  !Config  Desc = coefficient pour gamdissip
+  !Config  Def  = 0
+  !Config  Help = coefficient pour gamdissip  
+  coefdis = 0.
+  CALL getin('coefdis',coefdis)
+
+  !Config  Key  = purmats
+  !Config  Desc = Schema d'integration
+  !Config  Def  = n
+  !Config  Help = Choix du schema d'integration temporel.
+  !Config         y = pure Matsuno sinon c'est du Matsuno-leapfrog
+  purmats = .FALSE.
+  CALL getin('purmats',purmats)
+
+  !Config  Key  = ok_guide
+  !Config  Desc = Guidage
+  !Config  Def  = n
+  !Config  Help = Guidage
+  ok_guide = .FALSE.
+  CALL getin('ok_guide',ok_guide)
+
+  !Config  Key  =  read_start
+  !Config  Desc = Initialize model using a 'start.nc' file
+  !Config  Def  = y
+  !Config  Help = y: intialize dynamical fields using a 'start.nc' file
+  !               n: fields are initialized by 'iniacademic' routine
+  read_start= .true.
+  CALL getin('read_start',read_start)
+
+  !Config  Key  = iflag_phys
+  !Config  Desc = Avec ls physique 
+  !Config  Def  = 1
+  !Config  Help = Permet de faire tourner le modele sans 
+  !Config         physique.
+  iflag_phys = 1
+  CALL getin('iflag_phys',iflag_phys)
+
+  !Config  Key  =  iphysiq
+  !Config  Desc = Periode de la physique
+  !Config  Def  = 5
+  !Config  Help = Periode de la physique en pas de temps de la dynamique.
+  iphysiq = 5
+  CALL getin('iphysiq', iphysiq)
+
+  !Config  Key  = ip_ebil_dyn
+  !Config  Desc = PRINT level for energy conserv. diag.
+  !Config  Def  = 0
+  !Config  Help = PRINT level for energy conservation diag. ;
+  !               les options suivantes existent :
+  !Config         0 pas de print
+  !Config         1 pas de print
+  !Config         2 print,
+  ip_ebil_dyn = 0
+  CALL getin('ip_ebil_dyn',ip_ebil_dyn)
+
+  !cc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
+  !     .........   (  modif  le 17/04/96 )   .........
+
+  test_etatinit: IF (.not. etatinit) then
+     !Config  Key  = clon
+     !Config  Desc = centre du zoom, longitude
+     !Config  Def  = 0
+     !Config  Help = longitude en degres du centre 
+     !Config         du zoom
+     clonn = 0.
+     CALL getin('clon',clonn)
+
+     !Config  Key  = clat
+     !Config  Desc = centre du zoom, latitude
+     !Config  Def  = 0
+     !Config  Help = latitude en degres du centre du zoom
+     !Config         
+     clatt = 0.
+     CALL getin('clat',clatt)
+
+     IF( ABS(clat - clatt).GE. 0.001 )  THEN
+        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def', &
+             ' est differente de celle lue sur le fichier  start '
+        STOP
+     ENDIF
+
+     !Config  Key  = grossismx 
+     !Config  Desc = zoom en longitude
+     !Config  Def  = 1.0
+     !Config  Help = facteur de grossissement du zoom,
+     !Config         selon la longitude
+     grossismxx = 1.0
+     CALL getin('grossismx',grossismxx)
+
+     IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
+        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ', &
+             'run.def est differente de celle lue sur le fichier  start '
+        STOP
+     ENDIF
+
+     !Config  Key  = grossismy
+     !Config  Desc = zoom en latitude
+     !Config  Def  = 1.0
+     !Config  Help = facteur de grossissement du zoom,
+     !Config         selon la latitude
+     grossismyy = 1.0
+     CALL getin('grossismy',grossismyy)
+
+     IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
+        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ', &
+             'run.def est differente de celle lue sur le fichier  start '
+        STOP
+     ENDIF
+
+     IF( grossismx.LT.1. )  THEN
+        write(lunout,*) &
+             'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
+        STOP
+     ELSE
+        alphax = 1. - 1./ grossismx
+     ENDIF
+
+     IF( grossismy.LT.1. )  THEN
+        write(lunout,*) &
+             'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
+        STOP
+     ELSE
+        alphay = 1. - 1./ grossismy
+     ENDIF
+
+     write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
+
+     !    alphax et alphay sont les anciennes formulat. des grossissements
+
+     !Config  Key  = fxyhypb
+     !Config  Desc = Fonction  hyperbolique
+     !Config  Def  = y
+     !Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+     !Config         sinon  sinusoidale
+     fxyhypbb = .TRUE.
+     CALL getin('fxyhypb',fxyhypbb)
+
+     IF( .NOT.fxyhypb )  THEN
+        IF( fxyhypbb )     THEN
+           write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+           write(lunout,*)' *** fxyhypb lu sur le fichier start est ', &
+                'F alors  qu il est  T  sur  run.def  ***'
+           STOP
+        ENDIF
+     ELSE
+        IF( .NOT.fxyhypbb )   THEN
+           write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+           write(lunout,*)' ***  fxyhypb lu sur le fichier start est ', &
+                'T alors  qu il est  F  sur  run.def  ****  '
+           STOP
+        ENDIF
+     ENDIF
+
+     !Config  Key  = dzoomx
+     !Config  Desc = extension en longitude
+     !Config  Def  = 0
+     !Config  Help = extension en longitude  de la zone du zoom  
+     !Config         ( fraction de la zone totale)
+     dzoomxx = 0.0
+     CALL getin('dzoomx',dzoomxx)
+
+     IF( fxyhypb )  THEN
+        IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+           write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ', &
+                'run.def est differente de celle lue sur le fichier  start '
+           STOP
+        ENDIF
+     ENDIF
+
+     !Config  Key  = dzoomy
+     !Config  Desc = extension en latitude
+     !Config  Def  = 0
+     !Config  Help = extension en latitude de la zone  du zoom  
+     !Config         ( fraction de la zone totale)
+     dzoomyy = 0.0
+     CALL getin('dzoomy',dzoomyy)
+
+     IF( fxyhypb )  THEN
+        IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
+           write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ', &
+                'run.def est differente de celle lue sur le fichier  start '
+           STOP
+        ENDIF
+     ENDIF
+
+     !Config  Key  = taux
+     !Config  Desc = raideur du zoom en  X
+     !Config  Def  = 3
+     !Config  Help = raideur du zoom en  X
+     tauxx = 3.0
+     CALL getin('taux',tauxx)
+
+     IF( fxyhypb )  THEN
+        IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+           write(lunout,*)'conf_gcm: La valeur de taux passee par ', &
+                'run.def est differente de celle lue sur le fichier  start '
+           STOP
+        ENDIF
+     ENDIF
+
+     !Config  Key  = tauyy
+     !Config  Desc = raideur du zoom en  Y
+     !Config  Def  = 3
+     !Config  Help = raideur du zoom en  Y
+     tauyy = 3.0
+     CALL getin('tauy',tauyy)
+
+     IF( fxyhypb )  THEN
+        IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+           write(lunout,*)'conf_gcm: La valeur de tauy passee par ', &
+                'run.def est differente de celle lue sur le fichier  start '
+           STOP
+        ENDIF
+     ENDIF
+
+     !c
+     IF( .NOT.fxyhypb  )  THEN
+
+        !Config  Key  = ysinus
+        !Config  IF   = !fxyhypb
+        !Config  Desc = Fonction en Sinus
+        !Config  Def  = y
+        !Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+        !Config         sinon y = latit.
+        ysinuss = .TRUE.
+        CALL getin('ysinus',ysinuss)
+
+        IF( .NOT.ysinus )  THEN
+           IF( ysinuss )     THEN
+              write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+              write(lunout,*)' *** ysinus lu sur le fichier start est F', &
+                   ' alors  qu il est  T  sur  run.def  ***'
+              STOP
+           ENDIF
+        ELSE
+           IF( .NOT.ysinuss )   THEN
+              write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
+              write(lunout,*)' *** ysinus lu sur le fichier start est T', &
+                   ' alors  qu il est  F  sur  run.def  ****  '
+              STOP
+           ENDIF
+        ENDIF
+     ENDIF ! of IF( .NOT.fxyhypb  )
+
+     !Config  Key  = offline
+     !Config  Desc = Nouvelle eau liquide
+     !Config  Def  = n
+     !Config  Help = Permet de mettre en route la
+     !Config         nouvelle parametrisation de l'eau liquide !
+     offline = .FALSE.
+     CALL getin('offline',offline)
+
+     !Config  Key  = type_trac
+     !Config  Desc = Choix de couplage avec model de chimie INCA ou REPROBUS
+     !Config  Def  = lmdz
+     !Config  Help = 
+     !Config         'lmdz' = pas de couplage, pur LMDZ
+     !Config         'inca' = model de chime INCA 
+     !Config         'repr' = model de chime REPROBUS
+     type_trac = 'lmdz'
+     CALL getin('type_trac',type_trac)
+
+     !Config  Key  = config_inca
+     !Config  Desc = Choix de configuration de INCA
+     !Config  Def  = none
+     !Config  Help = Choix de configuration de INCA :
+     !Config         'none' = sans INCA
+     !Config         'chem' = INCA avec calcul de chemie
+     !Config         'aero' = INCA avec calcul des aerosols 
+     config_inca = 'none'
+     CALL getin('config_inca',config_inca)
+
+     !Config  Key  = ok_dynzon 
+     !Config  Desc = calcul et sortie des transports 
+     !Config  Def  = n 
+     !Config  Help = Permet de mettre en route le calcul des transports 
+     !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) 
+
+     write(lunout,*)' #########################################'
+     write(lunout,*)' Configuration des parametres du gcm: '
+     write(lunout,*)' planet_type = ', planet_type
+     write(lunout,*)' calend = ', calend
+     write(lunout,*)' dayref = ', dayref
+     write(lunout,*)' anneeref = ', anneeref
+     write(lunout,*)' nday = ', nday
+     write(lunout,*)' day_step = ', day_step
+     write(lunout,*)' iperiod = ', iperiod
+     write(lunout,*)' nsplit_phys = ', nsplit_phys
+     write(lunout,*)' iconser = ', iconser
+     write(lunout,*)' iecri = ', iecri
+     write(lunout,*)' periodav = ', periodav 
+     write(lunout,*)' output_grads_dyn = ', output_grads_dyn
+     write(lunout,*)' dissip_period = ', dissip_period
+     write(lunout,*)' lstardis = ', lstardis
+     write(lunout,*)' nitergdiv = ', nitergdiv
+     write(lunout,*)' nitergrot = ', nitergrot
+     write(lunout,*)' niterh = ', niterh
+     write(lunout,*)' tetagdiv = ', tetagdiv
+     write(lunout,*)' tetagrot = ', tetagrot
+     write(lunout,*)' tetatemp = ', tetatemp
+     write(lunout,*)' coefdis = ', coefdis
+     write(lunout,*)' purmats = ', purmats
+     write(lunout,*)' read_start = ', read_start
+     write(lunout,*)' iflag_phys = ', iflag_phys
+     write(lunout,*)' iphysiq = ', iphysiq
+     write(lunout,*)' clonn = ', clonn 
+     write(lunout,*)' clatt = ', clatt
+     write(lunout,*)' grossismx = ', grossismx
+     write(lunout,*)' grossismy = ', grossismy
+     write(lunout,*)' fxyhypbb = ', fxyhypbb
+     write(lunout,*)' dzoomxx = ', dzoomxx
+     write(lunout,*)' dzoomy = ', dzoomyy
+     write(lunout,*)' tauxx = ', tauxx
+     write(lunout,*)' tauyy = ', tauyy
+     write(lunout,*)' offline = ', offline
+     write(lunout,*)' type_trac = ', type_trac
+     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 
+  else
+     !Config  Key  = clon
+     !Config  Desc = centre du zoom, longitude
+     !Config  Def  = 0
+     !Config  Help = longitude en degres du centre 
+     !Config         du zoom
+     clon = 0.
+     CALL getin('clon',clon)
+
+     !Config  Key  = clat
+     !Config  Desc = centre du zoom, latitude
+     !Config  Def  = 0
+     !Config  Help = latitude en degres du centre du zoom
+     !Config         
+     clat = 0.
+     CALL getin('clat',clat)
+
+     !Config  Key  = grossismx 
+     !Config  Desc = zoom en longitude
+     !Config  Def  = 1.0
+     !Config  Help = facteur de grossissement du zoom,
+     !Config         selon la longitude
+     grossismx = 1.0
+     CALL getin('grossismx',grossismx)
+
+     !Config  Key  = grossismy
+     !Config  Desc = zoom en latitude
+     !Config  Def  = 1.0
+     !Config  Help = facteur de grossissement du zoom,
+     !Config         selon la latitude
+     grossismy = 1.0
+     CALL getin('grossismy',grossismy)
+
+     IF( grossismx.LT.1. )  THEN
+        write(lunout,*) &
+             'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
+        STOP
+     ELSE
+        alphax = 1. - 1./ grossismx
+     ENDIF
+
+     IF( grossismy.LT.1. )  THEN
+        write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** '
+        STOP
+     ELSE
+        alphay = 1. - 1./ grossismy
+     ENDIF
+
+     write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
+
+     !    alphax et alphay sont les anciennes formulat. des grossissements
+
+     !Config  Key  = fxyhypb
+     !Config  Desc = Fonction  hyperbolique
+     !Config  Def  = y
+     !Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+     !Config         sinon  sinusoidale
+     fxyhypb = .TRUE.
+     CALL getin('fxyhypb',fxyhypb)
+
+     !Config  Key  = dzoomx
+     !Config  Desc = extension en longitude
+     !Config  Def  = 0
+     !Config  Help = extension en longitude  de la zone du zoom  
+     !Config         ( fraction de la zone totale)
+     dzoomx = 0.2
+     CALL getin('dzoomx',dzoomx)
+     call assert(dzoomx < 1, "conf_gcm: dzoomx must be < 1")
+
+     !Config  Key  = dzoomy
+     !Config  Desc = extension en latitude
+     !Config  Def  = 0
+     !Config  Help = extension en latitude de la zone  du zoom  
+     !Config         ( fraction de la zone totale)
+     dzoomy = 0.2
+     CALL getin('dzoomy',dzoomy)
+     call assert(dzoomy < 1, "conf_gcm: dzoomy must be < 1")
+
+     !Config  Key  = taux
+     !Config  Desc = raideur du zoom en  X
+     !Config  Def  = 3
+     !Config  Help = raideur du zoom en  X
+     taux = 3.0
+     CALL getin('taux',taux)
+
+     !Config  Key  = tauy
+     !Config  Desc = raideur du zoom en  Y
+     !Config  Def  = 3
+     !Config  Help = raideur du zoom en  Y
+     tauy = 3.0
+     CALL getin('tauy',tauy)
+
+     !Config  Key  = ysinus
+     !Config  IF   = !fxyhypb
+     !Config  Desc = Fonction en Sinus
+     !Config  Def  = y
+     !Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+     !Config         sinon y = latit.
+     ysinus = .TRUE.
+     CALL getin('ysinus',ysinus)
+
+     !Config  Key  = offline
+     !Config  Desc = Nouvelle eau liquide
+     !Config  Def  = n
+     !Config  Help = Permet de mettre en route la
+     !Config         nouvelle parametrisation de l'eau liquide !
+     offline = .FALSE.
+     CALL getin('offline',offline)
+
+     !Config  Key  = type_trac
+     !Config  Desc = Choix de couplage avec model de chimie INCA ou REPROBUS
+     !Config  Def  = lmdz
+     !Config  Help = 
+     !Config         'lmdz' = pas de couplage, pur LMDZ
+     !Config         'inca' = model de chime INCA 
+     !Config         'repr' = model de chime REPROBUS
+     type_trac = 'lmdz'
+     CALL getin('type_trac',type_trac)
+
+     !Config  Key  = config_inca
+     !Config  Desc = Choix de configuration de INCA
+     !Config  Def  = none
+     !Config  Help = Choix de configuration de INCA :
+     !Config         'none' = sans INCA
+     !Config         'chem' = INCA avec calcul de chemie
+     !Config         'aero' = INCA avec calcul des aerosols 
+     config_inca = 'none'
+     CALL getin('config_inca',config_inca)
+
+     !Config  Key  = ok_dynzon 
+     !Config  Desc = sortie des transports zonaux dans la dynamique
+     !Config  Def  = n 
+     !Config  Help = Permet de mettre en route le calcul des transports 
+     !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
+     !Config  Desc = activation de la version strato
+     !Config  Def  = .FALSE.
+     !Config  Help = active la version stratosph\'erique de LMDZ de F. Lott
+
+     ok_strato=.FALSE.
+     CALL getin('ok_strato',ok_strato)
+
+     vert_prof_dissip = merge(1, 0, ok_strato .and. llm==39)
+     CALL getin('vert_prof_dissip', vert_prof_dissip)
+     call assert(vert_prof_dissip == 0 .or. vert_prof_dissip ==  1, &
+          "bad value for vert_prof_dissip")
+
+     !Config  Key  = ok_gradsfile
+     !Config  Desc = activation des sorties grads du guidage
+     !Config  Def  = n
+     !Config  Help = active les sorties grads du guidage
+
+     ok_gradsfile = .FALSE.
+     CALL getin('ok_gradsfile',ok_gradsfile)
+
+     !Config  Key  = ok_limit
+     !Config  Desc = creation des fichiers limit dans create_etat0_limit
+     !Config  Def  = y
+     !Config  Help = production du fichier limit.nc requise
+
+     ok_limit = .TRUE.
+     CALL getin('ok_limit',ok_limit)
+
+     !Config  Key  = ok_etat0
+     !Config  Desc = creation des fichiers etat0 dans create_etat0_limit
+     !Config  Def  = y
+     !Config  Help = production des fichiers start.nc, startphy.nc requise
+
+     ok_etat0 = .TRUE.
+     CALL getin('ok_etat0',ok_etat0)
+
+     write(lunout,*)' #########################################'
+     write(lunout,*)' Configuration des parametres de cel0' &
+          //'_limit: '
+     write(lunout,*)' planet_type = ', planet_type
+     write(lunout,*)' calend = ', calend
+     write(lunout,*)' dayref = ', dayref
+     write(lunout,*)' anneeref = ', anneeref
+     write(lunout,*)' nday = ', nday
+     write(lunout,*)' day_step = ', day_step
+     write(lunout,*)' iperiod = ', iperiod
+     write(lunout,*)' iconser = ', iconser
+     write(lunout,*)' iecri = ', iecri
+     write(lunout,*)' periodav = ', periodav 
+     write(lunout,*)' output_grads_dyn = ', output_grads_dyn
+     write(lunout,*)' dissip_period = ', dissip_period
+     write(lunout,*)' lstardis = ', lstardis
+     write(lunout,*)' nitergdiv = ', nitergdiv
+     write(lunout,*)' nitergrot = ', nitergrot
+     write(lunout,*)' niterh = ', niterh
+     write(lunout,*)' tetagdiv = ', tetagdiv
+     write(lunout,*)' tetagrot = ', tetagrot
+     write(lunout,*)' tetatemp = ', tetatemp
+     write(lunout,*)' coefdis = ', coefdis
+     write(lunout,*)' purmats = ', purmats
+     write(lunout,*)' read_start = ', read_start
+     write(lunout,*)' iflag_phys = ', iflag_phys
+     write(lunout,*)' iphysiq = ', iphysiq
+     write(lunout,*)' clon = ', clon
+     write(lunout,*)' clat = ', clat
+     write(lunout,*)' grossismx = ', grossismx
+     write(lunout,*)' grossismy = ', grossismy
+     write(lunout,*)' fxyhypb = ', fxyhypb
+     write(lunout,*)' dzoomx = ', dzoomx
+     write(lunout,*)' dzoomy = ', dzoomy
+     write(lunout,*)' taux = ', taux
+     write(lunout,*)' tauy = ', tauy
+     write(lunout,*)' offline = ', offline
+     write(lunout,*)' type_trac = ', type_trac
+     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
+     write(lunout,*)' ok_limit = ', ok_limit
+     write(lunout,*)' ok_etat0 = ', ok_etat0
+  end IF test_etatinit
+
+END SUBROUTINE conf_gcm
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/control_mod.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/control_mod.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/control_mod.F90	(revision 3815)
@@ -0,0 +1,42 @@
+!
+! $Id $
+!
+
+MODULE control_mod
+
+! LF 01/2010
+! Remplacement du fichier et common control
+
+  IMPLICIT NONE
+
+  REAL,SAVE :: periodav
+  REAL,SAVE :: starttime
+  INTEGER,SAVE :: nday ! # of days to run
+  INTEGER,SAVE :: day_step ! # of dynamical time steps per day
+  INTEGER,SAVE :: iperiod ! make a Matsuno step before avery iperiod-1 LF steps
+  INTEGER,SAVE :: iapp_tracvl ! apply (cumulated) traceur advection every
+                              ! iapp_tracvl dynamical steps
+  INTEGER,SAVE :: nsplit_phys ! number of sub-cycle steps in call to physics
+  INTEGER,SAVE :: iconser
+  INTEGER,SAVE :: iecri
+  INTEGER,SAVE :: dissip_period ! apply dissipation every dissip_period
+                                ! dynamical step
+  INTEGER,SAVE :: iphysiq ! call physics every iphysiq dynamical steps
+  INTEGER,SAVE :: iecrimoy
+  INTEGER,SAVE :: dayref
+  INTEGER,SAVE :: anneeref ! reference year #
+  INTEGER,SAVE :: raz_date
+  INTEGER,SAVE :: ip_ebil_dyn
+  LOGICAL,SAVE :: offline
+  CHARACTER(len=4),SAVE :: config_inca
+  CHARACTER(len=10),SAVE :: planet_type ! planet type ('earth','mars',...)
+  LOGICAL,SAVE :: output_grads_dyn ! output dynamics diagnostics in
+                                   ! binary grads file 'dyn.dat' (y/n)
+  LOGICAL,SAVE :: ok_dynzon  ! output zonal transports in dynzon.nc file
+  LOGICAL,SAVE ::  ok_dyn_ins ! output instantaneous values of fields
+                              ! in the dynamics in NetCDF files dyn_hist*nc
+  LOGICAL,SAVE :: ok_dyn_ave ! output averaged values of fields in the dynamics
+                             ! in NetCDF files dyn_hist*ave.nc
+  LOGICAL,SAVE :: resetvarc  ! allows to reset the variables in sortvarc
+
+END MODULE
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/disvert.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/disvert.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/disvert.F90	(revision 3815)
@@ -0,0 +1,455 @@
+! $Id: disvert.F90 2153 2014-11-24 15:18:11Z lguez $
+
+SUBROUTINE disvert()
+
+#ifdef CPP_IOIPSL
+  use ioipsl, only: getin
+#else
+  USE ioipsl_getincom, only: getin
+#endif
+  use new_unit_m, only: new_unit
+  use assert_m, only: assert
+
+  IMPLICIT NONE
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comvert.h"
+  include "comconst.h"
+  include "iniprint.h"
+  include "logic.h"
+
+!-------------------------------------------------------------------------------
+! Purpose: Vertical distribution functions for LMDZ.
+!          Triggered by the levels number llm.
+!-------------------------------------------------------------------------------
+! Read    in "comvert.h":
+
+! pa !--- vertical coordinate is close to a PRESSURE COORDINATE FOR P
+! < 0.3 * pa (relative variation of p on a model level is < 0.1 %)
+
+! preff                      !--- REFERENCE PRESSURE                 (101325 Pa)
+! Written in "comvert.h":
+! ap(llm+1), bp(llm+1)       !--- Ap, Bp HYBRID COEFFICIENTS AT INTERFACES
+! aps(llm),  bps(llm)        !--- Ap, Bp HYBRID COEFFICIENTS AT MID-LAYERS
+! dpres(llm)                 !--- PRESSURE DIFFERENCE FOR EACH LAYER
+! presnivs(llm)              !--- PRESSURE AT EACH MID-LAYER
+! scaleheight                !--- VERTICAL SCALE HEIGHT            (Earth: 8kms)
+! nivsig(llm+1)              !--- SIGMA INDEX OF EACH LAYER INTERFACE
+! nivsigs(llm)               !--- SIGMA INDEX OF EACH MID-LAYER
+!-------------------------------------------------------------------------------
+! Local variables:
+  REAL sig(llm+1), dsig(llm)
+  REAL sig0(llm+1), zz(llm+1)
+  REAL zk, zkm1, dzk1, dzk2, z, k0, k1
+
+  INTEGER l, unit
+  REAL dsigmin
+  REAL vert_scale,vert_dzmin,vert_dzlow,vert_z0low,vert_dzmid,vert_z0mid,vert_h_mid,vert_dzhig,vert_z0hig,vert_h_hig
+
+  REAL alpha, beta, deltaz
+  REAL x
+  character(len=*),parameter :: modname="disvert"
+
+  character(len=24):: vert_sampling
+  ! (allowed values are "param", "tropo", "strato" and "read")
+
+  !-----------------------------------------------------------------------
+
+  WRITE(lunout,*) TRIM(modname)//" starts"
+
+  ! default scaleheight is 8km for earth
+  scaleheight=8.
+
+  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
+  call getin('vert_sampling', vert_sampling)
+  WRITE(lunout,*) TRIM(modname)//' vert_sampling = ' // vert_sampling
+  if (llm==39 .and. vert_sampling=="strato") then
+     dsigmin=0.3 ! Vieille option par défaut pour CMIP5
+  else
+     dsigmin=1.
+  endif
+  call getin('dsigmin', dsigmin)
+  WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
+
+
+  select case (vert_sampling)
+  case ("param")
+     ! On lit les options dans sigma.def:
+     OPEN(99, file='sigma.def', status='old', form='formatted')
+     READ(99, *) scaleheight ! hauteur d'echelle 8.
+     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
+     READ(99, *) beta ! facteur d'acroissement en haut 1.3
+     READ(99, *) k0 ! nombre de couches dans la transition surf
+     READ(99, *) k1 ! nombre de couches dans la transition haute
+     CLOSE(99)
+     alpha=deltaz/(llm*scaleheight)
+     write(lunout, *)trim(modname),':scaleheight, alpha, k0, k1, beta', &
+                               scaleheight, alpha, k0, k1, beta
+
+     alpha=deltaz/tanh(1./k0)*2.
+     zkm1=0.
+     sig(1)=1.
+     do l=1, llm
+        sig(l+1)=(cosh(l/k0))**(-alpha*k0/scaleheight) &
+             *exp(-alpha/scaleheight*tanh((llm-k1)/k0) &
+                  *beta**(l-(llm-k1))/log(beta))
+        zk=-scaleheight*log(sig(l+1))
+
+        dzk1=alpha*tanh(l/k0)
+        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
+        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
+        zkm1=zk
+     enddo
+
+     sig(llm+1)=0.
+
+     bp(: llm) = EXP(1. - 1. / sig(: llm)**2)
+     bp(llmp1) = 0.
+
+     ap = pa * (sig - bp)
+  case("sigma")
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) = dsigmin + 7.0 * SIN(x)**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+
+     bp(1)=1.
+     bp(2: llm) = sig(2:llm)
+     bp(llmp1) = 0.
+     ap(:)=0.
+  case("tropo")
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) = dsigmin + 7.0 * SIN(x)**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+
+     bp(1)=1.
+     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
+     bp(llmp1) = 0.
+
+     ap(1)=0.
+     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
+  case("strato")
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+
+     bp(1)=1.
+     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
+     bp(llmp1) = 0.
+
+     ap(1)=0.
+     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
+  case("strato_correct")
+!==================================================================
+! Fredho 2014/05/18, Saint-Louis du Senegal
+! Cette version de la discretisation strato est corrige au niveau
+! du passage des sig aux ap, bp
+! la version precedente donne un coude dans l'epaisseur des couches
+! vers la tropopause
+!==================================================================
+
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig0(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig0(l) = sig0(l+1) + dsig(l)
+     ENDDO
+     sig=racinesig(sig0)
+
+     bp(1)=1.
+     bp(2:llm)=EXP(1.-1./sig(2: llm)**2)
+     bp(llmp1)=0.
+
+     ap(1)=0.
+     ap(2:llm)=pa*(sig(2:llm)-bp(2:llm))
+     ap(llm+1)=0.
+
+  CASE("strato_custom0") 
+!=======================================================
+! Version Transitoire
+    ! custumize strato distribution with specific alpha & beta values and function
+    ! depending on llm (experimental and temporary)!
+    SELECT CASE (llm)
+      CASE(55)
+        alpha=0.45
+        beta=4.0
+      CASE(63)
+        alpha=0.45
+        beta=5.0
+      CASE(71)
+        alpha=3.05
+        beta=65.
+      CASE(79)
+        alpha=3.20
+        ! alpha=2.05 ! FLOTT 79 (PLANTE)
+        beta=70.
+    END SELECT
+    ! Or used values provided by user in def file:
+    CALL getin("strato_alpha",alpha)
+    CALL getin("strato_beta",beta)
+    
+    ! Build geometrical distribution
+    scaleheight=7.
+    zz(1)=0.
+    IF (llm==55.OR.llm==63) THEN
+      DO l=1,llm
+        z=zz(l)/scaleheight
+        zz(l+1)=zz(l)+0.03+z*1.5*(1.-TANH(z-0.5))+alpha*(1.+TANH(z-1.5))     &
+                            +5.0*EXP((l-llm)/beta)
+      ENDDO
+    ELSEIF (llm==71) THEN !.OR.llm==79) THEN      ! FLOTT 79 (PLANTE)
+      DO l=1,llm
+        z=zz(l)
+        zz(l+1)=zz(l)+0.02+0.88*TANH(z/2.5)+alpha*(1.+TANH((z-beta)/15.))
+      ENDDO
+    ELSEIF (llm==79) THEN
+      DO l=1,llm
+        z=zz(l)
+        zz(l+1)=zz(l)+0.02+0.80*TANH(z/3.8)+alpha*(1+TANH((z-beta)/17.))     &
+                            +0.03*TANH(z/.25)
+      ENDDO
+    ENDIF ! of IF (llm==55.OR.llm==63) ...
+    
+
+    ! Build sigma distribution
+    sig0=EXP(-zz(:)/scaleheight)
+    sig0(llm+1)=0.
+!    sig=ridders(sig0)
+    sig=racinesig(sig0)
+    
+    ! Compute ap() and bp()
+    bp(1)=1.
+    bp(2:llm)=EXP(1.-1./sig(2:llm)**2)
+    bp(llm+1)=0.
+    ap=pa*(sig-bp)
+
+  CASE("strato_custom") 
+!===================================================================
+! David Cugnet, François Lott, Lionel Guez, Ehouoarn Millour, Fredho
+! 2014/05
+! custumize strato distribution
+! Al the parameter are given in km assuming a given scalehigh
+    vert_scale=7.     ! scale hight
+    vert_dzmin=0.02   ! width of first layer
+    vert_dzlow=1.     ! dz in the low atmosphere
+    vert_z0low=8.     ! height at which resolution recches dzlow
+    vert_dzmid=3.     ! dz in the mid atmsophere
+    vert_z0mid=70.    ! height at which resolution recches dzmid
+    vert_h_mid=20.    ! width of the transition
+    vert_dzhig=11.    ! dz in the high atmsophere
+    vert_z0hig=80.    ! height at which resolution recches dz
+    vert_h_hig=20.    ! width of the transition
+!===================================================================
+
+    call getin('vert_scale',vert_scale)
+    call getin('vert_dzmin',vert_dzmin)
+    call getin('vert_dzlow',vert_dzlow)
+    call getin('vert_z0low',vert_z0low)
+    CALL getin('vert_dzmid',vert_dzmid)
+    CALL getin('vert_z0mid',vert_z0mid)
+    call getin('vert_h_mid',vert_h_mid)
+    call getin('vert_dzhig',vert_dzhig)
+    call getin('vert_z0hig',vert_z0hig)
+    call getin('vert_h_hig',vert_h_hig)
+
+    scaleheight=vert_scale ! for consistency with further computations
+    ! Build geometrical distribution
+    zz(1)=0.
+    DO l=1,llm
+       z=zz(l)
+       zz(l+1)=zz(l)+vert_dzmin+vert_dzlow*TANH(z/vert_z0low)+                &
+&      (vert_dzmid-vert_dzlow)* &
+&           (TANH((z-vert_z0mid)/vert_h_mid)-TANH((-vert_z0mid)/vert_h_mid)) &
+&     +(vert_dzhig-vert_dzmid-vert_dzlow)*                                  &
+&           (TANH((z-vert_z0hig)/vert_h_hig)-TANH((-vert_z0hig)/vert_h_hig))
+    ENDDO
+
+
+!===================================================================
+! Comment added Fredho 2014/05/18, Saint-Louis, Senegal
+! From approximate z to ap, bp, so that p=ap+bp*p0 and p/p0=exp(-z/H)
+! sig0 is p/p0
+! sig is an intermediate distribution introduce to estimate bp
+! 1.   sig0=exp(-z/H)
+! 2.   inversion of sig0=(1-pa/p0)*sig+(1-pa/p0)*exp(1-1/sig**2)
+! 3.   bp=exp(1-1/sig**2)
+! 4.   ap deduced from  the combination of 2 and 3 so that sig0=ap/p0+bp
+!===================================================================
+
+    sig0=EXP(-zz(:)/vert_scale)
+    sig0(llm+1)=0.
+    sig=racinesig(sig0)
+    bp(1)=1.
+    bp(2:llm)=EXP(1.-1./sig(2:llm)**2)
+    bp(llm+1)=0.
+    ap=pa*(sig-bp)
+
+  case("read")
+     ! Read "ap" and "bp". First line is skipped (title line). "ap"
+     ! should be in Pa. First couple of values should correspond to
+     ! the surface, that is : "bp" should be in descending order.
+     call new_unit(unit)
+     open(unit, file="hybrid.txt", status="old", action="read", &
+          position="rewind")
+     read(unit, fmt=*) ! skip title line
+     do l = 1, llm + 1
+        read(unit, fmt=*) ap(l), bp(l)
+     end do
+     close(unit)
+     call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &
+          bp(llm + 1) == 0., "disvert: bad ap or bp values")
+  case default
+     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
+  END select
+
+  DO l=1, llm
+     nivsigs(l) = REAL(l)
+  ENDDO
+
+  DO l=1, llmp1
+     nivsig(l)= REAL(l)
+  ENDDO
+
+  write(lunout, *)  trim(modname),': BP '
+  write(lunout, *) bp
+  write(lunout, *)  trim(modname),': AP '
+  write(lunout, *) ap
+
+  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
+  write(lunout, *)'couches calcules pour une pression de surface =', preff
+  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de '
+  write(lunout, *) scaleheight,' km'
+  DO l = 1, llm
+     dpres(l) = bp(l) - bp(l+1)
+     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
+          log(preff/presnivs(l))*scaleheight &
+          , ' DZ ~ ', scaleheight*log((ap(l)+bp(l)*preff)/ &
+          max(ap(l+1)+bp(l+1)*preff, 1.e-10))
+  ENDDO
+
+  write(lunout, *) trim(modname),': PRESNIVS '
+  write(lunout, *) presnivs
+
+CONTAINS
+
+!-------------------------------------------------------------------------------
+!
+FUNCTION ridders(sig) RESULT(sg)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Purpose: Search for s solving (Pa/Preff)*s+(1-Pa/Preff)*EXP(1-1./s**2)=sg
+! Notes:   Uses Ridders' method, quite robust. Initial bracketing: 0<=sg<=1.
+! Reference: Ridders, C. F. J. "A New Algorithm for Computing a Single Root of a
+!       Real Continuous Function" IEEE Trans. Circuits Systems 26, 979-980, 1979
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: sig(:)
+  REAL              :: sg(SIZE(sig))
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: it, ns, maxit
+  REAL :: c1, c2, x1, x2, x3, x4, f1, f2, f3, f4, s, xx, distrib
+!-------------------------------------------------------------------------------
+  ns=SIZE(sig); maxit=9999
+  c1=Pa/Preff; c2=1.-c1
+  DO l=1,ns
+    xx=HUGE(1.)
+    x1=0.0; f1=distrib(x1,c1,c2,sig(l))
+    x2=1.0; f2=distrib(x2,c1,c2,sig(l))
+    DO it=1,maxit
+      x3=0.5*(x1+x2); f3=distrib(x3,c1,c2,sig(l))
+      s=SQRT(f3**2-f1*f2);                 IF(s==0.) EXIT
+      x4=x3+(x3-x1)*(SIGN(1.,f1-f2)*f3/s); IF(ABS(10.*LOG(x4-xx))<=1E-5) EXIT
+      xx=x4; f4=distrib(x4,c1,c2,sig(l));  IF(f4==0.) EXIT
+      IF(SIGN(f3,f4)/=f3) THEN;      x1=x3; f1=f3; x2=xx; f2=f4
+      ELSE IF(SIGN(f1,f4)/=f1) THEN; x2=xx; f2=f4
+      ELSE IF(SIGN(f2,f4)/=f2) THEN; x1=xx; f1=f4
+      ELSE; CALL abort_gcm("ridders",'Algorithm failed (which is odd...')
+      END IF
+      IF(ABS(10.*LOG(ABS(x2-x1)))<=1E-5) EXIT       !--- ERROR ON SIG <= 0.01m            
+    END DO
+    IF(it==maxit+1) WRITE(lunout,'(a,i3)')'WARNING in ridder: failed to converg&
+     &e for level ',l
+    sg(l)=xx
+  END DO
+  sg(1)=1.; sg(ns)=0.
+
+END FUNCTION ridders
+
+FUNCTION racinesig(sig) RESULT(sg)
+!
+!-------------------------------------------------------------------------------
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Fredho 2014/05/18
+! Purpose: Search for s solving (Pa/Preff)*sg+(1-Pa/Preff)*EXP(1-1./sg**2)=s
+! Notes:   Uses Newton Raphson search
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN)  :: sig(:)
+  REAL              :: sg(SIZE(sig))
+!-------------------------------------------------------------------------------
+! Local variables:
+  INTEGER :: it, ns, maxit
+  REAL :: c1, c2, x1, x2, x3, x4, f1, f2, f3, f4, s, xx, distrib
+!-------------------------------------------------------------------------------
+  ns=SIZE(sig); maxit=100
+  c1=Pa/Preff; c2=1.-c1
+  DO l=2,ns-1
+    sg(l)=sig(l)
+    DO it=1,maxit
+       f1=exp(1-1./sg(l)**2)*(1.-c1)
+       sg(l)=sg(l)-(c1*sg(l)+f1-sig(l))/(c1+2*f1*sg(l)**(-3))
+    ENDDO
+!   print*,'SSSSIG ',sig(l),sg(l),c1*sg(l)+exp(1-1./sg(l)**2)*(1.-c1)
+  ENDDO
+  sg(1)=1.; sg(ns)=0.
+
+END FUNCTION racinesig
+
+
+
+
+END SUBROUTINE disvert
+
+!-------------------------------------------------------------------------------
+
+FUNCTION distrib(x,c1,c2,x0) RESULT(res)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  REAL, INTENT(IN) :: x, c1, c2, x0
+  REAL             :: res
+!-------------------------------------------------------------------------------
+  res=c1*x+c2*EXP(1-1/(x**2))-x0
+
+END FUNCTION distrib
+
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/ener.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/ener.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/ener.h	(revision 3815)
@@ -0,0 +1,18 @@
+!
+! $Id: ener.h 1952 2014-01-28 13:05:47Z lguez $
+!
+!  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 'ener.h'
+
+      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
+     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
+     &            rmsv,gtot(llmm1)
+
+      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
+     &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
+
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/exner_hyb_m.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/exner_hyb_m.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/exner_hyb_m.F90	(revision 3815)
@@ -0,0 +1,145 @@
+module exner_hyb_m
+
+  IMPLICIT NONE
+
+contains
+
+  SUBROUTINE  exner_hyb ( ngrid, ps, p, pks, pk, pkf )
+
+    !     Auteurs :  P.Le Van  , Fr. Hourdin  .
+    !    ..........
+    !
+    !    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
+    !    ....  pks,pk,pkf   sont des argum.de sortie au sous-prog ...
+    !
+    !   ************************************************************************
+    !    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des 
+    !    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+    !    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+    !   ************************************************************************
+    !  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+    !    la pression et la fonction d'Exner  au  sol  .
+    !
+    !                                 -------- z
+    !    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
+    !                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
+    !    ( voir note de Fr.Hourdin )  ,
+    !
+    !    on determine successivement , du haut vers le bas des couches, les 
+    !    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2), 
+    !    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches,  
+    !     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
+    !
+    !
+    !
+    include "dimensions.h"
+    include "paramet.h"
+    include "comconst.h"
+    include "comgeom.h"
+    include "comvert.h"
+    include "serre.h"
+
+    INTEGER  ngrid
+    REAL p(ngrid,llmp1),pk(ngrid,llm)
+    real, optional:: pkf(ngrid,llm)
+    REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
+
+    !    .... variables locales   ...
+
+    INTEGER l, ij
+    REAL unpl2k,dellta
+
+    logical,save :: firstcall=.true.
+    character(len=*),parameter :: modname="exner_hyb"
+
+    ! Sanity check
+    if (firstcall) then
+       ! sanity checks for Shallow Water case (1 vertical layer)
+       if (llm.eq.1) then
+          if (kappa.ne.1) then
+             call abort_gcm(modname, &
+                  "kappa!=1 , but running in Shallow Water mode!!",42)
+          endif
+          if (cpp.ne.r) then
+             call abort_gcm(modname, &
+                  "cpp!=r , but running in Shallow Water mode!!",42)
+          endif
+       endif ! of if (llm.eq.1)
+
+       firstcall=.false.
+    endif ! of if (firstcall)
+
+    ! Specific behaviour for Shallow Water (1 vertical layer) case:
+    if (llm.eq.1) then
+
+       ! Compute pks(:),pk(:),pkf(:)
+
+       DO   ij  = 1, ngrid
+          pks(ij) = (cpp/preff) * ps(ij)
+          pk(ij,1) = .5*pks(ij)
+       ENDDO
+
+       if (present(pkf)) then
+          pkf = pk
+          CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
+       end if
+
+       ! our work is done, exit routine
+       return
+    endif ! of if (llm.eq.1)
+
+    ! General case:
+
+    unpl2k    = 1.+ 2.* kappa
+
+    !     -------------
+    !     Calcul de pks
+    !     -------------
+
+    DO   ij  = 1, ngrid
+       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+    ENDDO
+
+    !    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
+    !
+    DO     ij      = 1, ngrid
+       alpha(ij,llm) = 0.
+       beta (ij,llm) = 1./ unpl2k
+    ENDDO
+    !
+    !     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
+    !
+    DO l = llm -1 , 2 , -1
+       !
+       DO ij = 1, ngrid
+          dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
+          alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
+          beta (ij,l)  =   p(ij,l  ) / dellta   
+       ENDDO
+    ENDDO
+
+    !  ***********************************************************************
+    !     .....  Calcul de pk pour la couche 1 , pres du sol  ....
+    !
+    DO   ij   = 1, ngrid
+       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  / &
+            (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
+    ENDDO
+    !
+    !    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
+    !
+    DO l = 2, llm
+       DO   ij   = 1, ngrid
+          pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
+       ENDDO
+    ENDDO
+
+    if (present(pkf)) then
+       !    calcul de pkf
+       pkf = pk
+       CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
+    end if
+
+  END SUBROUTINE exner_hyb
+
+end module exner_hyb_m
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/infotrac.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/infotrac.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/infotrac.F90	(revision 3815)
@@ -0,0 +1,400 @@
+! $Id$
+!
+MODULE infotrac
+
+! nqtot : total number of tracers and higher order of moment, water vapor and liquid included
+  INTEGER, SAVE :: nqtot
+!CR: on ajoute le nombre de traceurs de l eau
+  INTEGER, SAVE :: nqo
+
+! nbtr : number of tracers not including higher order of moment or water vapor or liquid
+!        number of tracers used in the physics
+  INTEGER, SAVE :: nbtr
+
+! Name variables
+  CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
+  CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
+
+! iadv  : index of trasport schema for each tracer
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: iadv
+
+! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 
+!         dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: niadv ! equivalent dyn / physique
+
+! conv_flg(it)=0 : convection desactivated for tracer number it 
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: conv_flg
+! pbl_flg(it)=0  : boundary layer diffusion desactivaded for tracer number it 
+  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: pbl_flg
+
+  CHARACTER(len=4),SAVE :: type_trac
+  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
+ 
+CONTAINS
+
+  SUBROUTINE infotrac_init
+    USE control_mod
+#ifdef REPROBUS
+    USE CHEM_REP, ONLY : Init_chem_rep_trac
+#endif
+    IMPLICIT NONE
+!=======================================================================
+!
+!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
+!   -------
+!   Modif special traceur F.Forget 05/94
+!   Modif M-A Filiberti 02/02 lecture de traceur.def
+!
+!   Objet:
+!   ------
+!   GCM LMD nouvelle grille
+!
+!=======================================================================
+!   ... modification de l'integration de q ( 26/04/94 ) ....
+!-----------------------------------------------------------------------
+! Declarations
+
+    INCLUDE "dimensions.h"
+    INCLUDE "iniprint.h"
+
+! Local variables
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv  ! index of horizontal trasport schema
+    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv  ! index of vertical trasport schema
+
+    CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
+    CHARACTER(len=3), DIMENSION(30) :: descrq
+    CHARACTER(len=1), DIMENSION(3)  :: txts
+    CHARACTER(len=2), DIMENSION(9)  :: txtp
+    CHARACTER(len=23)               :: str1,str2
+  
+    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
+    INTEGER :: iq, new_iq, iiq, jq, ierr
+
+    character(len=*),parameter :: modname="infotrac_init"
+!-----------------------------------------------------------------------
+! Initialization :
+!
+    txts=(/'x','y','z'/)
+    txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/)
+
+    descrq(14)='VLH'
+    descrq(10)='VL1'
+    descrq(11)='VLP'
+    descrq(12)='FH1'
+    descrq(13)='FH2'
+    descrq(16)='PPM'
+    descrq(17)='PPS'
+    descrq(18)='PPP'
+    descrq(20)='SLP'
+    descrq(30)='PRA'
+    
+
+    ! Coherence test between parameter type_trac, config_inca and preprocessing keys
+    IF (type_trac=='inca') THEN
+       WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
+            type_trac,' config_inca=',config_inca
+       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
+          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
+          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
+       END IF
+#ifndef INCA
+       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
+       CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
+#endif
+    ELSE IF (type_trac=='repr') THEN
+       WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
+#ifndef REPROBUS
+       WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
+       CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
+#endif
+    ELSE IF (type_trac == 'lmdz') THEN
+       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
+    ELSE
+       WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
+       CALL abort_gcm('infotrac_init','bad parameter',1)
+    END IF
+
+
+    ! Test if config_inca is other then none for run without INCA
+    IF (type_trac/='inca' .AND. config_inca/='none') THEN
+       WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
+       config_inca='none'
+    END IF
+
+
+!-----------------------------------------------------------------------
+!
+! 1) Get the true number of tracers + water vapor/liquid
+!    Here true tracers (nqtrue) means declared tracers (only first order)
+!
+!-----------------------------------------------------------------------
+    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
+       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
+       IF(ierr.EQ.0) THEN
+          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
+          READ(90,*) nqtrue
+       ELSE 
+          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
+          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
+          if (planet_type=='earth') then
+            nqtrue=4 ! Default value for Earth
+          else
+            nqtrue=1 ! Default value for other planets
+          endif
+       END IF
+       if ( planet_type=='earth') then
+         ! For Earth, water vapour & liquid tracers are not in the physics
+         nbtr=nqtrue-2
+       else
+         ! Other planets (for now); we have the same number of tracers
+         ! in the dynamics than in the physics
+         nbtr=nqtrue
+       endif
+    ELSE ! type_trac=inca
+       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 
+       nqtrue=nbtr+2
+    END IF
+
+    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
+       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
+       CALL abort_gcm('infotrac_init','Not enough tracers',1)
+    END IF
+    
+! Transfert number of tracers to Reprobus
+    IF (type_trac == 'repr') THEN
+#ifdef REPROBUS
+       CALL Init_chem_rep_trac(nbtr)
+#endif
+    END IF
+       
+!
+! Allocate variables depending on nqtrue and nbtr
+!
+    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue))
+    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
+    conv_flg(:) = 1 ! convection activated for all tracers
+    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
+
+!-----------------------------------------------------------------------
+! 2)     Choix  des schemas d'advection pour l'eau et les traceurs
+!
+!     iadv = 1    schema  transport type "humidite specifique LMD"
+!     iadv = 2    schema   amont
+!     iadv = 14   schema  Van-leer + humidite specifique 
+!                            Modif F.Codron
+!     iadv = 10   schema  Van-leer (retenu pour l'eau vapeur et liquide)
+!     iadv = 11   schema  Van-Leer pour hadv et version PPM (Monotone) pour vadv
+!     iadv = 12   schema  Frederic Hourdin I
+!     iadv = 13   schema  Frederic Hourdin II
+!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
+!     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
+!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
+!     iadv = 20   schema  Slopes
+!     iadv = 30   schema  Prather
+!
+!        Dans le tableau q(ij,l,iq) : iq = 1  pour l'eau vapeur
+!                                     iq = 2  pour l'eau liquide
+!       Et eventuellement             iq = 3,nqtot pour les autres traceurs
+!
+!        iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
+!------------------------------------------------------------------------
+!
+!    Get choice of advection schema from file tracer.def or from INCA
+!---------------------------------------------------------------------
+    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
+       IF(ierr.EQ.0) THEN
+          ! Continue to read tracer.def
+          DO iq=1,nqtrue
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
+          END DO
+          CLOSE(90)  
+       ELSE ! Without tracer.def, set default values 
+         if (planet_type=="earth") then
+          ! for Earth, default is to have 4 tracers
+          hadv(1) = 14
+          vadv(1) = 14
+          tnom_0(1) = 'H2Ov'
+          hadv(2) = 10
+          vadv(2) = 10
+          tnom_0(2) = 'H2Ol'
+          hadv(3) = 10
+          vadv(3) = 10
+          tnom_0(3) = 'RN'
+          hadv(4) = 10
+          vadv(4) = 10
+          tnom_0(4) = 'PB'
+         else ! default for other planets
+          hadv(1) = 10
+          vadv(1) = 10
+          tnom_0(1) = 'dummy'
+         endif ! of if (planet_type=="earth")
+       END IF
+
+!CR: nombre de traceurs de l eau
+       if (tnom_0(3) == 'H2Oi') then
+          nqo=3
+       else
+          nqo=2
+       endif
+       
+       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
+       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
+       DO iq=1,nqtrue
+          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
+       END DO
+
+    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
+! le module de chimie fournit les noms des traceurs
+! et les schemas d'advection associes.
+     
+#ifdef INCA
+       CALL init_transport( &
+            hadv, &
+            vadv, &
+            conv_flg, &
+            pbl_flg,  &
+            solsym)
+#endif
+       tnom_0(1)='H2Ov'
+       tnom_0(2)='H2Ol'
+
+       DO iq =3,nqtrue
+          tnom_0(iq)=solsym(iq-2)
+       END DO
+       nqo = 2
+
+    END IF ! type_trac
+
+!-----------------------------------------------------------------------
+!
+! 3) Verify if advection schema 20 or 30 choosen
+!    Calculate total number of tracers needed: nqtot
+!    Allocate variables depending on total number of tracers
+!-----------------------------------------------------------------------
+    new_iq=0
+    DO iq=1,nqtrue
+       ! Add tracers for certain advection schema
+       IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN
+          new_iq=new_iq+1  ! no tracers added
+       ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN
+          new_iq=new_iq+4  ! 3 tracers added
+       ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN
+          new_iq=new_iq+10 ! 9 tracers added
+       ELSE
+          WRITE(lunout,*) trim(modname),': 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
+    END DO
+    
+    IF (new_iq /= nqtrue) THEN
+       ! The choice of advection schema imposes more tracers
+       ! Assigne total number of tracers
+       nqtot = new_iq
+
+       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
+       WRITE(lunout,*) 'makes it necessary to add tracers'
+       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
+       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
+
+    ELSE
+       ! The true number of tracers is also the total number
+       nqtot = nqtrue
+    END IF
+
+!
+! Allocate variables with total number of tracers, nqtot
+!
+    ALLOCATE(tname(nqtot), ttext(nqtot))
+    ALLOCATE(iadv(nqtot), niadv(nqtot))
+
+!-----------------------------------------------------------------------
+!
+! 4) Determine iadv, long and short name
+!
+!-----------------------------------------------------------------------
+    new_iq=0
+    DO iq=1,nqtrue
+       new_iq=new_iq+1
+
+       ! Verify choice of advection schema
+       IF (hadv(iq)==vadv(iq)) THEN
+          iadv(new_iq)=hadv(iq)
+       ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN
+          iadv(new_iq)=11
+       ELSE
+          WRITE(lunout,*)trim(modname),': 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
+      
+       str1=tnom_0(iq)
+       tname(new_iq)= tnom_0(iq)
+       IF (iadv(new_iq)==0) THEN
+          ttext(new_iq)=trim(str1)
+       ELSE
+          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
+       END IF
+
+       ! schemas tenant compte des moments d'ordre superieur
+       str2=ttext(new_iq)
+       IF (iadv(new_iq)==20) THEN
+          DO jq=1,3
+             new_iq=new_iq+1
+             iadv(new_iq)=-20
+             ttext(new_iq)=trim(str2)//txts(jq)
+             tname(new_iq)=trim(str1)//txts(jq)
+          END DO
+       ELSE IF (iadv(new_iq)==30) THEN
+          DO jq=1,9
+             new_iq=new_iq+1
+             iadv(new_iq)=-30
+             ttext(new_iq)=trim(str2)//txtp(jq)
+             tname(new_iq)=trim(str1)//txtp(jq)
+          END DO
+       END IF
+    END DO
+
+!
+! Find vector keeping the correspodence between true and total tracers
+!
+    niadv(:)=0
+    iiq=0
+    DO iq=1,nqtot
+       IF(iadv(iq).GE.0) THEN
+          ! True tracer
+          iiq=iiq+1
+          niadv(iiq)=iq
+       ENDIF
+    END DO
+
+
+    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
+    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
+    DO iq=1,nqtot
+       WRITE(lunout,*) iadv(iq),niadv(iq),&
+       ' ',trim(tname(iq)),' ',trim(ttext(iq))
+    END DO
+
+!
+! Test for advection schema. 
+! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) .
+!
+    DO iq=1,nqtot
+       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
+          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
+       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
+          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
+       END IF
+    END DO
+
+!-----------------------------------------------------------------------
+! Finalize :
+!
+    DEALLOCATE(tnom_0, hadv, vadv)
+
+
+  END SUBROUTINE infotrac_init
+
+END MODULE infotrac
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/iniphysiq.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/iniphysiq.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/iniphysiq.F90	(revision 3815)
@@ -0,0 +1,204 @@
+
+! $Id: iniphysiq.F90 2242 2015-03-24 08:08:43Z emillour $
+
+
+SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep,         &
+                     rlatu,rlonv,aire,cu,cv,                             &
+                     prad,pg,pr,pcpp,iflag_phys)
+  USE dimphy, ONLY: klev ! number of atmospheric levels
+  USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns
+                                        ! (on full grid)
+  USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid)
+                                klon_omp_begin, & ! start index of local omp subgrid
+                                klon_omp_end, & ! end index of local omp subgrid
+                                klon_mpi_begin ! start indes of columns (on local mpi grid)
+  USE comgeomphy, ONLY: initcomgeomphy, &
+                        airephy, & ! physics grid area (m2)
+                        cuphy, & ! cu coeff. (u_covariant = cu * u)
+                        cvphy, & ! cv coeff. (v_covariant = cv * v)
+                        rlond, & ! longitudes
+                        rlatd ! latitudes
+  USE phyaqua_mod, ONLY: iniaqua
+  IMPLICIT NONE
+
+  ! =======================================================================
+  ! Initialisation of the physical constants and some positional and
+  ! geometrical arrays for the physics
+  ! =======================================================================
+
+  include "YOMCST.h"
+  include "iniprint.h"
+
+  REAL, INTENT (IN) :: prad ! radius of the planet (m)
+  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
+  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
+  REAL, INTENT (IN) :: pcpp ! specific heat Cp
+  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
+  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
+  INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes
+  INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes
+  REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid
+  REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid
+  REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2)
+  REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u)
+  REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v)
+  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
+  REAL, INTENT (IN) :: ptimestep !physics time step (s)
+  INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
+
+  INTEGER :: ibegin, iend, offset
+  INTEGER :: i,j
+  CHARACTER (LEN=20) :: modname = 'iniphysiq'
+  CHARACTER (LEN=80) :: abort_message
+  REAL :: total_area_phy, total_area_dyn
+
+
+  ! global array, on full physics grid:
+  REAL,ALLOCATABLE :: latfi(:)
+  REAL,ALLOCATABLE :: lonfi(:)
+  REAL,ALLOCATABLE :: cufi(:)
+  REAL,ALLOCATABLE :: cvfi(:)
+  REAL,ALLOCATABLE :: airefi(:)
+
+  IF (nlayer/=klev) THEN
+    WRITE (lunout, *) 'STOP in ', trim(modname)
+    WRITE (lunout, *) 'Problem with dimensions :'
+    WRITE (lunout, *) 'nlayer     = ', nlayer
+    WRITE (lunout, *) 'klev   = ', klev
+    abort_message = ''
+    CALL abort_gcm(modname, abort_message, 1)
+  END IF
+
+  !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
+  
+  ! Generate global arrays on full physics grid
+  ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo))
+  ALLOCATE(airefi(klon_glo))
+
+  IF (klon_glo>1) THEN ! general case
+    ! North pole
+    latfi(1)=rlatu(1)
+    lonfi(1)=0.
+    cufi(1) = cu(1)
+    cvfi(1) = cv(1)
+    DO j=2,jjm
+      DO i=1,iim
+        latfi((j-2)*iim+1+i)= rlatu(j)
+        lonfi((j-2)*iim+1+i)= rlonv(i)
+        cufi((j-2)*iim+1+i) = cu((j-1)*iim+1+i)
+        cvfi((j-2)*iim+1+i) = cv((j-1)*iim+1+i)
+      ENDDO
+    ENDDO
+    ! South pole
+    latfi(klon_glo)= rlatu(jjm+1)
+    lonfi(klon_glo)= 0.
+    cufi(klon_glo) = cu((iim+1)*jjm+1)
+    cvfi(klon_glo) = cv((iim+1)*jjm-iim)
+
+    ! build airefi(), mesh area on physics grid
+    CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi)
+    ! Poles are single points on physics grid
+    airefi(1)=sum(aire(1:iim,1))
+    airefi(klon_glo)=sum(aire(1:iim,jjm+1))
+
+    ! Sanity check: do total planet area match between physics and dynamics?
+    total_area_dyn=sum(aire(1:iim,1:jjm+1))
+    total_area_phy=sum(airefi(1:klon_glo))
+    IF (total_area_dyn/=total_area_phy) THEN
+      WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!'
+      WRITE (lunout, *) '     in the dynamics total_area_dyn=', total_area_dyn
+      WRITE (lunout, *) '  but in the physics total_area_phy=', total_area_phy
+      IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN
+        ! stop here if the relative difference is more than 0.001%
+        abort_message = 'planet total surface discrepancy'
+        CALL abort_gcm(modname, abort_message, 1)
+      ENDIF
+    ENDIF
+  ELSE ! klon_glo==1, running the 1D model
+    ! just copy over input values
+    latfi(1)=rlatu(1)
+    lonfi(1)=rlonv(1)
+    cufi(1)=cu(1)
+    cvfi(1)=cv(1)
+    airefi(1)=aire(1,1)
+  ENDIF ! of IF (klon_glo>1)
+
+!$OMP PARALLEL 
+  ! Now generate local lon/lat/cu/cv/area arrays
+  CALL initcomgeomphy
+
+  offset = klon_mpi_begin - 1
+  airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end)
+  cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end)
+  cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end)
+  rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end)
+
+    ! suphel => initialize some physical constants (orbital parameters,
+    !           geoid, gravity, thermodynamical constants, etc.) in the
+    !           physics
+  CALL suphel
+
+!$OMP END PARALLEL
+
+  ! check that physical constants set in 'suphel' are coherent
+  ! with values set in the dynamics:
+  IF (rday/=punjours) THEN
+    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
+    WRITE (lunout, *) '  in the dynamics punjours=', punjours
+    WRITE (lunout, *) '   but in the physics RDAY=', rday
+    IF (abs(rday-punjours)>0.01*punjours) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'length of day discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rg/=pg) THEN
+    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pg=', pg
+    WRITE (lunout, *) '  but in the physics RG=', rg
+    IF (abs(rg-pg)>0.01*pg) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'gravity discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (ra/=prad) THEN
+    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
+    WRITE (lunout, *) '   in the dynamics prad=', prad
+    WRITE (lunout, *) '  but in the physics RA=', ra
+    IF (abs(ra-prad)>0.01*prad) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'planet radius discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rd/=pr) THEN
+    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pr=', pr
+    WRITE (lunout, *) '  but in the physics RD=', rd
+    IF (abs(rd-pr)>0.01*pr) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'reduced gas constant discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+  IF (rcpd/=pcpp) THEN
+    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
+    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
+    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
+    IF (abs(rcpd-pcpp)>0.01*pcpp) THEN
+        ! stop here if the relative difference is more than 1%
+      abort_message = 'specific heat discrepancy'
+      CALL abort_gcm(modname, abort_message, 1)
+    END IF
+  END IF
+
+  ! Additional initializations for aquaplanets
+!$OMP PARALLEL
+  IF (iflag_phys>=100) THEN
+    CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
+  END IF
+!$OMP END PARALLEL
+
+END SUBROUTINE iniphysiq
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/lmdz1d.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/lmdz1d.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/lmdz1d.F90	(revision 3815)
@@ -0,0 +1,1051 @@
+!#ifdef CPP_1D
+!#include "../dyn3d/mod_const_mpi.F90"
+!#include "../dyn3d_common/control_mod.F90"
+!#include "../dyn3d_common/infotrac.F90"
+!#include "../dyn3d_common/disvert.F90"
+
+
+      PROGRAM lmdz1d
+
+      USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar
+      use phys_state_var_mod
+      use dimphy
+      use surface_data, only : type_ocean,ok_veget
+      use pbl_surface_mod, only : ftsoil, pbl_surface_init,                     &
+     &                            pbl_surface_final
+      use fonte_neige_mod, only : fonte_neige_init, fonte_neige_final 
+
+      use infotrac ! new
+      use control_mod
+      USE indice_sol_mod
+      USE phyaqua_mod
+      USE mod_1D_cases_read
+      USE mod_1D_amma_read
+
+      implicit none
+#include "dimensions.h"
+#include "YOMCST.h"
+#include "temps.h"
+!!#include "control.h"
+#include "iniprint.h"
+#include "clesphys.h"
+#include "dimsoil.h"
+!#include "indicesol.h"
+
+#include "comvert.h"
+#include "compar1d.h"
+#include "flux_arp.h"
+#include "tsoilnudge.h"
+#include "fcg_gcssold.h"
+!!!#include "fbforcing.h"
+
+!=====================================================================
+! DECLARATIONS
+!=====================================================================
+
+!---------------------------------------------------------------------
+!  Externals
+!---------------------------------------------------------------------
+      external fq_sat
+      real fq_sat
+
+!---------------------------------------------------------------------
+!  Arguments d' initialisations de la physique (USER DEFINE)
+!---------------------------------------------------------------------
+
+      integer, parameter :: ngrid=1
+      real :: zcufi    = 1.
+      real :: zcvfi    = 1.
+
+!-      real :: nat_surf
+!-      logical :: ok_flux_surf
+!-      real :: fsens
+!-      real :: flat
+!-      real :: tsurf
+!-      real :: rugos
+!-      real :: qsol(1:2)
+!-      real :: qsurf
+!-      real :: psurf
+!-      real :: zsurf
+!-      real :: albedo
+!-
+!-      real :: time     = 0.
+!-      real :: time_ini
+!-      real :: xlat 
+!-      real :: xlon 
+!-      real :: wtsurf 
+!-      real :: wqsurf 
+!-      real :: restart_runoff 
+!-      real :: xagesno 
+!-      real :: qsolinp 
+!-      real :: zpicinp 
+!-
+      real :: fnday 
+      real :: day, daytime 
+      real :: day1
+      real :: heure
+      integer :: jour
+      integer :: mois
+      integer :: an
+ 
+!---------------------------------------------------------------------
+!  Declarations related to forcing and initial profiles 
+!---------------------------------------------------------------------
+
+        integer :: kmax = llm
+        integer llm700,nq1,nq2
+        INTEGER, PARAMETER :: nlev_max=1000, nqmx=1000
+        real timestep, frac
+        real height(nlev_max),tttprof(nlev_max),qtprof(nlev_max)
+        real  uprof(nlev_max),vprof(nlev_max),e12prof(nlev_max)
+        real  ugprof(nlev_max),vgprof(nlev_max),wfls(nlev_max)
+        real  dqtdxls(nlev_max),dqtdyls(nlev_max)
+        real  dqtdtls(nlev_max),thlpcar(nlev_max)
+        real  qprof(nlev_max,nqmx)
+
+!        integer :: forcing_type
+        logical :: forcing_les     = .false.
+        logical :: forcing_armcu   = .false.
+        logical :: forcing_rico    = .false.
+        logical :: forcing_radconv = .false.
+        logical :: forcing_toga    = .false.
+        logical :: forcing_twpice  = .false.
+        logical :: forcing_amma    = .false.
+        logical :: forcing_dice    = .false.
+        logical :: forcing_GCM2SCM = .false.
+        logical :: forcing_GCSSold = .false.
+        logical :: forcing_sandu   = .false.
+        logical :: forcing_astex   = .false.
+        logical :: forcing_fire    = .false.
+        logical :: forcing_case    = .false.
+        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+!                                                            (cf read_tsurf1d.F)
+
+!vertical advection computation
+!       real d_t_z(llm), d_q_z(llm)
+!       real d_t_dyn_z(llm), d_q_dyn_z(llm)
+!       real zz(llm)
+!       real zfact
+
+!flag forcings
+        logical :: nudge_wind=.true.
+        logical :: nudge_thermo=.false.
+        logical :: cptadvw=.true.
+!=====================================================================
+! DECLARATIONS FOR EACH CASE
+!=====================================================================
+!
+#include "1D_decl_cases.h"
+!
+!---------------------------------------------------------------------
+!  Declarations related to nudging
+!---------------------------------------------------------------------
+     integer :: nudge_max
+     parameter (nudge_max=9)
+     integer :: inudge_RHT=1
+     integer :: inudge_UV=2
+     logical :: nudge(nudge_max)
+     real :: t_targ(llm)
+     real :: rh_targ(llm)
+     real :: u_targ(llm)
+     real :: v_targ(llm)
+!
+!---------------------------------------------------------------------
+!  Declarations related to vertical discretization:
+!---------------------------------------------------------------------
+      real :: pzero=1.e5
+      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
+      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1),poub
+
+!---------------------------------------------------------------------
+!  Declarations related to variables
+!---------------------------------------------------------------------
+
+      real :: phi(llm)
+      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
+      real :: rlat_rad(1),rlon_rad(1)
+      real :: omega(llm+1),omega2(llm),rho(llm+1)
+      real :: ug(llm),vg(llm),fcoriolis
+      real :: sfdt, cfdt
+      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
+      real :: dt_dyn(llm)
+      real :: dt_cooling(llm),d_th_adv(llm),d_t_nudge(llm)
+      real :: d_u_nudge(llm),d_v_nudge(llm)
+      real :: du_adv(llm),dv_adv(llm)
+      real :: alpha
+      real :: ttt
+
+      REAL, ALLOCATABLE, DIMENSION(:,:):: q
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
+      REAL, ALLOCATABLE, DIMENSION(:,:):: dq_dyn
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_adv
+      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_nudge
+!      REAL, ALLOCATABLE, DIMENSION(:):: d_th_adv
+
+!---------------------------------------------------------------------
+!  Initialization of surface variables
+!---------------------------------------------------------------------
+      real :: run_off_lic_0(1)
+      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
+      real :: tsoil(1,nsoilmx,nbsrf)
+!     real :: agesno(1,nbsrf)
+
+!---------------------------------------------------------------------
+!  Call to phyredem
+!---------------------------------------------------------------------
+      logical :: ok_writedem =.true.
+      real :: sollw_in = 0.
+      real :: solsw_in = 0.
+      
+!---------------------------------------------------------------------
+!  Call to physiq
+!---------------------------------------------------------------------
+      logical :: firstcall=.true.
+      logical :: lastcall=.false.
+      real :: phis    = 0.0
+      real :: dpsrf 
+
+!---------------------------------------------------------------------
+!  Initializations of boundary conditions 
+!---------------------------------------------------------------------
+      integer, parameter :: yd = 360
+      real :: phy_nat (yd) = 0.0 ! 0=ocean libre,1=land,2=glacier,3=banquise
+      real :: phy_alb (yd)  ! Albedo land only (old value condsurf_jyg=0.3)
+      real :: phy_sst (yd)  ! SST (will not be used; cf read_tsurf1d.F)
+      real :: phy_bil (yd) = 1.0 ! Ne sert que pour les slab_ocean
+      real :: phy_rug (yd) ! Longueur rugosite utilisee sur land only
+      real :: phy_ice (yd) = 0.0 ! Fraction de glace
+      real :: phy_fter(yd) = 0.0 ! Fraction de terre
+      real :: phy_foce(yd) = 0.0 ! Fraction de ocean
+      real :: phy_fsic(yd) = 0.0 ! Fraction de glace
+      real :: phy_flic(yd) = 0.0 ! Fraction de glace
+
+!---------------------------------------------------------------------
+!  Fichiers et d'autres variables
+!---------------------------------------------------------------------
+      integer :: k,l,i,it=1,mxcalc
+      integer jcode
+      integer jjmp1
+      parameter (jjmp1=jjm+1-1/jjm)
+      REAL dudyn(iim+1,jjmp1,llm)
+      INTEGER read_climoz 
+!Al1
+      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+      data ecrit_slab_oc/-1/
+
+!=====================================================================
+! INITIALIZATIONS 
+!=====================================================================
+! Initialization of Common turb_forcing
+       dtime_frcg = 0.
+       Turb_fcg_gcssold=.false.
+       hthturb_gcssold = 0.
+       hqturb_gcssold = 0.
+
+!---------------------------------------------------------------------
+! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
+!---------------------------------------------------------------------
+!Al1
+        call conf_unicol
+!Al1 moves this gcssold var from common fcg_gcssold to 
+        Turb_fcg_gcssold = xTurb_fcg_gcssold
+! --------------------------------------------------------------------
+        close(1)
+!Al1
+        write(*,*) 'lmdz1d.def lu => unicol.def'
+
+! forcing_type defines the way the SCM is forced:
+!forcing_type = 0 ==> forcing_les = .true.
+!             initial profiles from file prof.inp.001
+!             no forcing by LS convergence ; 
+!             surface temperature imposed ;
+!             radiative cooling may be imposed (iflag_radia=0 in physiq.def)
+!forcing_type = 1 ==> forcing_radconv = .true.
+!             idem forcing_type = 0, but the imposed radiative cooling 
+!             is set to 0 (hence, if iflag_radia=0 in physiq.def, 
+!             then there is no radiative cooling at all)
+!forcing_type = 2 ==> forcing_toga = .true.
+!             initial profiles from TOGA-COARE IFA files 
+!             LS convergence and SST imposed from TOGA-COARE IFA files 
+!forcing_type = 3 ==> forcing_GCM2SCM = .true.
+!             initial profiles from the GCM output
+!             LS convergence imposed from the GCM output
+!forcing_type = 4 ==> forcing_twpice = .true.
+!             initial profiles from TWP-ICE cdf file 
+!             LS convergence, omega and SST imposed from TWP-ICE files 
+!forcing_type = 5 ==> forcing_rico = .true.
+!             initial profiles from RICO files 
+!             LS convergence imposed from RICO files 
+!forcing_type = 6 ==> forcing_amma = .true.
+!             initial profiles from AMMA nc file 
+!             LS convergence, omega and surface fluxes imposed from AMMA file  
+!forcing_type = 7 ==> forcing_dice = .true.
+!             initial profiles and large scale forcings in dice_driver.nc
+!             Different stages: soil model alone, atm. model alone
+!             then both models coupled
+!forcing_type = 10 ==> forcing_case = .true.
+!             initial profiles and large scale forcings in cas.nc
+!             LS convergence, omega and SST imposed from CINDY-DYNAMO files 
+!forcing_type = 40 ==> forcing_GCSSold = .true.
+!             initial profile from GCSS file
+!             LS convergence imposed from GCSS file
+!forcing_type = 50 ==> forcing_fire = .true.
+!             forcing from fire.nc
+!forcing_type = 59 ==> forcing_sandu = .true.
+!             initial profiles from sanduref file: see prof.inp.001
+!             SST varying with time and divergence constante: see ifa_sanduref.txt file
+!             Radiation has to be computed interactively
+!forcing_type = 60 ==> forcing_astex = .true.
+!             initial profiles from file: see prof.inp.001 
+!             SST,divergence,ug,vg,ufa,vfa varying with time : see ifa_astex.txt file
+!             Radiation has to be computed interactively
+!forcing_type = 61 ==> forcing_armcu = .true.
+!             initial profiles from file: see prof.inp.001 
+!             sensible and latent heat flux imposed: see ifa_arm_cu_1.txt
+!             large scale advective forcing & radiative tendencies applied below 1000m: see ifa_arm_cu_2.txt
+!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s 
+!             Radiation to be switched off
+!
+      if (forcing_type .eq.0) THEN
+       forcing_les = .true.
+      elseif (forcing_type .eq.1) THEN
+       forcing_radconv = .true.
+      elseif (forcing_type .eq.2) THEN
+       forcing_toga    = .true.
+      elseif (forcing_type .eq.3) THEN
+       forcing_GCM2SCM = .true.
+      elseif (forcing_type .eq.4) THEN
+       forcing_twpice = .true.
+      elseif (forcing_type .eq.5) THEN
+       forcing_rico = .true.
+      elseif (forcing_type .eq.6) THEN
+       forcing_amma = .true.
+      elseif (forcing_type .eq.7) THEN
+       forcing_dice = .true.
+      elseif (forcing_type .eq.10) THEN
+       forcing_case = .true.
+      elseif (forcing_type .eq.40) THEN
+       forcing_GCSSold = .true.
+      elseif (forcing_type .eq.50) THEN
+       forcing_fire = .true.
+      elseif (forcing_type .eq.59) THEN
+       forcing_sandu   = .true.
+      elseif (forcing_type .eq.60) THEN
+       forcing_astex   = .true.
+      elseif (forcing_type .eq.61) THEN
+       forcing_armcu = .true.
+       IF(llm.NE.19.AND.llm.NE.40) stop 'Erreur nombre de niveaux !!'
+      else
+       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
+       stop 'Forcing_type should be 0,1,2,3,4,5,6 or 40,59,60,61'
+      ENDIF
+      print*,"forcing type=",forcing_type
+
+! if type_ts_forcing=0, the surface temp of 1D simulation is constant in time
+! (specified by tsurf in lmdz1d.def); if type_ts_forcing=1, the surface temperature
+! varies in time according to a forcing (e.g. forcing_toga) and is passed to read_tsurf1d.F
+! through the common sst_forcing.
+
+        type_ts_forcing = 0
+        if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice)                 &
+     &    type_ts_forcing = 1
+!
+! Initialization of the logical switch for nudging
+     jcode = iflag_nudge
+     do i = 1,nudge_max
+       nudge(i) = mod(jcode,10) .ge. 1
+       jcode = jcode/10
+     enddo
+!---------------------------------------------------------------------
+!  Definition of the run
+!---------------------------------------------------------------------
+
+      call conf_gcm( 99, .TRUE. )
+!-----------------------------------------------------------------------
+!   Choix du calendrier
+!   -------------------
+
+!      calend = 'earth_365d'
+      if (calend == 'earth_360d') then
+        call ioconf_calendar('360d')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
+      else if (calend == 'earth_365d') then
+        call ioconf_calendar('noleap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
+      else if (calend == 'earth_366d') then
+        call ioconf_calendar('all_leap')
+        write(*,*)'CALENDRIER CHOISI: Terrestre bissextile'
+      else if (calend == 'gregorian') then
+        call ioconf_calendar('gregorian') ! not to be used by normal users
+        write(*,*)'CALENDRIER CHOISI: Gregorien'
+      else
+        write (*,*) 'ERROR : unknown calendar ', calend
+        stop 'calend should be 360d,earth_365d,earth_366d,gregorian'
+      endif
+!-----------------------------------------------------------------------
+!
+!c Date :
+!      La date est supposee donnee sous la forme [annee, numero du jour dans 
+!      l annee] ; l heure est donnee dans time_ini, lu dans lmdz1d.def.
+!      On appelle ymds2ju pour convertir [annee, jour] en [jour Julien].
+!      Le numero du jour est dans "day". L heure est traitee separement.
+!      La date complete est dans "daytime" (l'unite est le jour).
+      if (nday>0) then
+         fnday=nday
+      else
+         fnday=-nday/float(day_step)
+      endif
+
+! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
+      IF(forcing_type .EQ. 61) fnday=53100./86400.
+! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
+      IF(forcing_type .EQ. 6) fnday=64800./86400.
+!     IF(forcing_type .EQ. 6) fnday=50400./86400.
+      annee_ref = anneeref
+      mois = 1
+      day_ref = dayref
+      heure = 0.
+      itau_dyn = 0
+      itau_phy = 0
+      call ymds2ju(annee_ref,mois,day_ref,heure,day)
+      day_ini = int(day)
+      day_end = day_ini + fnday
+
+      IF (forcing_type .eq.2) THEN
+! Convert the initial date of Toga-Coare to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
+
+      ELSEIF (forcing_type .eq.4) THEN
+! Convert the initial date of TWPICE to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi              &
+     & ,day_ju_ini_twpi)
+      ELSEIF (forcing_type .eq.6) THEN
+! Convert the initial date of AMMA to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma              &
+     & ,day_ju_ini_amma)
+      ELSEIF (forcing_type .eq.7) THEN
+! Convert the initial date of DICE to Julian day
+      call ymds2ju                                                         &
+     & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             & 
+     & ,day_ju_ini_dice)
+      ELSEIF (forcing_type .eq.10) THEN
+! Convert the initial date to Julian day
+      print*,'time cindy',year_ini_cas,mth_ini_cas,day_ini_cas
+      call ymds2ju                                                         &
+     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas &
+     & ,day_ju_ini_cas)
+      print*,'time cindy 2',day_ju_ini_cas
+      ELSEIF (forcing_type .eq.59) THEN
+! Convert the initial date of Sandu case to Julian day
+      call ymds2ju                                                          &
+     &   (year_ini_sandu,mth_ini_sandu,day_ini_sandu,                       &
+     &    time_ini*3600.,day_ju_ini_sandu)
+
+      ELSEIF (forcing_type .eq.60) THEN
+! Convert the initial date of Astex case to Julian day
+      call ymds2ju                                                          &
+     &   (year_ini_astex,mth_ini_astex,day_ini_astex,                        &
+     &    time_ini*3600.,day_ju_ini_astex)
+
+      ELSEIF (forcing_type .eq.61) THEN
+! Convert the initial date of Arm_cu case to Julian day
+      call ymds2ju                                                          &
+     & (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu          &
+     & ,day_ju_ini_armcu)
+      ENDIF
+
+      daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+! Print out the actual date of the beginning of the simulation :
+      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
+      print *,' Time of beginning : ',                                      &
+     &        year_print, month_print, day_print, sec_print
+
+!---------------------------------------------------------------------
+! Initialization of dimensions, geometry and initial state
+!---------------------------------------------------------------------
+      call init_phys_lmdz(1,1,llm,1,(/1/))
+      call suphel
+      call infotrac_init 
+
+      if (nqtot>nqmx) STOP'Augmenter nqmx dans lmdz1d.F'
+      allocate(q(llm,nqtot)) ; q(:,:)=0.
+      allocate(dq(llm,nqtot)) 
+      allocate(dq_dyn(llm,nqtot)) 
+      allocate(d_q_adv(llm,nqtot)) 
+      allocate(d_q_nudge(llm,nqtot)) 
+!      allocate(d_th_adv(llm)) 
+
+!
+!   No ozone climatology need be read in this pre-initialization
+!          (phys_state_var_init is called again in physiq)
+      read_climoz = 0
+!
+      call phys_state_var_init(read_climoz)
+
+      if (ngrid.ne.klon) then
+         print*,'stop in inifis'
+         print*,'Probleme de dimensions :'
+         print*,'ngrid = ',ngrid
+         print*,'klon  = ',klon
+         stop
+      endif
+!!!=====================================================================
+!!! Feedback forcing values for Gateaux differentiation (al1)
+!!!=====================================================================
+!!! Surface Planck forcing bracketing call radiation
+!!      surf_Planck = 0.
+!!      surf_Conv   = 0.
+!!      write(*,*) 'Gateaux-dif Planck,Conv:',surf_Planck,surf_Conv
+!!! a mettre dans le lmdz1d.def ou autre
+!!
+!!
+      qsol = qsolinp
+      qsurf = fq_sat(tsurf,psurf/100.)
+      rlat=xlat
+      rlon=xlon
+      day1= day_ini
+      time=daytime-day
+      ts_toga(1)=tsurf ! needed by read_tsurf1d.F
+      rho(1)=psurf/(rd*tsurf*(1.+(rv/rd-1.)*qsurf)) 
+
+!
+!! mpl et jyg le 22/08/2012 : 
+!!  pour que les cas a flux de surface imposes marchent
+      IF(.NOT.ok_flux_surf.or.max(abs(wtsurf),abs(wqsurf))>0.) THEN
+       fsens=-wtsurf*rcpd*rho(1)
+       flat=-wqsurf*rlvtt*rho(1)
+       print *,'Flux: ok_flux wtsurf wqsurf',ok_flux_surf,wtsurf,wqsurf
+      ENDIF
+      print*,'Flux sol ',fsens,flat
+!!      ok_flux_surf=.false.
+!!      fsens=-wtsurf*rcpd*rho(1)
+!!      flat=-wqsurf*rlvtt*rho(1)
+!!!!
+
+! Vertical discretization and pressure levels at half and mid levels:
+
+      pa   = 5e4
+!!      preff= 1.01325e5
+      preff = psurf
+      IF (ok_old_disvert) THEN
+        call disvert0(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
+        print *,'On utilise disvert0'
+      ELSE
+        call disvert()
+        print *,'On utilise disvert'
+!       Nouvelle version disvert permettant d imposer ap,bp (modif L.Guez) MPL 18092012
+!       Dans ce cas, on lit ap,bp dans le fichier hybrid.txt
+      ENDIF
+      sig_s=presnivs/preff
+      plev =ap+bp*psurf
+      play = 0.5*(plev(1:llm)+plev(2:llm+1))
+!cc      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
+
+      IF (forcing_type .eq. 59) THEN
+! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
+      write(*,*) '***********************'
+      do l = 1, llm
+       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
+       if (trouve_700 .and. play(l).le.70000) then
+         llm700=l
+         print *,'llm700,play=',llm700,play(l)/100.
+         trouve_700= .false.
+       endif
+      enddo
+      write(*,*) '***********************'
+      ENDIF
+
+!
+!=====================================================================
+! EVENTUALLY, READ FORCING DATA :
+!=====================================================================
+
+#include "1D_read_forc_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in initialization'
+      endif ! forcing_GCM2SCM
+
+      print*,'mxcalc=',mxcalc
+      print*,'zlay=',zlay(mxcalc)
+      print*,'play=',play(mxcalc)
+
+!Al1 pour SST forced, appellé depuis ocean_forced_noice
+      ts_cur = tsurf ! SST used in read_tsurf1d
+!=====================================================================
+! Initialisation de la physique : 
+!=====================================================================
+
+!  Rq: conf_phys.F90 lit tous les flags de physiq.def; conf_phys appele depuis physiq.F
+!
+! day_step, iphysiq lus dans gcm.def ci-dessus
+! timestep: calcule ci-dessous from rday et day_step
+! ngrid=1
+! llm: defini dans .../modipsl/modeles/LMDZ4/libf/grid/dimension
+! rday: defini dans suphel.F (86400.)
+! day_ini: lu dans run.def (dayref)
+! rlat_rad,rlon-rad: transformes en radian de rlat,rlon lus dans lmdz1d.def (en degres)
+! airefi,zcufi,zcvfi initialises au debut de ce programme
+! rday,ra,rg,rd,rcpd declares dans YOMCST.h et calcules dans suphel.F
+      day_step = float(nsplit_phys)*day_step/float(iphysiq)
+      write (*,*) 'Time step divided by nsplit_phys (=',nsplit_phys,')'
+      timestep =rday/day_step
+      dtime_frcg = timestep
+!
+      zcufi=airefi
+      zcvfi=airefi
+!
+      rlat_rad(:)=rlat(:)*rpi/180.
+      rlon_rad(:)=rlon(:)*rpi/180.
+
+      call iniphysiq(iim,jjm,llm,rday,day_ini,timestep,                        &
+     &     rlat_rad,rlon_rad,airefi,zcufi,zcvfi,ra,rg,rd,rcpd,(/1/))
+      print*,'apres iniphysiq'
+
+! 2 PARAMETRES QUI DEVRAIENT ETRE LUS DANS run.def MAIS NE LE SONT PAS ICI:
+      co2_ppm= 330.0
+      solaire=1370.0
+
+! Ecriture du startphy avant le premier appel a la physique.
+! On le met juste avant pour avoir acces a tous les champs
+
+      if (ok_writedem) then
+
+!--------------------------------------------------------------------------
+! pbl_surface_init (called here) and pbl_surface_final (called by phyredem)
+! need : qsol fder snow qsurf evap rugos agesno ftsoil
+!--------------------------------------------------------------------------
+
+        type_ocean = "force"
+        run_off_lic_0(1) = restart_runoff 
+        call fonte_neige_init(run_off_lic_0)
+
+        fder=0.
+        snsrf(1,:)=0.        ! couverture de neige des sous surface
+        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
+        fevap=0.
+        z0m(1,:)=rugos     ! couverture de neige des sous surface
+        z0h(1,:)=rugos     ! couverture de neige des sous surface
+        agesno  = xagesno
+        tsoil(:,:,:)=tsurf
+!------ AMMA 2e run avec modele sol et rayonnement actif (MPL 23052012)
+!       tsoil(1,1,1)=299.18
+!       tsoil(1,2,1)=300.08
+!       tsoil(1,3,1)=301.88
+!       tsoil(1,4,1)=305.48
+!       tsoil(1,5,1)=308.00
+!       tsoil(1,6,1)=308.00
+!       tsoil(1,7,1)=308.00
+!       tsoil(1,8,1)=308.00
+!       tsoil(1,9,1)=308.00
+!       tsoil(1,10,1)=308.00
+!       tsoil(1,11,1)=308.00
+!-----------------------------------------------------------------------
+        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)
+
+!------------------ prepare limit conditions for limit.nc -----------------
+!--   Ocean force
+
+        print*,'avant phyredem'
+        pctsrf(1,:)=0.
+        if (nat_surf.eq.0.) then
+          pctsrf(1,is_oce)=1.
+          pctsrf(1,is_ter)=0.
+        else
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=1.
+        end if
+
+        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
+     &        ,pctsrf(1,is_oce),pctsrf(1,is_ter)
+
+        zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic)
+        zpic = zpicinp
+        ftsol=tsurf
+        nsw=6 ! on met le nb de bandes SW=6, pour initialiser
+              ! 6 albedo, mais on peut quand meme tourner avec
+              ! moins. Seules les 2 ou 4 premiers seront lus
+        falb_dir=albedo
+        falb_dif=albedo
+        rugoro=rugos 
+        t_ancien(1,:)=temp(:)
+        q_ancien(1,:)=q(:,1)
+        pbl_tke=1.e-8
+
+        rain_fall=0.
+        snow_fall=0.
+        solsw=0.
+        sollw=0.
+        radsol=0.
+        rnebcon=0.
+        ratqs=0.
+        clwcon=0.
+        zmea=0.
+        zstd=0.
+        zsig=0.
+        zgam=0.
+        zval=0. 
+        zthe=0. 
+        sig1=0.
+        w01=0.
+        u_ancien(1,:)=u(:)
+        v_ancien(1,:)=v(:)
+ 
+!------------------------------------------------------------------------
+! Make file containing restart for the physics (startphy.nc)
+!
+! NB: List of the variables to be written by phyredem (via put_field):
+! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
+! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
+! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
+! radsol,solsw,sollw,fder,rain_fall,snow_fall,frugs(:,nsrf)
+! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
+! t_ancien,q_ancien,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
+! run_off_lic_0,pbl_tke(:,1:klev,nsrf),zmax0,f0,sig1,w01
+! wake_deltat,wake_deltaq,wake_s,wake_cstar,wake_fip
+!------------------------------------------------------------------------
+!Al1 =============== restart option ==========================
+        if (.not.restart) then
+          call phyredem ("startphy.nc")
+        else
+! (desallocations)
+        print*,'callin surf final'
+          call pbl_surface_final( fder, snsrf, qsurfsrf, tsoil)
+        print*,'after surf final'
+          CALL fonte_neige_final(run_off_lic_0)
+        endif
+
+        ok_writedem=.false.
+        print*,'apres phyredem'
+
+      endif ! ok_writedem
+      
+!------------------------------------------------------------------------
+! Make file containing boundary conditions (limit.nc) **Al1->restartdyn***
+! --------------------------------------------------
+! NB: List of the variables to be written in limit.nc 
+!     (by writelim.F, subroutine of 1DUTILS.h):
+!        phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
+!        phy_fter,phy_foce,phy_flic,phy_fsic)
+!------------------------------------------------------------------------
+      do i=1,yd
+        phy_nat(i)  = nat_surf
+        phy_alb(i)  = albedo
+        phy_sst(i)  = tsurf ! read_tsurf1d will be used instead
+        phy_rug(i)  = rugos
+        phy_fter(i) = pctsrf(1,is_ter)
+        phy_foce(i) = pctsrf(1,is_oce)
+        phy_fsic(i) = pctsrf(1,is_sic)
+        phy_flic(i) = pctsrf(1,is_lic)
+      enddo
+
+! fabrication de limit.nc
+      call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,             &
+     &               phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)
+
+
+      call phys_state_var_end
+!Al1
+      if (restart) then
+        print*,'call to restart dyn 1d'
+        Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs,          &
+     &              u,v,temp,q,omega2)
+
+       print*,'fnday,annee_ref,day_ref,day_ini',                            &
+     &     fnday,annee_ref,day_ref,day_ini
+!**      call ymds2ju(annee_ref,mois,day_ini,heure,day)
+       day = day_ini
+       day_end = day_ini + nday
+       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+
+! Print out the actual date of the beginning of the simulation :
+       call ju2ymds(daytime, an, mois, jour, heure)
+       print *,' Time of beginning : y m d h',an, mois,jour,heure/3600.
+
+       day = int(daytime)
+       time=daytime-day
+  
+       print*,'****** intialised fields from restart1dyn *******'
+       print*,'plev,play,phi,phis,presnivs,u,v,temp,q,omega2'
+       print*,'temp(1),q(1,1),u(1),v(1),plev(1),phis :'
+       print*,temp(1),q(1,1),u(1),v(1),plev(1),phis
+! raz for safety
+       do l=1,llm
+         dq_dyn(l,1) = 0.
+       enddo
+      endif
+!Al1 ================  end restart =================================
+      IF (ecrit_slab_oc.eq.1) then
+         open(97,file='div_slab.dat',STATUS='UNKNOWN')
+       elseif (ecrit_slab_oc.eq.0) then
+         open(97,file='div_slab.dat',STATUS='OLD')
+       endif
+!
+!---------------------------------------------------------------------
+!    Initialize target profile for RHT nudging if needed
+!---------------------------------------------------------------------
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT_init(plev,play,temp,q(:,1),t_targ,rh_targ)
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV_init(plev,play,u,v,u_targ,v_targ)
+      endif
+!
+!=====================================================================
+! START OF THE TEMPORAL LOOP :
+!=====================================================================
+           
+      do while(it.le.nint(fnday*day_step))
+
+       if (prt_level.ge.1) then
+         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
+     &                                it,day,time,nint(fnday*day_step)
+         print*,'PAS DE TEMPS ',timestep
+       endif
+!Al1 demande de restartphy.nc
+       if (it.eq.nint(fnday*day_step)) lastcall=.True.
+
+!---------------------------------------------------------------------
+! Interpolation of forcings in time and onto model levels
+!---------------------------------------------------------------------
+
+#include "1D_interp_cases.h"
+
+      if (forcing_GCM2SCM) then
+        write (*,*) 'forcing_GCM2SCM not yet implemented'
+        stop 'in time loop'
+      endif ! forcing_GCM2SCM
+
+!---------------------------------------------------------------------
+!  Geopotential :
+!---------------------------------------------------------------------
+
+        phi(1)=RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+        do l = 1, llm-1
+          phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))*                           &
+     &    (play(l)-play(l+1))/(play(l)+play(l+1))
+        enddo
+
+!---------------------------------------------------------------------
+! Listing output for debug prt_level>=1
+!---------------------------------------------------------------------
+       if (prt_level>=1) then
+         print *,' avant physiq : -------- day time ',day,time
+         write(*,*) 'firstcall,lastcall,phis',                               &
+     &               firstcall,lastcall,phis
+         write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l',                   &
+     &        'presniv','plev','play','phi'
+         write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l,                   &
+     &         presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+         write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l',                    &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+         write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l,         &
+     &   presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+       endif
+
+!---------------------------------------------------------------------
+!   Call physiq :
+!---------------------------------------------------------------------
+
+        call physiq(ngrid,llm,                                              &
+     &              firstcall,lastcall,                                     &
+     &              day,time,timestep,                                      &
+     &              plev,play,phi,phis,presnivs,                            &
+     &              u,v,temp,q,omega2,                                      &
+     &              du_phys,dv_phys,dt_phys,dq,dpsrf,                        &
+     &              dudyn)
+        firstcall=.false.
+
+!---------------------------------------------------------------------
+! Listing output for debug prt_level>=1
+!---------------------------------------------------------------------
+        if (prt_level>=1) then
+          write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l',                  &
+     &        'presniv','plev','play','phi'
+          write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l,                  &
+     &    presnivs(l),plev(l),play(l),phi(l),l=1,llm)
+          write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l',                   &
+     &         'presniv','u','v','temp','q1','q2','omega2'
+          write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l,       &
+     &    presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)
+          write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l',                   &
+     &         'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'    
+           write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l,            &
+     &      presnivs(l),86400*du_phys(l),86400*dv_phys(l),                   &
+     &       86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)
+          write(*,*) 'dpsrf',dpsrf
+        endif
+!---------------------------------------------------------------------
+!   Add physical tendencies :
+!---------------------------------------------------------------------
+
+       fcoriolis=2.*sin(rpi*xlat/180.)*romega
+       if (forcing_radconv .or. forcing_fire) then
+         fcoriolis=0.0
+         dt_cooling=0.0
+         d_th_adv=0.0
+         d_q_adv=0.0
+       endif
+
+       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
+     &    .or.forcing_amma) then
+         fcoriolis=0.0 ; ug=0. ; vg=0.
+       endif
+         if(forcing_rico) then
+          dt_cooling=0.
+        endif
+
+      print*, 'fcoriolis ', fcoriolis, xlat
+
+        du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+       dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+
+!!!!!!!!!!!!!!!!!!!!!!!!
+! Geostrophic wind
+!!!!!!!!!!!!!!!!!!!!!!!!
+       sfdt = sin(0.5*fcoriolis*timestep)
+       cfdt = cos(0.5*fcoriolis*timestep)
+!
+        du_age(1:mxcalc)= -2.*sfdt/timestep*                                &
+     &          (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) -                          &
+     &           cfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+!
+       dv_age(1:mxcalc)= -2.*sfdt/timestep*                                 &
+     &          (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) +                           &
+     &           sfdt*(v(1:mxcalc)-vg(1:mxcalc))  )
+!!     : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+!
+!!!!!!!!!!!!!!!!!!!!!!!!
+!  Nudging
+!!!!!!!!!!!!!!!!!!!!!!!!
+      d_t_nudge(:) = 0.
+      d_q_nudge(:,:) = 0.
+      d_u_nudge(:) = 0.
+      d_v_nudge(:) = 0.
+      if (nudge(inudge_RHT)) then
+        call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1),     &
+    &                  d_t_nudge,d_q_nudge(:,1))
+      endif
+      if (nudge(inudge_UV)) then
+        call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v,     &
+    &                  d_u_nudge,d_v_nudge)
+      endif
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!         call  writefield_phy('dv_age' ,dv_age,llm)
+!         call  writefield_phy('du_age' ,du_age,llm)
+!         call  writefield_phy('du_phys' ,du_phys,llm)
+!         call  writefield_phy('u_tend' ,u,llm)
+!         call  writefield_phy('u_g' ,ug,llm)
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Increment state variables
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! pour les cas sandu et astex, on reclacule u,v,q,temp et teta dans 1D_nudge_sandu_astex.h
+! au dessus de 700hpa, on relaxe vers les profils initiaux
+      if (forcing_sandu .OR. forcing_astex) then
+#include "1D_nudge_sandu_astex.h"
+      else
+        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
+     &              du_phys(1:mxcalc)                                       &
+     &             +du_age(1:mxcalc)+du_adv(1:mxcalc)                       &
+     &             +d_u_nudge(1:mxcalc) )            
+        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
+     &              dv_phys(1:mxcalc)                                       &
+     &             +dv_age(1:mxcalc)+dv_adv(1:mxcalc)                       &
+     &             +d_v_nudge(1:mxcalc) )
+        q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*(                              &
+     &                dq(1:mxcalc,:)                                        &
+     &               +d_q_adv(1:mxcalc,:)                                   &
+     &               +d_q_nudge(1:mxcalc,:) )
+
+        if (prt_level.ge.1) then
+          print *,                                                          &
+     &    'physiq-> temp(1),dt_phys(1),d_th_adv(1),dt_cooling(1) ',         &
+     &              temp(1),dt_phys(1),d_th_adv(1),dt_cooling(1)
+           print*,du_phys
+           print*, v
+           print*, vg
+        endif
+
+        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
+     &              dt_phys(1:mxcalc)                                       &
+     &             +d_th_adv(1:mxcalc)                                      &
+     &             +d_t_nudge(1:mxcalc)                                      &
+     &             +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+      endif  ! forcing_sandu or forcing_astex
+
+        teta=temp*(pzero/play)**rkappa
+!
+!---------------------------------------------------------------------
+!   Nudge soil temperature if requested
+!---------------------------------------------------------------------
+
+      IF (nudge_tsoil) THEN
+       ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:)                     &
+     &  -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)
+      ENDIF
+
+!---------------------------------------------------------------------
+!   Add large-scale tendencies (advection, etc) :
+!---------------------------------------------------------------------
+
+!cc nrlmd
+!cc        tmpvar=teta
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc
+!cc        teta(1:mxcalc)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,1)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,1)=tmpvar(1:mxcalc)
+!cc        tmpvar(:)=q(:,2)
+!cc        call advect_vert(llm,omega,timestep,tmpvar,plev)
+!cc        q(1:mxcalc,2)=tmpvar(1:mxcalc)
+
+!---------------------------------------------------------------------
+!   Air temperature :
+!---------------------------------------------------------------------        
+        if (lastcall) then
+          print*,'Pas de temps final ',it
+          call ju2ymds(daytime, an, mois, jour, heure)
+          print*,'a la date : a m j h',an, mois, jour ,heure/3600.
+        endif
+
+!  incremente day time
+!        print*,'daytime bef',daytime,1./day_step
+        daytime = daytime+1./day_step
+!Al1dbg
+        day = int(daytime+0.1/day_step)
+!        time = max(daytime-day,0.0)
+!Al1&jyg: correction de bug
+!cc        time = real(mod(it,day_step))/day_step
+        time = time_ini/24.+real(mod(it,day_step))/day_step
+!        print*,'daytime nxt time',daytime,time
+        it=it+1
+
+      enddo
+
+!Al1
+      if (ecrit_slab_oc.ne.-1) close(97)
+
+!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
+! -------------------------------------
+       call dyn1dredem("restart1dyn.nc",                                    &
+     &              plev,play,phi,phis,presnivs,                            &
+     &              u,v,temp,q,omega2)
+
+        CALL abort_gcm ('lmdz1d   ','The End  ',0)
+
+      end
+
+#include "1DUTILS.h"
+#include "1Dconv.h"
+
+!#endif
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/logic.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/logic.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/logic.h	(revision 3815)
@@ -0,0 +1,26 @@
+!
+! $Id: logic.h 1984 2014-02-18 09:59:29Z emillour $
+!
+!
+! NB: keep items of different kinds in seperate common blocs to avoid
+!     "misaligned commons" issues
+!-----------------------------------------------------------------------
+! INCLUDE 'logic.h'
+
+      COMMON/logicl/ purmats,forward,leapf,apphys,                      &
+     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
+     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
+     &  ,ok_limit,ok_etat0,hybrid
+
+      COMMON/logici/ iflag_phys,iflag_trac
+      
+      LOGICAL purmats,forward,leapf,apphys,statcl,conser,               &
+     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
+     &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
+     &  ,ok_limit,ok_etat0
+     
+      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
+                     ! (only used if disvert_type==2)
+
+      integer iflag_phys,iflag_trac
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_const_mpi.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_const_mpi.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_const_mpi.F90	(revision 3815)
@@ -0,0 +1,16 @@
+MODULE mod_const_mpi
+
+  INTEGER :: COMM_LMDZ
+  INTEGER :: MPI_REAL_LMDZ
+ 
+
+CONTAINS 
+
+  SUBROUTINE Init_const_mpi
+  IMPLICIT NONE
+  
+    COMM_LMDZ=0
+    MPI_REAL_LMDZ=0
+  END SUBROUTINE Init_const_mpi
+
+END MODULE mod_const_mpi
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_grid_phy_lmdz.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_grid_phy_lmdz.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_grid_phy_lmdz.F90	(revision 3815)
@@ -0,0 +1,454 @@
+!
+!$Id $
+!
+MODULE mod_grid_phy_lmdz
+
+  PUBLIC
+  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
+             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
+  
+  INTEGER,SAVE :: nbp_lon  ! == iim
+  INTEGER,SAVE :: nbp_lat  ! == jjmp1
+  INTEGER,SAVE :: nbp_lev  ! == llm
+  INTEGER,SAVE :: klon_glo
+
+  INTERFACE grid1dTo2d_glo
+    MODULE PROCEDURE grid1dTo2d_glo_i,grid1dTo2d_glo_i1,grid1dTo2d_glo_i2,grid1dTo2d_glo_i3, &
+                     grid1dTo2d_glo_r,grid1dTo2d_glo_r1,grid1dTo2d_glo_r2,grid1dTo2d_glo_r3, &
+		     grid1dTo2d_glo_l,grid1dTo2d_glo_l1,grid1dTo2d_glo_l2,grid1dTo2d_glo_l3
+   END INTERFACE 
+
+   INTERFACE grid2dTo1d_glo
+    MODULE PROCEDURE grid2dTo1d_glo_i,grid2dTo1d_glo_i1,grid2dTo1d_glo_i2,grid2dTo1d_glo_i3, &
+                     grid2dTo1d_glo_r,grid2dTo1d_glo_r1,grid2dTo1d_glo_r2,grid2dTo1d_glo_r3, &
+		     grid2dTo1d_glo_l,grid2dTo1d_glo_l1,grid2dTo1d_glo_l2,grid2dTo1d_glo_l3
+   END INTERFACE 
+ 
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE Init_grid_phy_lmdz(iim,jjp1,llm)
+  IMPLICIT NONE
+  INTEGER, INTENT(in) :: iim
+  INTEGER, INTENT(in) :: jjp1
+  INTEGER, INTENT(in) :: llm
+  
+    nbp_lon=iim
+    nbp_lat=jjp1
+    nbp_lev=llm
+    klon_glo=(iim*jjp1)-2*(iim-1)
+  
+  END SUBROUTINE Init_grid_phy_lmdz
+  
+  
+  SUBROUTINE grid1dTo2d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_i
+  
+
+  SUBROUTINE grid1dTo2d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_i1
+
+  SUBROUTINE grid1dTo2d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_i2
+  
+  SUBROUTINE grid1dTo2d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_i3
+
+
+  SUBROUTINE grid1dTo2d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_r
+  
+
+  SUBROUTINE grid1dTo2d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_r1
+
+  SUBROUTINE grid1dTo2d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_r2
+  
+  SUBROUTINE grid1dTo2d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_glo_l
+  
+
+  SUBROUTINE grid1dTo2d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_glo_l1
+
+  SUBROUTINE grid1dTo2d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_glo_l2
+  
+  SUBROUTINE grid1dTo2d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_glo_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_glo_l3  
+  
+    SUBROUTINE grid2dTo1d_glo_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_i
+  
+
+  SUBROUTINE grid2dTo1d_glo_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_i1
+
+  SUBROUTINE grid2dTo1d_glo_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_i2
+  
+  SUBROUTINE grid2dTo1d_glo_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_glo_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_r
+  
+
+  SUBROUTINE grid2dTo1d_glo_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_r1
+
+  SUBROUTINE grid2dTo1d_glo_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_r2
+  
+  SUBROUTINE grid2dTo1d_glo_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_r3
+
+
+
+  SUBROUTINE grid2dTo1d_glo_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_glo_l
+  
+
+  SUBROUTINE grid2dTo1d_glo_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_glo_l1
+
+  SUBROUTINE grid2dTo1d_glo_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_glo_l2
+  
+  SUBROUTINE grid2dTo1d_glo_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_glo_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_glo_l3
+
+!---------------------------------------------------------------- 
+!  Generic (private) fonctions
+!---------------------------------------------------------------- 
+  
+  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_igen   
+
+
+  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+   
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_rgen   
+
+  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_glo,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*nbp_lat,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    Offset=nbp_lon
+        
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=1,nbp_lon
+       VarOut(ij,i)=VarIn(1,i)
+      ENDDO
+    ENDDO
+    
+    
+    DO i=1,dimsize
+      DO ij=nbp_lon*(nbp_lat-1)+1,nbp_lat*nbp_lon
+       VarOut(ij,i)=VarIn(klon_glo,i)
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE grid1dTo2d_glo_lgen     
+  
+  
+  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_igen   
+  
+  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_rgen 
+    
+  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*nbp_lat,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_glo
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    DO i=1,dimsize
+      VarOut(1,i)=VarIn(1,i)
+    ENDDO
+    
+  END SUBROUTINE grid2dTo1d_glo_lgen   
+
+END MODULE mod_grid_phy_lmdz
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_data.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_data.F90	(revision 3815)
@@ -0,0 +1,203 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+       klon_glo=iim*(jjp1-2)+2
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+  INCLUDE "iniprint.h" 
+  
+    WRITE(lunout,*) 'ii_begin =', ii_begin
+    WRITE(lunout,*) 'ii_end =', ii_end
+    WRITE(lunout,*) 'jj_begin =',jj_begin
+    WRITE(lunout,*) 'jj_end =', jj_end
+    WRITE(lunout,*) 'jj_nb =', jj_nb
+    WRITE(lunout,*) 'ij_begin =', ij_begin
+    WRITE(lunout,*) 'ij_end =', ij_end
+    WRITE(lunout,*) 'ij_nb =', ij_nb
+    WRITE(lunout,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(lunout,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(lunout,*) 'klon_mpi =', klon_mpi
+    WRITE(lunout,*) 'jj_para_nb =', jj_para_nb
+    WRITE(lunout,*) 'jj_para_begin =', jj_para_begin
+    WRITE(lunout,*) 'jj_para_end =', jj_para_end
+    WRITE(lunout,*) 'ii_para_begin =', ii_para_begin
+    WRITE(lunout,*) 'ii_para_end =', ii_para_end
+    WRITE(lunout,*) 'ij_para_nb =', ij_para_nb
+    WRITE(lunout,*) 'ij_para_begin =', ij_para_begin
+    WRITE(lunout,*) 'ij_para_end =', ij_para_end
+    WRITE(lunout,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(lunout,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(lunout,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(lunout,*) 'mpi_rank =', mpi_rank
+    WRITE(lunout,*) 'mpi_size =', mpi_size
+    WRITE(lunout,*) 'mpi_root =', mpi_root
+    WRITE(lunout,*) 'is_mpi_root =', is_mpi_root
+    WRITE(lunout,*) 'is_north_pole =', is_north_pole
+    WRITE(lunout,*) 'is_south_pole =', is_south_pole
+    WRITE(lunout,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_mpi_transfert.F90	(revision 3815)
@@ -0,0 +1,1902 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_transfert
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+                     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+                     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_mpi
+    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+                     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D_mpi
+    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+                     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+                     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum_mpi
+    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE 
+
+ INTERFACE grid1dTo2d_mpi
+    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
+                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
+                     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
+ END INTERFACE 
+
+ INTERFACE grid2dTo1d_mpi
+    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
+                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
+                     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
+ END INTERFACE 
+    
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL scatter_mpi_igen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
+    
+  END SUBROUTINE scatter_mpi_i1
+  
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,1)
+  
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_r1
+  
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_l1
+  
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_i
+  
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i2
+  
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_R
+
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r1
+
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r2
+  
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_r3
+  
+  
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l
+
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE scatter2D_mpi_l1
+
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+  
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l2
+  
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i2
+  
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+ 
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i3
+
+
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r2
+  
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r3
+
+  
+  
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l2
+  
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i4                  
+  
+  
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+     
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r4 
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_i
+  
+
+  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i1
+
+  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i2
+  
+  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i3
+
+
+  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_r
+  
+
+  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r1
+
+  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r2
+  
+  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_l
+  
+
+  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l1
+
+  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l2
+  
+  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l3
+
+
+  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_i
+  
+
+  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i1
+
+  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i2
+  
+  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_r
+  
+
+  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r1
+
+  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r2
+  
+  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r3
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_l
+  
+
+  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l1
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l2
+
+  
+  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l3
+
+               
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+    
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: nb
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: nb
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE bcast_mpi_lgen
+
+  
+
+  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
+                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_igen
+
+  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+
+#endif
+
+  END SUBROUTINE scatter_mpi_rgen
+
+  
+  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_lgen  
+
+
+
+
+  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        Index=Index+nb*dimsize
+      ENDDO
+     
+    ENDIF
+    
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
+                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+                          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_igen  
+
+  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+                          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_rgen  
+
+  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+                          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_lgen
+  
+
+
+  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+   
+    INTEGER,INTENT(IN) :: nb
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER :: ierr
+   
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+
+
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+            
+  END SUBROUTINE reduce_sum_mpi_igen
+  
+  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+
+    IMPLICIT NONE
+
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: nb
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER :: ierr
+ 
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+   
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE reduce_sum_mpi_rgen
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE grid1dTo2d_mpi_igen   
+
+
+  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+        ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_rgen   
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=.FALSE.
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+        ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_lgen   
+
+  
+
+
+  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_igen   
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+         VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_rgen   
+  
+
+  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_lgen   
+
+END MODULE mod_phys_lmdz_mpi_transfert
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_data.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_data.F90	(revision 3815)
@@ -0,0 +1,109 @@
+!
+!$Id: mod_phys_lmdz_omp_data.F90 2239 2015-03-23 07:27:30Z emillour $
+!
+MODULE mod_phys_lmdz_omp_data
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_using_omp
+  
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
+  
+  INTEGER,SAVE :: klon_omp
+  INTEGER,SAVE :: klon_omp_begin
+  INTEGER,SAVE :: klon_omp_end
+!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
+
+CONTAINS
+  
+  SUBROUTINE Init_phys_lmdz_omp_data(klon_mpi)
+    USE dimphy
+    IMPLICIT NONE
+    INTEGER, INTENT(in) :: klon_mpi
+
+    INTEGER :: i
+
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
+#ifdef CPP_OMP    
+    INTEGER :: OMP_GET_NUM_THREADS
+    EXTERNAL OMP_GET_NUM_THREADS
+    INTEGER :: OMP_GET_THREAD_NUM
+    EXTERNAL OMP_GET_THREAD_NUM
+#endif  
+
+#ifdef CPP_OMP
+!$OMP MASTER
+        is_using_omp=.TRUE.
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+    is_using_omp=.FALSE.
+    omp_size=1
+    omp_rank=0
+#endif
+
+   is_omp_root=.FALSE.
+!$OMP MASTER
+   IF (omp_rank==0) THEN
+     is_omp_root=.TRUE.
+   ELSE
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
+   ENDIF
+!$OMP END MASTER
+
+
+!$OMP MASTER 
+    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
+    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
+    ALLOCATE(klon_omp_para_end(0:omp_size-1))
+    
+    DO i=0,omp_size-1
+      klon_omp_para_nb(i)=klon_mpi/omp_size
+      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
+    ENDDO
+    
+    klon_omp_para_begin(0) = 1
+    klon_omp_para_end(0) = klon_omp_para_nb(0)
+    
+    DO i=1,omp_size-1
+      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
+      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+   
+    klon_omp=klon_omp_para_nb(omp_rank)
+    klon_omp_begin=klon_omp_para_begin(omp_rank)
+    klon_omp_end=klon_omp_para_end(omp_rank)
+    
+    CALL Print_module_data
+    
+  END SUBROUTINE Init_phys_lmdz_omp_data
+
+  SUBROUTINE Print_module_data
+  IMPLICIT NONE
+  INCLUDE "iniprint.h"
+
+!$OMP CRITICAL  
+  WRITE(lunout,*)'--------> TASK ',omp_rank
+  WRITE(lunout,*)'omp_size =',omp_size
+  WRITE(lunout,*)'omp_rank =',omp_rank
+  WRITE(lunout,*)'is_omp_root =',is_omp_root
+  WRITE(lunout,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(lunout,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(lunout,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(lunout,*)'klon_omp =',klon_omp
+  WRITE(lunout,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(lunout,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE Print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_omp_transfert.F90	(revision 3815)
@@ -0,0 +1,1064 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_omp_transfert
+
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+                     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+                     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_omp
+    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+                     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+  
+  
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, omp_barrier
+
+CONTAINS
+
+  SUBROUTINE omp_barrier
+  IMPLICIT NONE
+
+!$OMP BARRIER
+
+  END SUBROUTINE omp_barrier
+  
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE scatter_omp_i
+
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
+    
+  END SUBROUTINE scatter_omp_i1
+  
+  
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
+
+  END SUBROUTINE scatter_omp_i2
+
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
+  
+  END SUBROUTINE scatter_omp_i3
+
+
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE scatter_omp_r
+
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
+        
+  END SUBROUTINE scatter_omp_r1
+  
+  
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
+
+  END SUBROUTINE scatter_omp_r2
+
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
+  
+  END SUBROUTINE scatter_omp_r3
+  
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE scatter_omp_l
+
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
+    
+  END SUBROUTINE scatter_omp_l1
+  
+  
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
+
+  END SUBROUTINE scatter_omp_l2
+
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
+  
+  END SUBROUTINE scatter_omp_l3  
+  
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
+    
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
+          
+  END SUBROUTINE gather_omp_i2
+  
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
+    
+  END SUBROUTINE gather_omp_i3
+
+
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+        
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    
+  END SUBROUTINE gather_omp_r2
+  
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))       
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
+    
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
+    
+  END SUBROUTINE gather_omp_l2
+  
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
+    
+  END SUBROUTINE gather_omp_l3
+
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: Nb
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: Nb
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: Nb
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+
+
+  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+    USE mod_phys_lmdz_omp_data
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+ 
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+ 
+  END SUBROUTINE scatter_omp_igen
+
+
+  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_rgen
+
+
+  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+ !$OMP MASTER 
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_lgen
+
+
+
+
+
+  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_igen
+
+
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_lgen
+
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+END MODULE mod_phys_lmdz_omp_transfert
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_para.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_para.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_para.F90	(revision 3815)
@@ -0,0 +1,113 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_para
+  USE mod_phys_lmdz_transfert_para
+  USE mod_phys_lmdz_mpi_data
+  USE mod_phys_lmdz_omp_data
+    
+  INTEGER,SAVE :: klon_loc
+  LOGICAL,SAVE :: is_sequential
+  LOGICAL,SAVE :: is_parallel
+  LOGICAL,SAVE :: is_master
+  
+!$OMP THREADPRIVATE(klon_loc,is_master)
+  
+CONTAINS
+
+  SUBROUTINE Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+    CALL Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL Init_phys_lmdz_omp_data(klon_mpi)
+    klon_loc=klon_omp
+    IF (is_mpi_root .AND. is_omp_root) THEN 
+       is_master=.TRUE.
+     ELSE
+       is_master=.FALSE.
+     ENDIF
+     CALL Test_transfert
+!$OMP END PARALLEL    
+     IF (is_using_mpi .OR. is_using_omp) THEN
+       is_sequential=.FALSE.
+       is_parallel=.TRUE.
+     ELSE
+       is_sequential=.TRUE.
+       is_parallel=.FALSE.
+     ENDIF
+      
+  END SUBROUTINE Init_phys_lmdz_para
+
+  SUBROUTINE Test_transfert
+  USE mod_grid_phy_lmdz
+  IMPLICIT NONE
+    INCLUDE "iniprint.h"
+ 
+    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
+    REAL :: tmp1d_glo(klon_glo,nbp_lev)
+    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
+    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
+    REAL :: CheckSum
+    
+    INTEGER :: i,l
+  
+    Test_Field1d_glo = 0.
+    Test_Field2d_glo = 0.
+    Test_Field1d_loc = 0.
+    Test_Field2d_loc = 0.
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER
+      DO l=1,nbp_lev
+        DO i=1,klon_glo
+!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
+           Test_Field1d_glo(i,l)=1
+        ENDDO
+      ENDDO
+!$OMP END MASTER  
+    ENDIF
+  
+    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
+    CALL Gather(Test_Field1d_loc,tmp1d_glo)
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
+    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
+    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
+    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+
+    CALL bcast(Test_Field1d_glo)
+    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE Test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_transfert_para.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/mod_phys_lmdz_transfert_para.F90	(revision 3815)
@@ -0,0 +1,1275 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_transfert_para
+
+  USE mod_phys_lmdz_mpi_transfert
+  USE mod_phys_lmdz_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i
+
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i1
+  
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i2  
+
+
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i3
+  
+
+!!!!! --> Les reels
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r
+
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r1
+  
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r2  
+
+
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r3
+    
+    
+!!!!! --> Les booleens
+
+
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l
+
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l1
+  
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l2  
+
+
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i
+  
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i1
+
+  
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i2
+
+
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r
+  
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r1
+
+  
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r2
+
+
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r3
+  
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l
+  
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l1
+
+  
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l2
+
+
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l3
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_phys_lmdz_transfert_para
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/paramet.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/paramet.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/paramet.h	(revision 3815)
@@ -0,0 +1,29 @@
+!
+! $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 'paramet.h'
+
+      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
+      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
+      INTEGER  ijmllm,mvar
+      INTEGER jcfil,jcfllm
+
+      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
+     &    ,jjp1=jjm+1-1/jjm)
+      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
+      PARAMETER( kftd  = iim/2 -ndm )
+      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
+      PARAMETER( ip1jmi1= ip1jm - iip1 )
+      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
+      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
+      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
+
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/q_sat.F
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/q_sat.F	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/q_sat.F	(revision 3815)
@@ -0,0 +1,72 @@
+!
+! $Header$
+!
+!
+!
+
+      subroutine q_sat(np,temp,pres,qsat)
+!
+      IMPLICIT none
+!======================================================================
+! Autheur(s): Z.X. Li (LMD/CNRS)
+!  reecriture vectorisee par F. Hourdin.
+! Objet: calculer la vapeur d'eau saturante (formule Centre Euro.)
+!======================================================================
+! Arguments:
+! kelvin---input-R: temperature en Kelvin
+! millibar--input-R: pression en mb
+!
+! q_sat----output-R: vapeur d'eau saturante en kg/kg
+!======================================================================
+!
+      integer np
+      REAL temp(np),pres(np),qsat(np)
+!
+      REAL r2es
+      PARAMETER (r2es=611.14 *18.0153/28.9644)
+!
+      REAL r3les, r3ies, r3es
+      PARAMETER (R3LES=17.269)
+      PARAMETER (R3IES=21.875)
+!
+      REAL r4les, r4ies, r4es
+      PARAMETER (R4LES=35.86)
+      PARAMETER (R4IES=7.66)
+!
+      REAL rtt
+      PARAMETER (rtt=273.16)
+!
+      REAL retv
+      PARAMETER (retv=28.9644/18.0153 - 1.0)
+
+      real zqsat
+      integer ip
+!
+!     ------------------------------------------------------------------
+!
+!
+
+      do ip=1,np
+
+!      write(*,*)'kelvin,millibar=',kelvin,millibar
+!       write(*,*)'temp,pres=',temp(ip),pres(ip)
+!
+         IF (temp(ip) .LE. rtt) THEN
+            r3es = r3ies
+            r4es = r4ies
+         ELSE
+            r3es = r3les
+            r4es = r4les
+         ENDIF
+!
+         zqsat=r2es/pres(ip)*EXP(r3es*(temp(ip)-rtt)/(temp(ip)-r4es))
+         zqsat=MIN(0.5,ZQSAT)
+         zqsat=zqsat/(1.-retv *zqsat)
+!
+         qsat(ip)= zqsat
+!      write(*,*)'qsat=',qsat(ip)
+
+      enddo
+!
+      RETURN
+      END
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/serre.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/serre.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/serre.h	(revision 3815)
@@ -0,0 +1,11 @@
+!
+! $Header$
+!
+!c
+!c
+!c..include serre.h
+!c
+       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
+       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
+     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/temps.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/temps.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/temps.h	(revision 3815)
@@ -0,0 +1,26 @@
+!
+! $Id: temps.h 1907 2013-11-26 13:10:46Z lguez $
+!
+!  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)
+!
+!
+! jD_ref = jour julien de la date de reference (lancement de l'experience)
+! hD_ref = "heure" julienne de la date de reference
+!-----------------------------------------------------------------------
+! INCLUDE 'temps.h'
+
+      COMMON/temps/ dt, jD_ref, jH_ref, start_time,                     &
+     &             day_ini, day_end, annee_ref, day_ref,                &
+     &             itau_dyn, itau_phy, itaufin, calend
+
+
+      INTEGER   itaufin
+      INTEGER itau_dyn, itau_phy 
+      INTEGER day_ini, day_end, annee_ref, day_ref
+      REAL      dt, jD_ref, jH_ref, start_time
+      CHARACTER (len=10) :: calend
+
+!-----------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/tracstoke.h
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/tracstoke.h	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/tracstoke.h	(revision 3815)
@@ -0,0 +1,5 @@
+!
+! $Header$
+!
+      common /tracstoke/istdyn,istphy,unittrac
+      integer istdyn,istphy,unittrac
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/write_field.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/write_field.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/dyn1d/write_field.F90	(revision 3815)
@@ -0,0 +1,326 @@
+!
+! $Id: write_field.F90 2239 2015-03-23 07:27:30Z emillour $
+!
+module write_field
+implicit none
+
+  integer, parameter :: MaxWriteField = 100
+  integer, dimension(MaxWriteField),save :: FieldId
+  integer, dimension(MaxWriteField),save :: FieldVarId
+  integer, dimension(MaxWriteField),save :: FieldIndex
+  character(len=255), dimension(MaxWriteField) ::  FieldName 
+   
+  integer,save :: NbField = 0
+  
+  interface WriteField
+    module procedure WriteField3d,WriteField2d,WriteField1d
+  end interface WriteField
+  contains
+  
+    function GetFieldIndex(name)
+    implicit none
+      integer          :: GetFieldindex
+      character(len=*) :: name
+    
+      character(len=255) :: TrueName
+      integer            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      do i=1,NbField
+        if (TrueName==FieldName(i)) then
+          GetFieldIndex=i
+          exit
+        endif
+      enddo
+    end function GetFieldIndex
+ 
+    subroutine WriteField3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3))  
+  
+    end subroutine WriteField3d
+    
+    subroutine WriteField2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),Dim(2),1)  
+  
+    end subroutine WriteField2d
+    
+    subroutine WriteField1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,Dim(1),1,1)  
+  
+    end subroutine WriteField1d
+        
+    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
+    implicit none
+    include 'netcdf.inc'
+      character(len=*) :: name
+      integer :: dimx,dimy,dimz
+      real,dimension(dimx,dimy,dimz) :: Field
+      integer,dimension(dimx*dimy*dimz) :: ndex
+      integer :: status
+      integer :: index
+      integer :: start(4)
+      integer :: count(4)
+      
+           
+      Index=GetFieldIndex(name)
+      if (Index==-1) then
+        call CreateNewField(name,dimx,dimy,dimz)
+	Index=GetFieldIndex(name)
+      else
+        FieldIndex(Index)=FieldIndex(Index)+1.
+      endif
+      
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=FieldIndex(Index)
+
+      count(1)=dimx
+      count(2)=dimy
+      count(3)=dimz
+      count(4)=1
+
+      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
+      status = NF_SYNC(FieldId(Index))
+      
+    end subroutine WriteField_gen
+       
+    subroutine CreateNewField(name,dimx,dimy,dimz)
+    implicit none
+    include 'netcdf.inc'  
+      character(len=*) :: name
+      integer :: dimx,dimy,dimz
+      integer :: TabDim(4)
+      integer :: status
+      
+      
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      
+      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
+      status = NF_DEF_DIM(FieldId(NbField),'X',dimx,TabDim(1))
+      status = NF_DEF_DIM(FieldId(NbField),'Y',dimy,TabDim(2))
+      status = NF_DEF_DIM(FieldId(NbField),'Z',dimz,TabDim(3))
+      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(4))
+      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,4,TabDim,FieldVarId(NbField))
+      status = NF_ENDDEF(FieldId(NbField))
+
+    end subroutine CreateNewField
+    
+    
+    
+  subroutine write_field1D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=1
+    character(len=*)   :: name
+    real, dimension(:) :: Field
+    real, dimension(:),allocatable :: New_Field
+    character(len=20) :: str
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos
+    character(len=255) :: form
+    character(len=255) :: MaxLen
+    
+    
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'",//)')
+    Dim=shape(Field)
+    MaxLen=int2str(len(trim(int2str(Dim(1)))))
+    ColumnSize=20+6+3+len(trim(int2str(Dim(1))))
+    Nb=0
+    Pos=2
+    do i=1,Dim(1)
+      nb=nb+1
+      
+      if (MOD(nb,NbCol)==0) then
+        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16,/)'
+        Pos=2
+      else
+        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16," | ",)'
+        Pos=Pos+ColumnSize
+      endif
+      write (id,form,advance='no') i,Field(i)
+    enddo
+     
+    close(id)
+
+  end subroutine write_field1D
+
+  subroutine write_field2D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=2
+    character(len=*)   :: name
+    real, dimension(:,:) :: Field
+    real, dimension(:,:),allocatable :: New_Field
+    character(len=20) :: str
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,j,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos,offset
+    character(len=255) :: form
+    character(len=255) :: spacing
+    
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'",//)')
+    
+    Dim=shape(Field)
+    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+3
+    ColumnSize=20+6+3+offset
+
+    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
+    
+    do i=1,Dim(2)
+      nb=0
+      Pos=2
+      do j=1,Dim(1)
+        nb=nb+1
+      
+        if (MOD(nb,NbCol)==0) then
+          form='(t'//trim(int2str(pos))//            &
+               ',"('//trim(int2str(j))//','          &
+                    //trim(int2str(i))//')",t'       & 
+                    //trim(int2str(pos+offset))     &    
+                    //'," ---> ",g22.16,/)'
+          Pos=2
+        else
+          form='(t'//trim(int2str(pos))//            &
+               ',"('//trim(int2str(j))//','          &
+                    //trim(int2str(i))//')",t'       & 
+                    //trim(int2str(pos+offset))     &    
+                    //'," ---> ",g22.16," | ")'
+          Pos=Pos+ColumnSize
+        endif
+        write (id,form,advance='no') Field(j,i)
+      enddo
+      if (MOD(nb,NbCol)==0) then
+        write (id,spacing)
+      else
+        write (id,'("")')
+        write (id,spacing)
+      endif
+    enddo
+     
+  end subroutine write_field2D
+  
+  subroutine write_field3D(name,Field)
+    implicit none
+  
+    integer, parameter :: MaxDim=3
+    character(len=*)   :: name
+    real, dimension(:,:,:) :: Field
+    real, dimension(:,:,:),allocatable :: New_Field
+    integer, dimension(MaxDim) :: Dim
+    integer :: i,j,k,nb
+    integer, parameter :: id=10
+    integer, parameter :: NbCol=4
+    integer :: ColumnSize 
+    integer :: pos,offset
+    character(len=255) :: form
+    character(len=255) :: spacing
+
+    open(unit=id,file=name//'.field',form='formatted',status='replace')
+    write (id,'("----- Field '//name//'"//)')
+    
+    Dim=shape(Field)
+    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+len(trim(int2str(Dim(3))))+4
+    ColumnSize=22+6+3+offset
+
+!    open(unit=id,file=name,form=formatted
+   
+    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
+    
+    do i=1,Dim(3)
+    
+      do j=1,Dim(2)
+        nb=0
+        Pos=2
+        
+        do k=1,Dim(1)
+        nb=nb+1
+      
+          if (MOD(nb,NbCol)==0) then
+            form='(t'//trim(int2str(pos))//            &
+                 ',"('//trim(int2str(k))//','          &
+                      //trim(int2str(j))//','          &
+                      //trim(int2str(i))//')",t'       & 
+                      //trim(int2str(pos+offset))      &    
+                      //'," ---> ",g22.16,/)'
+           Pos=2
+          else
+            form='(t'//trim(int2str(pos))//            &
+                 ',"('//trim(int2str(k))//','          &
+                      //trim(int2str(j))//','          &
+                      //trim(int2str(i))//')",t'       & 
+                      //trim(int2str(pos+offset))      &    
+                      //'," ---> ",g22.16," | ")'
+! dépent de l'implémention, sur compaq, c'est necessaire
+!            Pos=Pos+ColumnSize
+          endif
+          write (id,form,advance='no') Field(k,j,i)
+        enddo
+        if (MOD(nb,NbCol)==0) then
+          write (id,spacing)
+        else
+          write (id,'("")')
+          write (id,spacing)
+        endif
+      enddo
+      write (id,spacing)
+    enddo
+    
+    close(id)
+  
+  end subroutine write_field3D  
+  
+  function int2str(int)
+    implicit none
+    integer, parameter :: MaxLen=10
+    integer,intent(in) :: int
+    character(len=MaxLen) :: int2str
+    logical :: flag
+    integer :: i
+    flag=.true.
+    
+    i=int
+    
+    int2str=''
+    do while (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      if (i==0) flag=.false.
+    enddo
+  end function int2str
+
+end module write_field
+  
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/etat0_netcdf.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/etat0_netcdf.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/etat0_netcdf.F90	(revision 3815)
@@ -0,0 +1,541 @@
+!
+! $Id: etat0_netcdf.F90 1625 2012-05-09 13:14:48Z lguez $
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE etat0_netcdf(ib, masque, phis, letat0)
+#ifndef CPP_1D
+!
+!-------------------------------------------------------------------------------
+! Purpose: Creates initial states
+!-------------------------------------------------------------------------------
+! Note: This routine is designed to work for Earth
+!-------------------------------------------------------------------------------
+  USE control_mod
+#ifdef CPP_EARTH
+  USE startvar
+  USE ioipsl
+  USE dimphy
+  USE infotrac
+  USE fonte_neige_mod
+  USE pbl_surface_mod
+  USE phys_state_var_mod
+  USE filtreg_mod
+  USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
+  USE conf_phys_m,            ONLY: conf_phys
+! For parameterization of ozone chemistry:
+  USE regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
+  USE press_coefoz_m, only: press_coefoz
+  USE regr_pr_o3_m, only: regr_pr_o3
+  USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
+  USE indice_sol_mod
+  use exner_hyb_m, only: exner_hyb
+  use exner_milieu_m, only: exner_milieu
+  use test_disvert_m, only: test_disvert
+#endif
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+#include "dimensions.h"
+#include "paramet.h"
+#include "iniprint.h"
+  LOGICAL,                    INTENT(IN)    :: ib     ! barycentric interpolat.
+  REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask
+  REAL, DIMENSION(iip1,jjp1), INTENT(OUT)   :: phis   ! geopotentiel au sol
+  LOGICAL,                    INTENT(IN)    :: letat0 ! F: masque only required
+#ifndef CPP_EARTH
+  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
+#else
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "comgeom2.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "dimsoil.h"
+#include "temps.h"
+  REAL,    DIMENSION(klon)                 :: tsol
+  REAL,    DIMENSION(klon)                 :: sn, rugmer, run_off_lic_0
+  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol
+  REAL,    DIMENSION(iip1,jjp1,llm+1)      :: p3d
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: uvent, t3d, tpot, qsat, qd
+  REAL,    DIMENSION(iip1,jjm ,llm)        :: vvent
+  REAL,    DIMENSION(:,:,:,:), ALLOCATABLE :: q3d
+  REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
+  REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
+
+!--- Local variables for sea-ice reading:
+  INTEGER                                  :: iml_lic, jml_lic, llm_tmp
+  INTEGER                                  :: ttm_tmp, iret, fid
+  INTEGER, DIMENSION(1)                    :: itaul
+  REAL,    DIMENSION(1)                    :: lev
+  REAL                                     :: date
+  REAL,    DIMENSION(:,:),   ALLOCATABLE   ::  lon_lic,  lat_lic, fraclic
+  REAL,    DIMENSION(:),     ALLOCATABLE   :: dlon_lic, dlat_lic
+  REAL,    DIMENSION(iip1,jjp1)            :: flic_tmp
+
+!--- Misc
+  CHARACTER(LEN=80)                        :: x, fmt
+  INTEGER                                  :: i, j, l, ji
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: pk, pls, y
+  REAL,    DIMENSION(ip1jmp1)              :: pks
+
+#include "comdissnew.h"
+#include "serre.h"
+#include "clesphys.h"
+
+  REAL,    DIMENSION(iip1,jjp1,llm)        :: masse
+  INTEGER :: itau, iday
+  REAL    :: xpn, xps, time, phystep
+  REAL,    DIMENSION(iim)                  :: xppn, xpps
+  REAL,    DIMENSION(ip1jmp1,llm)          :: pbaru, phi, w
+  REAL,    DIMENSION(ip1jm  ,llm)          :: pbarv
+  REAL,    DIMENSION(klon)                 :: fder
+
+!--- Local variables for ocean mask reading:
+  INTEGER :: nid_o2a, iml_omask, jml_omask
+  LOGICAL :: couple=.FALSE.
+  REAL,    DIMENSION(:,:), ALLOCATABLE ::  lon_omask, lat_omask, ocemask, ocetmp
+  REAL,    DIMENSION(:),   ALLOCATABLE :: dlon_omask,dlat_omask
+  REAL,    DIMENSION(klon)             :: ocemask_fi
+  INTEGER, DIMENSION(klon-2)           :: isst
+  REAL,    DIMENSION(iim,jjp1)         :: zx_tmp_2d
+  REAL    :: dummy
+  LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
+  LOGICAL :: ok_LES, ok_ade, ok_aie, ok_cdnc, aerosol_couple, new_aod, callstats
+  INTEGER :: iflag_radia, flag_aerosol
+  LOGICAL :: flag_aerosol_strat
+  REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
+  REAL    :: tau_ratqs
+  INTEGER :: iflag_cldcon, iflag_ratqs, iflag_coupl, iflag_clos, iflag_wake
+  INTEGER :: iflag_thermals, nsplit_thermals
+  INTEGER :: iflag_thermals_ed, iflag_thermals_optflux
+  REAL    :: tau_thermals, solarlong0,  seuil_inversion
+  INTEGER :: read_climoz ! read ozone climatology
+!  Allowed values are 0, 1 and 2
+!     0: do not read an ozone climatology
+!     1: read a single ozone climatology that will be used day and night
+!     2: read two ozone climatologies, the average day and night
+!     climatology and the daylight climatology
+!-------------------------------------------------------------------------------
+  REAL    :: alp_offset
+  logical found
+
+!--- Constants
+  pi     = 4. * ATAN(1.)
+  rad    = 6371229.
+  daysec = 86400.
+  omeg   = 2.*pi/daysec
+  g      = 9.8
+  kappa  = 0.2857143
+  cpp    = 1004.70885
+  preff  = 101325.
+  pa     = 50000.
+  jmp1   = jjm + 1
+
+!--- CONSTRUCT A GRID
+  CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
+                   callstats,                                           &
+                   solarlong0,seuil_inversion,                          &
+                   fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
+                   iflag_cldcon,                                        &
+                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
+                   ok_ade, ok_aie, ok_cdnc, aerosol_couple,             &
+                   flag_aerosol, flag_aerosol_strat, new_aod,           &
+                   bl95_b0, bl95_b1,                                    &
+                   read_climoz,                                         &
+                   alp_offset)
+
+! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
+  co2_ppm0 = co2_ppm
+
+  dtvr   = daysec/FLOAT(day_step)
+  WRITE(lunout,*)'dtvr',dtvr
+
+  CALL iniconst()
+  if (pressure_exner) call test_disvert
+  CALL inigeom()
+
+!--- Initializations for tracers
+  CALL infotrac_init
+  ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
+
+  CALL inifilr()
+  CALL phys_state_var_init(read_climoz)
+
+  rlat(1) = ASIN(1.0)
+  DO j=2,jjm; rlat((j-2)*iim+2:(j-1)*iim+1)=rlatu(j);     END DO
+  rlat(klon) = - ASIN(1.0)
+  rlat(:)=rlat(:)*(180.0/pi)
+
+  rlon(1) = 0.0
+  DO j=2,jjm; rlon((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:iim); END DO
+  rlon(klon) = 0.0
+  rlon(:)=rlon(:)*(180.0/pi)
+
+! For a coupled simulation, the ocean mask from ocean model is used to compute
+! the weights an to insure ocean fractions are the same for atmosphere and ocean
+! Otherwise, mask is created using Relief file.
+
+  WRITE(lunout,*)'Essai de lecture masque ocean'
+  iret = NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)
+  IF(iret/=NF90_NOERR) THEN
+    WRITE(lunout,*)'ATTENTION!! pas de fichier o2a.nc trouve'
+    WRITE(lunout,*)'Run force'
+    x='masque'
+    masque(:,:)=0.0
+    CALL startget_phys2d(x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, &
+   &              rlonu, rlatv, ib)
+    WRITE(lunout,*)'MASQUE construit : Masque'
+    if (prt_level >= 1) WRITE(lunout,'(97I1)') nINT(masque)
+    CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
+    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
+    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
+  ELSE
+    WRITE(lunout,*)'ATTENTION!! fichier o2a.nc trouve'
+    WRITE(lunout,*)'Run couple'
+    couple=.true.
+    iret=NF90_CLOSE(nid_o2a)
+    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
+    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
+      WRITE(lunout,*)'Dimensions non compatibles pour masque ocean'
+      WRITE(lunout,*)'iim = ',iim,' iml_omask = ',iml_omask
+      WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
+      CALL abort_gcm('etat0_netcdf','Dimensions non compatibles pour masque oc&
+     &ean',1)
+    END IF
+    ALLOCATE(   ocemask(iml_omask,jml_omask),   ocetmp(iml_omask,jml_omask))
+    ALLOCATE( lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask))
+    ALLOCATE(dlon_omask(iml_omask),         dlat_omask(jml_omask))
+    CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask,&
+   &              lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
+    CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, &
+   &              1, 1, ocetmp)
+    CALL flinclo(fid)
+    dlon_omask(1:iml_omask) = lon_omask(1:iml_omask,1)
+    dlat_omask(1:jml_omask) = lat_omask(1,1:jml_omask)
+    ocemask = ocetmp
+    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
+      DO j=1,jml_omask
+        ocemask(:,j) = ocetmp(:,jml_omask-j+1)
+      END DO
+    END IF
+!
+! Ocean mask to physical grid
+!*******************************************************************************
+    WRITE(lunout,*)'ocemask '
+    WRITE(fmt,"(i4,'i1)')")iml_omask ; fmt='('//ADJUSTL(fmt)
+    WRITE(lunout,fmt)int(ocemask)
+    ocemask_fi(1)=ocemask(1,1)
+    DO j=2,jjm; ocemask_fi((j-2)*iim+2:(j-1)*iim+1)=ocemask(1:iim,j); END DO
+    ocemask_fi(klon)=ocemask(1,jjp1)
+    zmasq=1.-ocemask_fi
+  END IF
+
+  CALL gr_fi_dyn(1,klon,iip1,jjp1,zmasq,masque)
+
+  ! The startget calls need to be replaced by a call to restget to get the
+  ! values in the restart file
+  x = 'relief'; orog(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, orog, 0.0,jjm,rlonu,rlatv,ib,&
+ &               masque)
+
+  x = 'rugosite'; rugo(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, rugo, 0.0,jjm, rlonu,rlatv,ib)
+!  WRITE(lunout,'(49I1)') INT(orog(:,:)*10)
+!  WRITE(lunout,'(49I1)') INT(rugo(:,:)*10)
+
+! Sub-surfaces initialization
+!*******************************************************************************
+  pctsrf=0.
+  x = 'psol'; psol(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib)
+!  WRITE(lunout,*) 'PSOL :', psol(10,20)
+!  WRITE(lunout,*) ap(:), bp(:)
+
+! Mid-levels pressure computation
+!*******************************************************************************
+  CALL pression(ip1jmp1, ap, bp, psol, p3d)
+  if (pressure_exner) then
+    CALL exner_hyb(ip1jmp1, psol, p3d, pks, pk)
+  else
+    CALL exner_milieu(ip1jmp1,psol,p3d, pks,pk)
+  endif
+  pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)
+!  WRITE(lunout,*) 'P3D :', p3d(10,20,:)
+!  WRITE(lunout,*) 'PK:',    pk(10,20,:)
+!  WRITE(lunout,*) 'PLS :', pls(10,20,:)
+
+  x = 'surfgeo'; phis(:,:) = 0.0
+  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib)
+
+  x = 'u';    uvent(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonu,rlatu,pls,y,uvent,0.0,  &
+ &                  rlonv,rlatv,ib)
+
+  x = 'v';    vvent(:,:,:) = 0.0
+  CALL startget_dyn(x, rlonv,rlatv,pls(:, :jjm, :),y(:, :jjm, :),vvent,0.0, &
+ &                  rlonu,rlatu(:jjm),ib)
+
+  x = 't';    t3d(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,y,t3d,0.0,    &
+ &                  rlonu,rlatv,ib)
+
+  x = 'tpot'; tpot(:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,pk,tpot,0.0,  &
+ &                  rlonu,rlatv,ib)
+
+  WRITE(lunout,*) 'T3D min,max:',minval(t3d(:,:,:)),maxval(t3d(:,:,:))
+  WRITE(lunout,*) 'PLS min,max:',minval(pls(:,:,:)),maxval(pls(:,:,:))
+
+! Humidity at saturation computation
+!*******************************************************************************
+  WRITE(lunout,*) 'avant q_sat'
+  CALL q_sat(llm*jjp1*iip1, t3d, pls, qsat)
+  WRITE(lunout,*) 'apres q_sat'
+  WRITE(lunout,*) 'QSAT min,max:',minval(qsat(:,:,:)),maxval(qsat(:,:,:))
+!  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
+
+  x = 'q';    qd (:,:,:) = 0.0
+  CALL startget_dyn(x,rlonv,rlatu,pls,qsat,qd,0.0, rlonu,rlatv,ib)
+  q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:)
+
+! Parameterization of ozone chemistry:
+! Look for ozone tracer:
+  i = 1
+  DO
+    found = tname(i)=="O3" .OR. tname(i)=="o3"
+    if (found .or. i == nqtot) exit
+    i = i + 1
+  end do
+  if (found) then
+    call regr_lat_time_coefoz
+    call press_coefoz
+    call regr_pr_o3(p3d, q3d(:, :, :, i))
+!   Convert from mole fraction to mass fraction:
+    q3d(:, :, :, i) = q3d(:, :, :, i)  * 48. / 29.
+  end if
+
+!--- OZONE CLIMATOLOGY
+  IF(read_climoz>=1) CALL regr_lat_time_climoz(read_climoz)
+
+  x = 'tsol'; tsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'qsol';  qsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'snow';  sn(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'rads';  radsol(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'rugmer'; rugmer(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zmea';  zmea(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zstd';  zstd(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zsig';  zsig(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zgam';  zgam(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zthe';  zthe(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zpic';  zpic(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib)
+
+  x = 'zval';  zval(:) = 0.0
+  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib)
+
+!  WRITE(lunout,'(48I3)') 'TSOL :', INT(tsol(2:klon)-273)
+
+! Soil ice file reading for soil fraction and soil ice fraction
+!*******************************************************************************
+  CALL flininfo("landiceref.nc", iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
+  ALLOCATE( lat_lic(iml_lic,jml_lic),lon_lic(iml_lic, jml_lic))
+  ALLOCATE(dlat_lic(jml_lic),       dlon_lic(iml_lic))
+  ALLOCATE( fraclic(iml_lic,jml_lic))
+  CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp,  &
+ &               lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
+  CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
+  CALL flinclo(fid)
+
+! Interpolation on model T-grid
+!*******************************************************************************
+  WRITE(lunout,*)'dimensions de landice iml_lic, jml_lic : ',iml_lic,jml_lic
+! conversion if coordinates are in degrees
+  IF(MAXVAL(lon_lic)>pi) lon_lic=lon_lic*pi/180.
+  IF(MAXVAL(lat_lic)>pi) lat_lic=lat_lic*pi/180.
+  dlon_lic(:)=lon_lic(:,1)
+  dlat_lic(:)=lat_lic(1,:)
+  CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1,   &
+ &               rlonv, rlatu, flic_tmp(1:iim,:) )
+  flic_tmp(iip1,:)=flic_tmp(1,:)
+
+!--- To the physical grid
+  CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, pctsrf(:,is_lic))
+
+!--- Adequation with soil/sea mask
+  WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. 
+  WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
+  pctsrf(:,is_ter)=zmasq(:)
+  DO ji=1,klon
+    IF(zmasq(ji)>EPSFRA) THEN 
+      IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
+        pctsrf(ji,is_lic)=zmasq(ji)
+        pctsrf(ji,is_ter)=0.
+      ELSE
+        pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
+        IF(pctsrf(ji,is_ter)<EPSFRA) THEN
+          pctsrf(ji,is_ter)=0.
+          pctsrf(ji,is_lic)=zmasq(ji)
+        END IF 
+      END IF 
+    END IF 
+  END DO 
+
+! sub-surface ocean and sea ice (sea ice set to zero for start)
+!*******************************************************************************
+  pctsrf(:,is_oce)=(1.-zmasq(:))
+  WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
+  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
+  isst=0
+  WHERE(pctsrf(2:klon-1,is_oce)>0.) isst=1
+
+! It is checked that the sub-surfaces sum is equal to 1
+!*******************************************************************************
+  ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
+  IF(ji/=0) WRITE(lunout,*) 'pb repartition sous maille pour ',ji,' points'
+  CALL gr_fi_ecrit(1, klon, iim, jjp1, zmasq, zx_tmp_2d)
+!  WRITE(fmt,"(i3,')')")iim; fmt='(i'//ADJUSTL(fmt)
+!  WRITE(lunout,*)'zmasq = '
+!  WRITE(lunout,TRIM(fmt))NINT(zx_tmp_2d)
+  CALL gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
+  WRITE(fmt,"(i4,'i1)')")iip1 ; fmt='('//ADJUSTL(fmt)
+  WRITE(lunout,*) 'MASQUE construit : Masque'
+  if (prt_level >= 1) WRITE(lunout,TRIM(fmt))NINT(masque(:,:))
+
+! Intermediate computation
+!*******************************************************************************
+  CALL massdair(p3d,masse)
+  WRITE(lunout,*)' ALPHAX ',alphax
+  DO l=1,llm
+    xppn(:)=aire(1:iim,1   )*masse(1:iim,1   ,l)
+    xpps(:)=aire(1:iim,jjp1)*masse(1:iim,jjp1,l)
+    xpn=SUM(xppn)/apoln
+    xps=SUM(xpps)/apols
+    masse(:,1   ,l)=xpn
+    masse(:,jjp1,l)=xps
+  END DO
+  q3d(iip1,:,:,:)=q3d(1,:,:,:)
+  phis(iip1,:) = phis(1,:)
+
+  IF(.NOT.letat0) RETURN
+
+! Writing
+!*******************************************************************************
+  CALL inidissip(lstardis, nitergdiv, nitergrot, niterh, tetagdiv, tetagrot, &
+       tetatemp, vert_prof_dissip)
+  WRITE(lunout,*)'sortie inidissip'
+  itau=0
+  itau_dyn=0
+  itau_phy=0
+  iday=dayref+itau/day_step
+  time=FLOAT(itau-(iday-dayref)*day_step)/day_step
+  IF(time>1.) THEN
+   time=time-1
+   iday=iday+1
+  END IF
+  day_ref=dayref
+  annee_ref=anneeref
+
+  CALL geopot( ip1jmp1, tpot, pk, pks, phis, phi )
+  WRITE(lunout,*)'sortie geopot'
+
+  CALL caldyn0( itau, uvent, vvent, tpot, psol, masse, pk, phis,               &
+                phi,  w, pbaru, pbarv, time+iday-dayref)
+  WRITE(lunout,*)'sortie caldyn0'     
+  CALL dynredem0( "start.nc", dayref, phis)
+  WRITE(lunout,*)'sortie dynredem0'
+  CALL dynredem1( "start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
+  WRITE(lunout,*)'sortie dynredem1' 
+
+! Physical initial state writting
+!*******************************************************************************
+  WRITE(lunout,*)'phystep ',dtvr,iphysiq,nbapp_rad
+  phystep   = dtvr * FLOAT(iphysiq)
+  radpas    = NINT (86400./phystep/ FLOAT(nbapp_rad) )
+  WRITE(lunout,*)'phystep =', phystep, radpas
+
+! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
+!*******************************************************************************
+  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
+  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
+!albedo SB >>>
+  falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
+  falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
+!albedo SB <<<
+  fevap(:,:) = 0.
+  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
+  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
+  rain_fall = 0.; snow_fall = 0.
+  solsw = 165.;   sollw = -53.
+  t_ancien = 273.15
+  q_ancien = 0.
+  agesno = 0.
+
+  z0m(:,is_oce) = rugmer(:)
+  z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+  z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
+  z0m(:,is_sic) = 0.001
+  z0h(:,:)=z0m(:,:)
+
+  fder = 0.0
+  clwcon = 0.0
+  rnebcon = 0.0
+  ratqs = 0.0
+  run_off_lic_0 = 0.0 
+  rugoro = 0.0
+
+! Before phyredem calling, surface modules and values to be saved in startphy.nc
+! are initialized
+!*******************************************************************************
+  dummy = 1.0
+  pbl_tke(:,:,:) = 1.e-8 
+  zmax0(:) = 40.
+  f0(:) = 1.e-5
+  sig1(:,:) = 0.
+  w01(:,:) = 0.
+  wake_deltat(:,:) = 0.
+  wake_deltaq(:,:) = 0.
+  wake_s(:) = 0.
+  wake_cstar(:) = 0.
+  wake_fip(:) = 0.
+  wake_pe = 0.
+  fm_therm = 0.
+  entr_therm = 0.
+  detr_therm = 0.
+
+  CALL fonte_neige_init(run_off_lic_0)
+  CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
+  CALL phyredem( "startphy.nc" )
+
+!  WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
+!  WRITE(lunout,*)'entree histclo'
+  CALL histclo()
+
+#endif 
+!#endif of #ifdef CPP_EARTH
+  RETURN
+#endif
+!#endif of ifndef CPP_1D
+END SUBROUTINE etat0_netcdf
+!
+!-------------------------------------------------------------------------------
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/inistats.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/inistats.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/inistats.F90	(revision 3815)
@@ -0,0 +1,129 @@
+SUBROUTINE inistats(ierr)
+  USE comconst_phy_mod
+  USE comvert_phy_mod
+  IMPLICIT NONE
+  
+  include "dimensions.h"
+!  include "paramet.h"
+!  include "comgeom.h"
+!  include "comvert.h"
+!  include "comconst.h"
+  include "statto.h"
+  include "netcdf.inc"
+
+  INTEGER, INTENT (OUT) :: ierr
+  INTEGER :: nid
+  INTEGER :: l, nsteppd
+  REAL, DIMENSION (llm) :: sig_s
+  INTEGER :: idim_lat, idim_lon, idim_llm, idim_llmp1, idim_time
+  REAL, DIMENSION (istime) :: lt
+  INTEGER :: nvarid
+
+  WRITE (*, *)
+  WRITE (*, *) '                        || STATS ||'
+  WRITE (*, *)
+  WRITE (*, *) 'daysec', daysec
+  WRITE (*, *) 'dtphys', dtphys
+  nsteppd = nint(daysec/dtphys)
+  WRITE (*, *) 'nsteppd=', nsteppd
+  IF (abs(float(nsteppd)-daysec/dtphys)>1.E-8*daysec) &
+    STOP 'Dans Instat:  1jour .ne. n pas physiques'
+
+  IF (mod(nsteppd,istime)/=0) STOP &
+    'Dans Instat:  1jour .ne. n*istime pas physiques'
+
+  istats = nsteppd/istime
+  WRITE (*, *) 'istats=', istats
+  WRITE (*, *) 'Storing ', istime, 'times per day'
+  WRITE (*, *) 'thus every ', istats, 'physical timestep '
+  WRITE (*, *)
+
+  DO l = 1, llm
+    sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2.
+    pseudoalt(l) = log(preff/presnivs(l))*8.
+  END DO
+
+  ierr = nf_create('stats.nc', nf_clobber, nid)
+  IF (ierr/=nf_noerr) THEN
+    WRITE (*, *) nf_strerror(ierr)
+    STOP ''
+  END IF
+
+  ierr = nf_def_dim(nid, 'latitude', jjp1, idim_lat)
+  ierr = nf_def_dim(nid, 'longitude', iip1, idim_lon)
+  ierr = nf_def_dim(nid, 'altitude', llm, idim_llm)
+  ierr = nf_def_dim(nid, 'llmp1', llm+1, idim_llmp1)
+  ierr = nf_def_dim(nid, 'Time', nf_unlimited, idim_time)
+
+  ierr = nf_enddef(nid)
+  CALL def_var_stats(nid, 'Time', 'Time', 'hours since 0000-00-0 00:00:00', &
+    1, idim_time, nvarid, ierr)
+  ! Time is initialised later by mkstats subroutine
+
+  CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, &
+    idim_lat, nvarid, ierr)
+#ifdef NC_DOUBLE
+  ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180)
+#else
+  ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180)
+#endif
+  CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, &
+    idim_lon, nvarid, ierr)
+#ifdef NC_DOUBLE
+  ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180)
+#else
+  ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180)
+#endif
+
+  ! Niveaux verticaux, aps et bps
+  ierr = nf_redef(nid)
+  ! presnivs
+#ifdef NC_DOUBLE
+  ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid)
+#else
+  ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid)
+#endif
+  ierr = nf_put_att_text(nid, nvarid, 'long_name', 15, 'Vertical levels')
+  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'Pa')
+  ierr = nf_put_att_text(nid, nvarid, 'positive', 4, 'down')
+  ierr = nf_enddef(nid)
+#ifdef NC_DOUBLE
+  ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm))
+#else
+  ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm))
+#endif
+  ! Pseudo alts
+#ifdef NC_DOUBLE
+  ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid)
+#else
+  ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid)
+#endif
+  ierr = nf_put_att_text(nid, nvarid, 'long_name', 8, 'altitude')
+  ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'km')
+  ierr = nf_put_att_text(nid, nvarid, 'positive', 2, 'up')
+  ierr = nf_enddef(nid)
+#ifdef NC_DOUBLE
+  ierr = nf_put_var_double(nid, nvarid, pseudoalt)
+#else
+  ierr = nf_put_var_real(nid, nvarid, pseudoalt)
+#endif
+  ! call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ",
+  ! &            1,idim_llm,nvarid,ierr)
+  ! #ifdef NC_DOUBLE
+  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps)
+  ! #else
+  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,aps)
+  ! #endif
+
+  ! call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ",
+  ! &            1,idim_llm,nvarid,ierr)
+  ! #ifdef NC_DOUBLE
+  ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps)
+  ! #else
+  ! ierr = NF_PUT_VAR_REAL (nid,nvarid,bps)
+  ! #endif
+
+  ierr = nf_close(nid)
+
+END SUBROUTINE inistats
+
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/limit_netcdf.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/limit_netcdf.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/limit_netcdf.F90	(revision 3815)
@@ -0,0 +1,665 @@
+!
+! $Id: limit_netcdf.F90 1508 2011-04-15 13:05:34Z jghattas $
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque)
+#ifndef CPP_1D
+!
+!-------------------------------------------------------------------------------
+! Author : L. Fairhead, 27/01/94
+!-------------------------------------------------------------------------------
+! Purpose: Boundary conditions files building for new model using climatologies.
+!          Both grids have to be regular.
+!-------------------------------------------------------------------------------
+! Note: This routine is designed to work for Earth
+!-------------------------------------------------------------------------------
+! Modification history:
+!  * 23/03/1994: Z. X. Li
+!  *    09/1999: L. Fairhead (netcdf reading in LMDZ.3.3)
+!  *    07/2001: P. Le Van
+!  *    11/2009: L. Guez     (ozone day & night climatos, see etat0_netcdf.F90)
+!  *    12/2009: D. Cugnet   (f77->f90, calendars, files from coupled runs)
+!-------------------------------------------------------------------------------
+  USE control_mod
+  USE indice_sol_mod
+#ifdef CPP_EARTH
+  USE dimphy
+  USE ioipsl,             ONLY : ioget_year_len
+  USE phys_state_var_mod, ONLY : pctsrf, rlon, rlat
+  USE netcdf,             ONLY : NF90_OPEN,    NF90_CREATE,  NF90_CLOSE,       &
+                   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_FLOAT
+  USE inter_barxy_m, only: inter_barxy
+  use netcdf95, only: nf95_def_var, nf95_put_att, nf95_put_var
+#endif
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+#include "dimensions.h"
+#include "paramet.h"
+#include "iniprint.h"
+  LOGICAL,                    INTENT(IN) :: interbar ! barycentric interpolation
+  LOGICAL,                    INTENT(IN) :: extrap   ! SST extrapolation flag
+  LOGICAL,                    INTENT(IN) :: oldice   ! old way ice computation
+  REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque   ! land mask
+#ifndef CPP_EARTH
+  CALL abort_gcm('limit_netcdf','Earth-specific routine, needs Earth physics',1)
+#else
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "logic.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "comconst.h"
+
+!--- INPUT NETCDF FILES NAMES --------------------------------------------------
+  CHARACTER(LEN=25) :: icefile, sstfile, dumstr
+  CHARACTER(LEN=25), PARAMETER :: famipsst ='amipbc_sst_1x1.nc        ',        &
+                                  famipsic ='amipbc_sic_1x1.nc        ',        &
+                                  fcpldsst ='cpl_atm_sst.nc           ',        &
+                                  fcpldsic ='cpl_atm_sic.nc           ',        &
+                                  fhistsst ='histmth_sst.nc           ',        &
+                                  fhistsic ='histmth_sic.nc           ',        &
+                                  frugo    ='Rugos.nc                 ',        &
+                                  falbe    ='Albedo.nc                ',        &
+                                  feraisstk='sstk.nc                  ',        &
+                                  feraici  ='ci.nc                    '
+  CHARACTER(LEN=10) :: varname
+!--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
+  REAL,   DIMENSION(klon)                :: fi_ice, verif
+  REAL,   DIMENSION(:,:),   POINTER      :: phy_rug=>NULL(), phy_ice=>NULL()
+  REAL,   DIMENSION(:,:),   POINTER      :: phy_sst=>NULL(), phy_alb=>NULL()
+  REAL,   DIMENSION(:,:),   ALLOCATABLE  :: phy_bil
+  REAL,   DIMENSION(:,:,:), ALLOCATABLE  :: pctsrf_t
+  INTEGER                                :: nbad
+
+!--- VARIABLES FOR OUTPUT FILE WRITING -----------------------------------------
+  INTEGER :: ierr, nid, ndim, ntim, k
+  INTEGER, DIMENSION(2) :: dims
+  INTEGER :: id_tim,  id_SST,  id_BILS, id_RUG, id_ALB
+  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude
+  INTEGER :: NF90_FORMAT
+  INTEGER :: ndays                   !--- Depending on the output calendar
+
+!--- INITIALIZATIONS -----------------------------------------------------------
+#ifdef NC_DOUBLE
+  NF90_FORMAT=NF90_DOUBLE
+#else
+  NF90_FORMAT=NF90_FLOAT
+#endif
+
+  pi    = 4.*ATAN(1.)
+  rad   = 6371229.
+  daysec= 86400.
+  omeg  = 2.*pi/daysec
+  g     = 9.8
+  kappa = 0.2857143
+  cpp   = 1004.70885
+  dtvr  = daysec/REAL(day_step)
+  CALL inigeom
+
+!--- Beware: anneeref (from gcm.def) is used to determine output time sampling
+  ndays=ioget_year_len(anneeref)
+
+!--- RUGOSITY TREATMENT --------------------------------------------------------
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la rugosite'
+  varname='RUGOS'
+  CALL get_2Dfield(frugo,varname,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:))
+
+!--- OCEAN TREATMENT -----------------------------------------------------------
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la glace oceanique'
+
+! Input SIC file selection
+! Open file only to test if available
+  IF ( NF90_OPEN(TRIM(famipsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(famipsic)
+     varname='sicbcs'
+  ELSE IF( NF90_OPEN(TRIM(fcpldsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(fcpldsic)
+     varname='SIICECOV'
+  ELSE IF ( NF90_OPEN(TRIM(fhistsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(fhistsic)
+     varname='pourc_sic'
+  ELSE IF ( NF90_OPEN(TRIM(feraici),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(feraici)
+     varname='ci'
+  ELSE
+     WRITE(lunout,*) 'ERROR! No sea-ice input file was found.'
+     WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsic),', ',trim(fcpldsic),', ', &
+                      trim(fhistsic), trim(feraici)
+     CALL abort_gcm('limit_netcdf','No sea-ice file was found',1)
+  END IF
+  ierr=NF90_CLOSE(nid)
+  IF (prt_level>=0) WRITE(lunout,*)'Pour la glace de mer a ete choisi le fichier '//TRIM(icefile)
+
+  CALL get_2Dfield(icefile,varname, 'SIC',interbar,ndays,phy_ice,flag=oldice)
+
+  ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
+  DO k=1,ndays
+     fi_ice=phy_ice(:,k)
+     WHERE(fi_ice>=1.0  ) fi_ice=1.0
+     WHERE(fi_ice<EPSFRA) fi_ice=0.0
+     pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
+     pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
+     IF (icefile==trim(fcpldsic)) THEN           ! SIC=pICE*(1-LIC-TER)
+        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
+     ELSE IF (icefile==trim(fhistsic)) THEN      ! SIC=pICE
+        pctsrf_t(:,is_sic,k)=fi_ice(:)
+     ELSE ! icefile==famipsic                    ! SIC=pICE-LIC
+        pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
+     END IF
+     WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
+     WHERE(1.0-zmasq<EPSFRA)
+        pctsrf_t(:,is_sic,k)=0.0
+        pctsrf_t(:,is_oce,k)=0.0
+     ELSEWHERE
+        WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
+           pctsrf_t(:,is_sic,k)=1.0-zmasq
+           pctsrf_t(:,is_oce,k)=0.0
+        ELSEWHERE
+           pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
+           WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
+              pctsrf_t(:,is_oce,k)=0.0
+              pctsrf_t(:,is_sic,k)=1.0-zmasq
+           END WHERE
+        END WHERE
+     END WHERE
+     nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
+     IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
+     nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
+     IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
+  END DO
+  DEALLOCATE(phy_ice)
+
+!--- SST TREATMENT -------------------------------------------------------------
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la sst'
+
+! Input SST file selection
+! Open file only to test if available
+  IF ( NF90_OPEN(TRIM(famipsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(famipsst)
+     varname='tosbcs'
+  ELSE IF ( NF90_OPEN(TRIM(fcpldsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(fcpldsst)
+     varname='SISUTESW'
+  ELSE IF ( NF90_OPEN(TRIM(fhistsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(fhistsst)
+     varname='tsol_oce'
+  ELSE IF ( NF90_OPEN(TRIM(feraisstk),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(feraisstk)
+     varname='sstk'
+  ELSE
+     WRITE(lunout,*) 'ERROR! No sst input file was found.'
+     WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsst),trim(fcpldsst),trim(fhistsst),trim(feraisstk)
+     CALL abort_gcm('limit_netcdf','No sst file was found',1)
+  END IF
+  ierr=NF90_CLOSE(nid)
+  IF (prt_level>=0) WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(sstfile)
+
+  CALL get_2Dfield(sstfile,varname,'SST',interbar,ndays,phy_sst,flag=extrap)
+
+!--- ALBEDO TREATMENT ----------------------------------------------------------
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de l albedo'
+  varname='ALBEDO'
+  CALL get_2Dfield(falbe,varname,'ALB',interbar,ndays,phy_alb)
+
+!--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
+  ALLOCATE(phy_bil(klon,ndays)); phy_bil=0.0
+
+!--- OUTPUT FILE WRITING -------------------------------------------------------
+  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : debut'
+
+  !--- File creation
+  ierr=NF90_CREATE("limit.nc",NF90_CLOBBER,nid)
+  ierr=NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier conditions aux limites")
+
+  !--- Dimensions creation
+  ierr=NF90_DEF_DIM(nid,"points_physiques",klon,ndim)
+  ierr=NF90_DEF_DIM(nid,"time",NF90_UNLIMITED,ntim)
+
+  dims=(/ndim,ntim/)
+
+  !--- Variables creation
+  ierr=NF90_DEF_VAR(nid,"TEMPS",NF90_FORMAT,(/ntim/),id_tim)
+  ierr=NF90_DEF_VAR(nid,"FOCE", NF90_FORMAT,dims,id_FOCE)
+  ierr=NF90_DEF_VAR(nid,"FSIC", NF90_FORMAT,dims,id_FSIC)
+  ierr=NF90_DEF_VAR(nid,"FTER", NF90_FORMAT,dims,id_FTER)
+  ierr=NF90_DEF_VAR(nid,"FLIC", NF90_FORMAT,dims,id_FLIC)
+  ierr=NF90_DEF_VAR(nid,"SST",  NF90_FORMAT,dims,id_SST)
+  ierr=NF90_DEF_VAR(nid,"BILS", NF90_FORMAT,dims,id_BILS)
+  ierr=NF90_DEF_VAR(nid,"ALB",  NF90_FORMAT,dims,id_ALB)
+  ierr=NF90_DEF_VAR(nid,"RUG",  NF90_FORMAT,dims,id_RUG)
+  call nf95_def_var(nid, "longitude", NF90_FLOAT, ndim, varid_longitude)
+  call nf95_def_var(nid, "latitude", NF90_FLOAT, ndim, varid_latitude)
+
+  !--- Attributes creation
+  ierr=NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee")
+  ierr=NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean")
+  ierr=NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer")
+  ierr=NF90_PUT_ATT(nid,id_FTER,"title","Fraction terre")
+  ierr=NF90_PUT_ATT(nid,id_FLIC,"title","Fraction land ice")
+  ierr=NF90_PUT_ATT(nid,id_SST ,"title","Temperature superficielle de la mer")
+  ierr=NF90_PUT_ATT(nid,id_BILS,"title","Reference flux de chaleur au sol")
+  ierr=NF90_PUT_ATT(nid,id_ALB, "title","Albedo a la surface")
+  ierr=NF90_PUT_ATT(nid,id_RUG, "title","Rugosite")
+
+  call nf95_put_att(nid, varid_longitude, "standard_name", "longitude")
+  call nf95_put_att(nid, varid_longitude, "units", "degrees_east")
+
+  call nf95_put_att(nid, varid_latitude, "standard_name", "latitude")
+  call nf95_put_att(nid, varid_latitude, "units", "degrees_north")
+
+  ierr=NF90_ENDDEF(nid)
+
+  !--- Variables saving
+  ierr=NF90_PUT_VAR(nid,id_tim,(/(REAL(k),k=1,ndays)/))
+  ierr=NF90_PUT_VAR(nid,id_FOCE,pctsrf_t(:,is_oce,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FSIC,pctsrf_t(:,is_sic,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FTER,pctsrf_t(:,is_ter,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_FLIC,pctsrf_t(:,is_lic,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_SST ,phy_sst(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_BILS,phy_bil(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_ALB ,phy_alb(:,:),(/1,1/),(/klon,ndays/))
+  ierr=NF90_PUT_VAR(nid,id_RUG ,phy_rug(:,:),(/1,1/),(/klon,ndays/))
+  call nf95_put_var(nid, varid_longitude, rlon)
+  call nf95_put_var(nid, varid_latitude, rlat)
+
+  ierr=NF90_CLOSE(nid)
+
+  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : fin'
+
+  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
+
+
+!===============================================================================
+!
+  CONTAINS
+!
+!===============================================================================
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask)
+!
+!-----------------------------------------------------------------------------
+! Comments:
+!   There are two assumptions concerning the NetCDF files, that are satisfied
+!   with files that are conforming NC convention:
+!     1) The last dimension of the variables used is the time record.
+!     2) Dimensional variables have the same names as corresponding dimensions.
+!-----------------------------------------------------------------------------
+  USE netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, &
+       NF90_CLOSE, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_GET_VAR, &
+       NF90_GET_ATT
+  USE dimphy, ONLY : klon
+  USE phys_state_var_mod, ONLY : pctsrf
+  USE control_mod
+  USE pchsp_95_m, only: pchsp_95
+  USE pchfe_95_m, only: pchfe_95
+  USE arth_m, only: arth
+  USE indice_sol_mod
+
+  IMPLICIT NONE
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "iniprint.h"
+!-----------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
+  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
+  CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
+  LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
+  INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
+  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
+  LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
+  REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
+!------------------------------------------------------------------------------
+! Local variables:
+!--- NetCDF
+  INTEGER :: ncid, varid                  ! NetCDF identifiers
+  CHARACTER(LEN=30)               :: dnam       ! dimension name
+!--- dimensions
+  INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
+  REAL, ALLOCATABLE, DIMENSION(:) :: dlon_ini   ! initial longitudes vector
+  REAL, ALLOCATABLE, DIMENSION(:) :: dlat_ini   ! initial latitudes  vector
+  REAL, POINTER,     DIMENSION(:) :: dlon, dlat ! reordered lon/lat  vectors
+!--- fields
+  INTEGER :: imdep, jmdep, lmdep                ! dimensions of 'champ'
+  REAL, ALLOCATABLE, DIMENSION(:, :) :: champ   ! wanted field on initial grid
+  REAL, ALLOCATABLE, DIMENSION(:) :: yder, timeyear
+  REAL,              DIMENSION(iim, jjp1) :: champint   ! interpolated field
+  REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: champtime
+  REAL, ALLOCATABLE, DIMENSION(:, :, :)    :: champan
+!--- input files
+  CHARACTER(LEN=20)                 :: cal_in   ! calendar
+  CHARACTER(LEN=20)                 :: unit_sic ! attribute unit in sea-ice file
+  INTEGER                           :: ndays_in ! number of days
+!--- misc
+  INTEGER :: i, j, k, l                         ! loop counters
+  REAL, ALLOCATABLE, DIMENSION(:, :) :: work     ! used for extrapolation
+  CHARACTER(LEN=25)                 :: title    ! for messages
+  LOGICAL                           :: extrp    ! flag for extrapolation
+  LOGICAL                           :: oldice   ! flag for old way ice computation 
+  REAL                              :: chmin, chmax
+  INTEGER ierr
+  integer n_extrap ! number of extrapolated points
+  logical skip
+
+!------------------------------------------------------------------------------
+!---Variables depending on keyword 'mode' -------------------------------------
+  NULLIFY(champo)
+
+  SELECT CASE(mode)
+  CASE('RUG'); title='Rugosite'
+  CASE('SIC'); title='Sea-ice'
+  CASE('SST'); title='SST'
+  CASE('ALB'); title='Albedo'
+  END SELECT
+  
+
+  extrp=.FALSE. 
+  oldice=.FALSE.
+  IF ( PRESENT(flag) ) THEN 
+    IF ( flag .AND. mode=='SST' ) extrp=.TRUE. 
+    IF ( flag .AND. mode=='SIC' ) oldice=.TRUE. 
+  END IF
+
+!--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
+  IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam
+  ierr=NF90_OPEN(fnam, NF90_NOWRITE, ncid);             CALL ncerr(ierr, fnam)
+  ierr=NF90_INQ_VARID(ncid, trim(varname), varid);            CALL ncerr(ierr, fnam)
+  ierr=NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids); CALL ncerr(ierr, fnam)
+
+!--- Read unit for sea-ice variable only
+  IF (mode=='SIC') THEN
+     ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sic)
+     IF(ierr/=NF90_NOERR) THEN
+        IF (prt_level>5) WRITE(lunout,*) 'No unit was given in sea-ice file. Take percentage as default value'
+        unit_sic='X'
+     ELSE
+        IF (prt_level>5) WRITE(lunout,*) ' Sea-ice cover has unit=',unit_sic
+     END IF
+  END IF
+
+!--- Longitude
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(1), name=dnam, len=imdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(dlon_ini(imdep), dlon(imdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
+
+!--- Latitude
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(2), name=dnam, len=jmdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(dlat_ini(jmdep), dlat(jmdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
+
+!--- Time (variable is not needed - it is rebuilt - but calendar is)
+  ierr=NF90_INQUIRE_DIMENSION(ncid, dids(3), name=dnam, len=lmdep)
+  CALL ncerr(ierr, fnam); ALLOCATE(timeyear(lmdep))
+  ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
+  cal_in=' '
+  ierr=NF90_GET_ATT(ncid, varid, 'calendar', cal_in)
+  IF(ierr/=NF90_NOERR) THEN
+    SELECT CASE(mode)
+      CASE('RUG', 'ALB'); cal_in='360d'
+      CASE('SIC', 'SST'); cal_in='gregorian'
+    END SELECT
+    IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
+         // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
+  END IF
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
+       cal_in
+
+  
+!--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
+  !--- Determining input file number of days, depending on calendar
+  ndays_in=year_len(anneeref, cal_in)
+
+!--- Time vector reconstruction (time vector from file is not trusted)
+!--- If input records are not monthly, time sampling has to be constant !
+  timeyear=mid_months(anneeref, cal_in, lmdep)
+  IF (lmdep /= 12) WRITE(lunout,*) 'Note : les fichiers de ', TRIM(mode), &
+       ' ne comportent pas 12, mais ', lmdep, ' enregistrements.'
+
+!--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
+  ALLOCATE(champ(imdep, jmdep), champtime(iim, jjp1, lmdep))
+  IF(extrp) ALLOCATE(work(imdep, jmdep))
+
+  IF (prt_level>5) WRITE(lunout, *)
+  IF (prt_level>5) WRITE(lunout,*)'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, ' CHAMPS.'
+  ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
+  DO l=1, lmdep
+    ierr=NF90_GET_VAR(ncid, varid, champ, (/1, 1, l/), (/imdep, jmdep, 1/))
+    CALL ncerr(ierr, fnam)
+    CALL conf_dat2d(title, imdep, jmdep, dlon_ini, dlat_ini, dlon, dlat, &
+         champ, ibar)
+
+    IF (extrp) CALL extrapol(champ, imdep, jmdep, 999999., .TRUE., .TRUE., 2, &
+         work)
+
+    IF(ibar .AND. .NOT.oldice) THEN
+      IF(l==1 .AND. prt_level>5) THEN
+        WRITE(lunout, *) '-------------------------------------------------------------------------'
+        WRITE(lunout, *) 'Utilisation de l''interpolation barycentrique pour ',TRIM(title),' $$$'
+        WRITE(lunout, *) '-------------------------------------------------------------------------'
+      END IF
+      IF(mode=='RUG') champ=LOG(champ)
+      CALL inter_barxy(dlon, dlat(:jmdep-1), champ, rlonu(:iim),     &
+                         rlatv, champint)
+      IF(mode=='RUG') THEN
+        champint=EXP(champint)
+        WHERE(NINT(mask)/=1) champint=0.001
+      END IF
+    ELSE
+      SELECT CASE(mode)
+        CASE('RUG');       CALL rugosite(imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint, mask)
+        CASE('SIC');       CALL sea_ice (imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint)
+        CASE('SST', 'ALB'); CALL grille_m(imdep, jmdep, dlon, dlat, champ,    &
+                                    iim, jjp1, rlonv, rlatu, champint)
+      END SELECT
+    END IF
+    champtime(:, :, l)=champint
+  END DO
+  ierr=NF90_CLOSE(ncid);                                 CALL ncerr(ierr, fnam)
+
+  DEALLOCATE(dlon_ini, dlat_ini, dlon, dlat, champ)
+  IF(extrp) DEALLOCATE(work)
+
+!--- TIME INTERPOLATION ------------------------------------------------------
+  IF (prt_level>5) THEN
+     WRITE(lunout, *)
+     WRITE(lunout, *)'INTERPOLATION TEMPORELLE.'
+     WRITE(lunout, *)' Vecteur temps en entree: ', timeyear
+     WRITE(lunout, *)' Vecteur temps en sortie de 0 a ', ndays
+  END IF
+
+  ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
+  skip = .false.
+  n_extrap = 0
+  DO j=1, jjp1
+    DO i=1, iim
+      yder = pchsp_95(timeyear, champtime(i, j, :), ibeg=2, iend=2, &
+           vc_beg=0., vc_end=0.)
+      CALL pchfe_95(timeyear, champtime(i, j, :), yder, skip, &
+           arth(0., real(ndays_in) / ndays, ndays), champan(i, j, :), ierr)
+      if (ierr < 0) stop 1
+      n_extrap = n_extrap + ierr
+    END DO
+  END DO
+  if (n_extrap /= 0) then
+     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
+  end if
+  champan(iip1, :, :)=champan(1, :, :)
+  DEALLOCATE(yder, champtime, timeyear)
+
+!--- Checking the result
+  DO j=1, jjp1
+    CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
+    IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' au temps 10 ', chmin, chmax, j
+  END DO
+
+!--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
+  IF(mode=='SST') THEN
+    IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
+    WHERE(champan<271.38) champan=271.38
+  END IF
+
+!--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
+  IF(mode=='SIC') THEN
+    IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0'
+
+    IF (unit_sic=='1') THEN
+       ! Nothing to be done for sea-ice field is already in fraction of 1
+       ! This is the case for sea-ice in file cpl_atm_sic.nc
+       IF (prt_level>5) WRITE(lunout,*) 'Sea-ice field already in fraction of 1'
+    ELSE
+       ! Convert sea ice from percentage to fraction of 1
+       IF (prt_level>5) WRITE(lunout,*) 'Transformt sea-ice field from percentage to fraction of 1.' 
+       champan(:, :, :)=champan(:, :, :)/100.
+    END IF
+
+    champan(iip1, :, :)=champan(1, :, :)
+    WHERE(champan>1.0) champan=1.0
+    WHERE(champan<0.0) champan=0.0
+ END IF
+
+!--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
+  ALLOCATE(champo(klon, ndays))
+  DO k=1, ndays
+    CALL gr_dyn_fi(1, iip1, jjp1, klon, champan(1, 1, k), champo(1, k))
+  END DO
+  DEALLOCATE(champan)
+
+END SUBROUTINE get_2Dfield
+!
+!-------------------------------------------------------------------------------
+
+
+
+!-------------------------------------------------------------------------------
+!
+FUNCTION year_len(y,cal_in)
+!
+!-------------------------------------------------------------------------------
+  USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER                       :: year_len
+  INTEGER,           INTENT(IN) :: y
+  CHARACTER(LEN=*),  INTENT(IN) :: cal_in
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=20)             :: cal_out              ! calendar (for outputs)
+!-------------------------------------------------------------------------------
+!--- Getting the input calendar to reset at the end of the function
+  CALL ioget_calendar(cal_out)
+
+!--- Unlocking calendar and setting it to wanted one
+  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+
+!--- Getting the number of days in this year
+  year_len=ioget_year_len(y)
+
+!--- Back to original calendar
+  CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+
+END FUNCTION year_len
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+FUNCTION mid_months(y,cal_in,nm)
+!
+!-------------------------------------------------------------------------------
+  USE ioipsl, ONLY : ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,                INTENT(IN) :: y               ! year
+  CHARACTER(LEN=*),       INTENT(IN) :: cal_in          ! calendar
+  INTEGER,                INTENT(IN) :: nm              ! months/year number
+  REAL,    DIMENSION(nm)             :: mid_months      ! mid-month times
+!-------------------------------------------------------------------------------
+! Local variables:
+  CHARACTER(LEN=99)                  :: mess            ! error message
+  CHARACTER(LEN=20)                  :: cal_out         ! calendar (for outputs)
+  INTEGER, DIMENSION(nm)             :: mnth            ! months lengths (days)
+  INTEGER                            :: m               ! months counter
+  INTEGER                            :: nd              ! number of days
+!-------------------------------------------------------------------------------
+  nd=year_len(y,cal_in)
+
+  IF(nm==12) THEN
+
+  !--- Getting the input calendar to reset at the end of the function
+    CALL ioget_calendar(cal_out)
+
+  !--- Unlocking calendar and setting it to wanted one
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in))
+
+  !--- Getting the length of each month
+    DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO
+
+  !--- Back to original calendar
+    CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out))
+
+  ELSE IF(MODULO(nd,nm)/=0) THEN
+    WRITE(mess,'(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&
+      nm,' months/year. Months number should divide days number.'
+    CALL abort_gcm('mid_months',TRIM(mess),1)
+
+  ELSE
+    mnth=(/(m,m=1,nm,nd/nm)/)
+  END IF
+
+!--- Mid-months times
+  mid_months(1)=0.5*REAL(mnth(1))
+  DO k=2,nm
+    mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
+  END DO
+
+END FUNCTION mid_months
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE ncerr(ncres,fnam)
+!
+!-------------------------------------------------------------------------------
+! Purpose: NetCDF errors handling.
+!-------------------------------------------------------------------------------
+  USE netcdf, ONLY : NF90_NOERR, NF90_STRERROR
+  IMPLICIT NONE
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,          INTENT(IN) :: ncres
+  CHARACTER(LEN=*), INTENT(IN) :: fnam
+!-------------------------------------------------------------------------------
+#include "iniprint.h"
+  IF(ncres/=NF90_NOERR) THEN
+    WRITE(lunout,*)'Problem with file '//TRIM(fnam)//' in routine limit_netcdf.'
+    CALL abort_gcm('limit_netcdf',NF90_STRERROR(ncres),1)
+  END IF
+
+END SUBROUTINE ncerr
+!
+!-------------------------------------------------------------------------------
+
+#endif
+! of #ifdef CPP_EARTH
+
+#endif
+! of #ifndef CPP_1D
+END SUBROUTINE limit_netcdf
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/mkstat.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/mkstat.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/mkstat.F90	(revision 3815)
@@ -0,0 +1,164 @@
+subroutine mkstats(ierr)
+
+ 
+!
+!  This program writes a stats.nc file from sums and sums of squares
+!  to means and standard deviations and also writes netcdf style
+!  file so that the data can be viewed easily.  The data file is
+!  overwritten in place.  
+!  SRL  21 May 1996
+!  Yann W. july 2003
+
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+integer :: ierr,nid,nbvar,i,ndims,lt,nvarid
+integer, dimension(4) :: id,varid,start,size
+integer, dimension(5) :: dimids
+character (len=50) :: name,nameout,units,title
+real, dimension(iip1,jjp1,llm) :: sum3d,square3d,mean3d,sd3d
+real, dimension(iip1,jjp1) :: sum2d,square2d,mean2d,sd2d
+real, dimension(istime) :: time
+real, dimension(jjp1) :: lat
+real, dimension(iip1) :: lon
+real, dimension(llm) :: alt
+logical :: lcopy=.true.
+!integer :: latid,lonid,altid,timeid
+integer :: meanid,sdid
+!integer, dimension(4) :: dimout
+
+! Incrementation of count for the last step, which is not done in wstats
+count(istime)=count(istime)+1
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+! We catch the id of dimensions of the stats file
+
+ierr= NF_INQ_DIMID(nid,"latitude",id(1))
+ierr= NF_INQ_DIMID(nid,"longitude",id(2))
+ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+ierr= NF_INQ_VARID(nid,"latitude",varid(1))
+ierr= NF_INQ_VARID(nid,"longitude",varid(2))
+ierr= NF_INQ_VARID(nid,"altitude",varid(3))
+ierr= NF_INQ_VARID(nid,"Time",varid(4))
+
+! Time initialisation
+
+do i=1,istime
+   time(i)=i*24./istime
+#ifdef NC_DOUBLE
+   ierr= NF_PUT_VARA_DOUBLE(nid,varid(4),i,1,time(i))
+#else
+   ierr= NF_PUT_VARA_REAL(nid,varid(4),i,1,time(i))
+#endif
+enddo
+
+! We catche the values of the variables
+
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(1),lat)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(2),lon)
+         ierr = NF_GET_VAR_DOUBLE(nid,varid(3),alt)
+#else
+         ierr = NF_GET_VAR_REAL(nid,varid(1),lat)
+         ierr = NF_GET_VAR_REAL(nid,varid(2),lon)
+         ierr = NF_GET_VAR_REAL(nid,varid(3),alt)
+#endif
+
+! We catch the number of variables in the stats file
+ierr = NF_INQ_NVARS(nid,nbvar)
+
+! to catche the "real" number of variables (without the "additionnal variables")
+nbvar=(nbvar-4)/2 
+
+do i=1,nbvar
+   varid=(i-1)*2+5
+
+   ! What's the variable's name?
+   ierr=NF_INQ_VARNAME(nid,varid,name)
+   write(*,*) "OK variable ",name
+   ! Its units?
+   units=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"units",units)
+   ! Its title?
+   title=" "
+   ierr=NF_GET_ATT_TEXT(nid,varid,"title",title)
+   ! Its number of dimensions?   
+   ierr=NF_INQ_VARNDIMS(nid,varid,ndims)
+   ! Its values?
+
+   if(ndims==4) then ! lat, lon, alt & time
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=altid
+!      dimout(4)=timeid
+
+      size=(/iip1,jjp1,llm,1/)
+      do lt=1,istime
+         start=(/1,1,1,lt/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square3d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum3d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square3d)
+#endif
+         ! Calculation of these variables
+         mean3d=sum3d/count(lt)
+         sd3d=sqrt(max(0.,square3d/count(lt)-mean3d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd3d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean3d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd3d)
+#endif
+      enddo
+
+    else if (ndims.eq.3) then
+
+!      dimout(1)=lonid
+!      dimout(2)=latid
+!      dimout(3)=timeid
+
+      size=(/iip1,jjp1,1,0/)
+      do lt=1,istime
+         start=(/1,1,lt,0/)
+         ! Extraction of the "source" variables
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_DOUBLE(nid,varid+1,start,size,square2d)
+#else
+         ierr = NF_GET_VARA_REAL(nid,varid,start,size,sum2d)
+         ierr = NF_GET_VARA_REAL(nid,varid+1,start,size,square2d)
+#endif
+         ! Calculation of these variables
+         mean2d=sum2d/count(lt)
+         sd2d=sqrt(max(0.,square2d/count(lt)-mean2d**2))
+         ! Writing of the variables
+#ifdef NC_DOUBLE
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_DOUBLE(nid,varid+1,start,size,sd2d)
+#else
+         ierr = NF_PUT_VARA_REAL(nid,varid,start,size,mean2d)
+         ierr = NF_PUT_VARA_REAL(nid,varid+1,start,size,sd2d)
+#endif
+      enddo
+
+    endif 
+enddo
+
+ierr= NF_CLOSE(nid)
+
+end
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/test_disvert_m.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/test_disvert_m.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/test_disvert_m.F90	(revision 3815)
@@ -0,0 +1,70 @@
+module test_disvert_m
+
+  implicit none
+
+contains
+
+  subroutine test_disvert
+
+    ! Author: Lionel GUEZ
+
+    ! This procedure tests the order of pressure values at half-levels
+    ! and full levels. We arbitrarily choose to test ngrid values of
+    ! the surface pressure, which sample possible values on Earth.
+
+    use exner_hyb_m, only: exner_hyb
+
+    ! For llm:
+    include "dimensions.h"
+
+    ! For ap, bp, preff:
+!    include "comvert.h"
+
+    ! For kappa, cpp:
+!    include "comconst.h"
+
+    ! Local:
+    integer l, i
+    integer, parameter:: ngrid = 7
+    real p(ngrid, llm + 1) ! pressure at half-level, in Pa
+    real pks(ngrid) ! exner function at the surface, in J K-1 kg-1 
+    real pk(ngrid, llm) ! exner function at full level, in J K-1 kg-1 
+    real ps(ngrid) ! surface pressure, in Pa
+    real p_lay(ngrid, llm) ! pressure at full level, in Pa
+    real delta_ps ! in Pa
+
+    !---------------------
+
+    print *, "Call sequence information: test_disvert"
+
+    delta_ps = 6e4 / (ngrid - 1)
+    ps = (/(5e4 + delta_ps * i, i = 0, ngrid - 1)/)
+    forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
+    call exner_hyb(ngrid, ps, p, pks, pk)
+    p_lay = preff * (pk / cpp)**(1. / kappa)
+
+    ! Are pressure values in the right order?
+    if (any(p(:, :llm) <= p_lay .or. p_lay <= p(:, 2:))) then
+       ! List details and stop:
+       do l = 1, llm
+          do i = 1, ngrid
+             if (p(i, l) <= p_lay(i, l)) then
+                print 1000, "ps = ", ps(i) / 100., "hPa, p(level ",  l, &
+                     ") = ", p(i, l) / 100., " hPa <= p(layer ", l, ") = ", &
+                     p_lay(i, l) / 100., " hPa"
+             end if
+             if (p_lay(i, l) <= p(i, l + 1)) then
+                print 1000, "ps = ", ps(i) / 100., "hPa, p(layer ", l, ") = ", &
+                     p_lay(i, l) / 100., " hPa <= p(level ", l + 1, ") = ", &
+                     p(i, l + 1) / 100., " hPa"
+             end if
+          end do
+       end do
+       call abort_gcm("test_disvert", "bad order of pressure values", 1)
+    end if
+
+1000 format (3(a, g10.4, a, i0))
+
+  end subroutine test_disvert
+
+end module test_disvert_m
Index: dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/wstats.F90
===================================================================
--- dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/wstats.F90	(revision 3815)
+++ dynamico_lmdz/aquaplanet/LMDZ5/libf/moved/wstats.F90	(revision 3815)
@@ -0,0 +1,351 @@
+subroutine wstats(ngrid,nom,titre,unite,dim,px)
+
+implicit none
+
+#include "dimensions.h"
+#include "statto.h"
+#include "netcdf.inc"
+
+integer,intent(in) :: ngrid
+character (len=*),intent(in) :: nom,titre,unite
+integer,intent(in) :: dim
+real, dimension(ngrid,llm),intent(in) :: px
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
+real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
+character (len=50) :: namebis
+character (len=50), save :: firstvar
+integer :: ierr,varid,nbdim,nid
+integer :: meanid,sdid
+integer, dimension(4)  :: id,start,size
+logical, save :: firstcall=.TRUE.
+integer :: l,i,j,ig0
+integer,save :: index
+
+integer, save :: step=0
+
+
+if (firstcall) then
+   firstcall=.false.
+   firstvar=trim((nom))
+   call inistats(ierr)
+endif
+
+if (firstvar==nom) then ! If we're back to the first variable
+      step = step + 1
+endif
+
+if (mod(step,istats).ne.0) then
+   RETURN
+endif
+
+ierr = NF_OPEN("stats.nc",NF_WRITE,nid)
+
+namebis=trim(nom)
+ierr= NF_INQ_VARID(nid,namebis,meanid)
+
+if (ierr.ne.NF_NOERR) then
+
+   if (firstvar==nom) then 
+      index=1
+      count=0
+   endif
+
+
+!declaration de la variable
+
+! choix du nom des coordonnees
+   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
+   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
+   if (dim.eq.3) then
+      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
+      ierr= NF_INQ_DIMID(nid,"Time",id(4))
+      nbdim=4
+   else if (dim==2) then
+      ierr= NF_INQ_DIMID(nid,"Time",id(3))
+      nbdim=3
+   endif
+
+   write (*,*) "====================="
+   write (*,*) "STATS: creation de ",nom
+   namebis=trim(nom)
+   call def_var_stats(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
+   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
+   namebis=trim(nom)//"_sd"
+   call def_var_stats(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
+   call inivar(nid,sdid,ngrid,dim,index,px,ierr)
+
+   ierr= NF_CLOSE(nid)
+   return
+
+else
+   namebis=trim(nom)//"_sd"
+   ierr= NF_INQ_VARID(nid,namebis,sdid)
+
+endif
+
+if (firstvar==nom) then 
+   count(index)=count(int(index))+1
+   index=index+1
+   if (index>istime) then
+      index=1
+   endif
+endif
+
+if (count(index)==0) then
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+      mean3d=0
+      sd3d=0
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+      mean2d=0
+      sd2d=0
+   endif
+else
+   if (dim.eq.3) then
+      start=(/1,1,1,index/)
+      size=(/iip1,jjp1,llm,1/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+
+   else if (dim.eq.2) then
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
+      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+      if (ierr.ne.NF_NOERR) then
+         write (*,*) NF_STRERROR(ierr)
+         stop ""
+      endif
+   endif
+endif
+
+if (dim.eq.3) then
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+   mean3d(:,:,:)= mean3d(:,:,:)+dx3(:,:,:)
+   sd3d(:,:,:)= sd3d(:,:,:)+dx3(:,:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
+#endif
+   if (ierr.ne.NF_NOERR) then
+     write (*,*) NF_STRERROR(ierr)
+     stop ""
+   endif
+
+else if (dim.eq.2) then
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+   mean2d(:,:)= mean2d(:,:)+dx2(:,:)
+   sd2d(:,:)= sd2d(:,:)+dx2(:,:)**2
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
+   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
+#endif
+   if (ierr.ne.NF_NOERR) then
+     write (*,*) NF_STRERROR(ierr)
+     stop ""
+   endif
+
+endif
+
+ierr= NF_CLOSE(nid)
+
+end subroutine wstats
+
+!======================================================
+subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)
+
+implicit none
+
+include "dimensions.h"
+!!!!!!include "dimphys.h"
+include "netcdf.inc"
+
+integer, intent(in) :: nid,varid,dim,index,ngrid
+real, dimension(ngrid,llm), intent(in) :: px
+integer, intent(out) :: ierr
+
+integer,parameter :: iip1=iim+1
+integer,parameter :: jjp1=jjm+1
+
+integer :: l,i,j,ig0
+integer, dimension(4) :: start,size
+real, dimension(iip1,jjp1,llm) :: dx3
+real, dimension(iip1,jjp1) :: dx2
+
+if (dim.eq.3) then
+
+   start=(/1,1,1,index/)
+   size=(/iip1,jjp1,llm,1/)
+
+!  Passage variable physique -->  variable dynamique
+
+   DO l=1,llm
+      DO i=1,iip1
+         dx3(i,1,l)=px(1,l)
+         dx3(i,jjp1,l)=px(ngrid,l)
+      ENDDO
+      DO j=2,jjm
+         ig0= 1+(j-2)*iim
+         DO i=1,iim
+            dx3(i,j,l)=px(ig0+i,l)
+         ENDDO
+         dx3(iip1,j,l)=dx3(1,j,l)
+      ENDDO
+   ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
+#endif
+
+else if (dim.eq.2) then
+
+      start=(/1,1,index,0/)
+      size=(/iip1,jjp1,1,0/)
+
+!    Passage variable physique -->  physique dynamique
+
+  DO i=1,iip1
+     dx2(i,1)=px(1,1)
+     dx2(i,jjp1)=px(ngrid,1)
+  ENDDO
+  DO j=2,jjm
+     ig0= 1+(j-2)*iim
+     DO i=1,iim
+        dx2(i,j)=px(ig0+i,1)
+     ENDDO
+     dx2(iip1,j)=dx2(1,j)
+  ENDDO
+
+#ifdef NC_DOUBLE
+   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
+#else
+   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
+#endif
+
+endif
+
+end subroutine inivar
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine def_var_stats(nid,name,title,units,nbdim,dimids,nvarid,ierr)
+
+! This subroutine defines variable 'name' in a (pre-existing and opened)
+! NetCDF file (known from its NetCDF ID 'nid').
+! The number of dimensions 'nbdim' of the variable, as well as the IDs of
+! corresponding dimensions must be set (in array 'dimids').
+! Upon successfull definition of the variable, 'nvarid' contains the
+! NetCDF ID of the variable.
+! The variables' attributes 'title' (Note that 'long_name' would be more
+! appropriate) and 'units' are also set. 
+
+implicit none
+
+#include "netcdf.inc"
+
+integer,intent(in) :: nid ! NetCDF file ID
+character(len=*),intent(in) :: name ! the variable's name
+character(len=*),intent(in) :: title ! 'title' attribute of variable
+character(len=*),intent(in) :: units ! 'units' attribute of variable
+integer,intent(in) :: nbdim ! number of dimensions of the variable
+integer,dimension(nbdim),intent(in) :: dimids ! NetCDF IDs of the dimensions
+                                              ! the variable is defined along
+integer,intent(out) :: nvarid ! NetCDF ID of the variable
+integer,intent(out) :: ierr ! returned NetCDF staus code
+
+! 1. Switch to NetCDF define mode 
+ierr=NF_REDEF(nid)
+
+! 2. Define the variable
+#ifdef NC_DOUBLE
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dimids,nvarid)
+#else
+ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dimids,nvarid)
+#endif
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed defining variable "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 3. Write attributes
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"title",&
+                     len_trim(adjustl(title)),adjustl(title))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed writing title attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+ierr=NF_PUT_ATT_TEXT(nid,nvarid,"units",&
+                     len_trim(adjustl(units)),adjustl(units))
+if(ierr/=NF_NOERR) then
+   write(*,*) "def_var_stats: Failed writing units attribute for "//trim(name)
+   write(*,*) NF_STRERROR(ierr)
+   stop ""
+endif
+
+! 4. Switch out of NetCDF define mode
+ierr = NF_ENDDEF(nid)
+
+end subroutine def_var_stats
+
