Changeset 5104 for LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d

Timestamp:

Jul 23, 2024, 5:57:06 PM (6 months ago)

Author:

abarral

Message:

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F in DUST to *.f90

Location:

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d

Files:

• lmdz1d.F90 (modified) (2 diffs)
• lmdz_1dutils.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1DUTILS.h) (2 diffs)
• lmdz_old_1dconv.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1Dconv.h) (1 diff)
• lmdz_old_lmdz1d.F90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_lmdz1d.F90) (1 diff)
• lmdz_scm.F90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/scm.F90) (1 diff)

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz1d.F90

@@ -1 +1 @@
 ! $Id$
-
-!#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: getin
+  USE lmdz_scm, ONLY: scm
+  USE lmdz_old_lmdz1d, ONLY: old_lmdz1d
   IMPLICIT NONE
 
@@ -20 +16 @@
     CALL old_lmdz1d
   ENDIF
-
 END
 
 
-include "1DUTILS.h"
-include "1Dconv.h"
 
-
-
-

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

@@ -1 @@
-! $Id$
-
-INCLUDE "conf_gcm.f90"
-
-SUBROUTINE conf_unicol
-
-  use IOIPSL
-  USE print_control_mod, ONLY: lunout
-  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 "fcg_racmo.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 debogage
-  !Config  Def  = 0
-  !Config  Help = Niveau d'impression pour le debogage
-  !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
-  !         > 100 ==> forcing_case = .TRUE. or forcing_case2 = .TRUE.
-  !             initial profiles from case.nc file
-
-  forcing_type = 0
-  CALL getin('forcing_type', forcing_type)
-  imp_fcg_gcssold = .FALSE.
-  ts_fcg_gcssold = .FALSE.
-  Tp_fcg_gcssold = .FALSE.
-  Tp_ini_gcssold = .FALSE.
-  xTurb_fcg_gcssold = .FALSE.
-  IF (forcing_type ==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
-
-  !Parametres de forcage
-  !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_forc_tsurf
-  !Config  Desc = forcage ou non par la Ts
-  !Config  Def  = false
-  !Config  Help = forcage ou non par la Ts
-  ok_forc_tsurf = .FALSE.
-  CALL getin('ok_forc_tsurf', ok_forc_tsurf)
-
-  !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_prescr_beta
-  !Config  Desc = betaevap impose ou non
-  !Config  Def  = false
-  !Config  Help = betaevap impose ou non
-  ok_prescr_beta = .FALSE.
-  CALL getin('ok_prescr_beta', ok_prescr_beta)
-
-  !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 =
-  time_ini = 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 = surface temperature
-  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)
-  ! EV pour accord avec format standard
-  CALL getin('zorog', 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)
-  ! FH/2020/04/08/confinement: Pour le nouveau format standard, la rugosite s'appelle z0
-  CALL getin('z0', rugos)
-
-  !Config  Key  = rugosh
-  !Config  Desc = coefficient de frottement
-  !Config  Def  = rugos
-  !Config  Help = calcul du Cdrag
-  rugosh = rugos
-  CALL getin('rugosh', rugosh)
-
-
-
-  !Config  Key  = snowmass
-  !Config  Desc = mass de neige de la surface en kg/m2
-  !Config  Def  = 0.0000
-  !Config  Help = snowmass
-  snowmass = 0.0000
-  CALL getin('snowmass', snowmass)
-
-  !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  = betaevap
-  !Config  Desc = beta for actual evaporation when prescribed
-  !Config  Def  = 1.0
-  !Config  Help =
-  betaevap = 1.
-  CALL getin('betaevap', betaevap)
-
-  !Config  Key  = zpicinp
-  !Config  Desc = denivellation orographie
-  !Config  Def  = 0.
-  !Config  Help =  input brise
-  zpicinp = 0.
-  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)
-
-  !----------------------------------------------------------
-  ! Param??tres de for??age pour les forcages communs:
-  ! Pour les forcages communs: ces entiers valent 0 ou 1
-  ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
-  ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
-  ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
-  ! forcages en omega, w, vent geostrophique ou ustar
-  ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
-  !----------------------------------------------------------
-
-  !Config  Key  = tadv
-  !Config  Desc = forcage ou non par advection totale de T
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection totale de T
-  tadv = 0
-  CALL getin('tadv', tadv)
-
-  !Config  Key  = tadvv
-  !Config  Desc = forcage ou non par advection verticale de T
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection verticale de T
-  tadvv = 0
-  CALL getin('tadvv', tadvv)
-
-  !Config  Key  = tadvh
-  !Config  Desc = forcage ou non par advection horizontale de T
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection horizontale de T
-  tadvh = 0
-  CALL getin('tadvh', tadvh)
-
-  !Config  Key  = thadv
-  !Config  Desc = forcage ou non par advection totale de Theta
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection totale de Theta
-  thadv = 0
-  CALL getin('thadv', thadv)
-
-  !Config  Key  = thadvv
-  !Config  Desc = forcage ou non par advection verticale de Theta
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection verticale de Theta
-  thadvv = 0
-  CALL getin('thadvv', thadvv)
-
-  !Config  Key  = thadvh
-  !Config  Desc = forcage ou non par advection horizontale de Theta
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection horizontale de Theta
-  thadvh = 0
-  CALL getin('thadvh', thadvh)
-
-  !Config  Key  = qadv
-  !Config  Desc = forcage ou non par advection totale de Q
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection totale de Q
-  qadv = 0
-  CALL getin('qadv', qadv)
-
-  !Config  Key  = qadvv
-  !Config  Desc = forcage ou non par advection verticale de Q
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection verticale de Q
-  qadvv = 0
-  CALL getin('qadvv', qadvv)
-
-  !Config  Key  = qadvh
-  !Config  Desc = forcage ou non par advection horizontale de Q
-  !Config  Def  = false
-  !Config  Help = forcage ou non par advection horizontale de Q
-  qadvh = 0
-  CALL getin('qadvh', qadvh)
-
-  !Config  Key  = trad
-  !Config  Desc = forcage ou non par tendance radiative
-  !Config  Def  = false
-  !Config  Help = forcage ou non par tendance radiative
-  trad = 0
-  CALL getin('trad', trad)
-
-  !Config  Key  = forc_omega
-  !Config  Desc = forcage ou non par omega
-  !Config  Def  = false
-  !Config  Help = forcage ou non par omega
-  forc_omega = 0
-  CALL getin('forc_omega', forc_omega)
-
-  !Config  Key  = forc_u
-  !Config  Desc = forcage ou non par u
-  !Config  Def  = false
-  !Config  Help = forcage ou non par u
-  forc_u = 0
-  CALL getin('forc_u', forc_u)
-
-  !Config  Key  = forc_v
-  !Config  Desc = forcage ou non par v
-  !Config  Def  = false
-  !Config  Help = forcage ou non par v
-  forc_v = 0
-  CALL getin('forc_v', forc_v)
-  !Config  Key  = forc_w
-  !Config  Desc = forcage ou non par w
-  !Config  Def  = false
-  !Config  Help = forcage ou non par w
-  forc_w = 0
-  CALL getin('forc_w', forc_w)
-
-  !Config  Key  = forc_geo
-  !Config  Desc = forcage ou non par geo
-  !Config  Def  = false
-  !Config  Help = forcage ou non par geo
-  forc_geo = 0
-  CALL getin('forc_geo', forc_geo)
-
-  ! Meme chose que ok_precr_ust
-  !Config  Key  = forc_ustar
-  !Config  Desc = forcage ou non par ustar
-  !Config  Def  = false
-  !Config  Help = forcage ou non par ustar
-  forc_ustar = 0
-  CALL getin('forc_ustar', forc_ustar)
-  IF (forc_ustar == 1) ok_prescr_ust = .TRUE.
-
-
-  !Config  Key  = nudging_u
-  !Config  Desc = forcage ou non par nudging sur u
-  !Config  Def  = false
-  !Config  Help = forcage ou non par nudging sur u
-  nudging_u = 0
-  CALL getin('nudging_u', nudging_u)
-
-  !Config  Key  = nudging_v
-  !Config  Desc = forcage ou non par nudging sur v
-  !Config  Def  = false
-  !Config  Help = forcage ou non par nudging sur v
-  nudging_v = 0
-  CALL getin('nudging_v', nudging_v)
-
-  !Config  Key  = nudging_w
-  !Config  Desc = forcage ou non par nudging sur w
-  !Config  Def  = false
-  !Config  Help = forcage ou non par nudging sur w
-  nudging_w = 0
-  CALL getin('nudging_w', nudging_w)
-
-  ! RELIQUE ANCIENS FORMAT. ECRASE PAR LE SUIVANT
-  !Config  Key  = nudging_q
-  !Config  Desc = forcage ou non par nudging sur q
-  !Config  Def  = false
-  !Config  Help = forcage ou non par nudging sur q
-  nudging_qv = 0
-  CALL getin('nudging_q', nudging_qv)
-  CALL getin('nudging_qv', nudging_qv)
-
-  p_nudging_u = 11000.
-  p_nudging_v = 11000.
-  p_nudging_t = 11000.
-  p_nudging_qv = 11000.
-  CALL getin('p_nudging_u', p_nudging_u)
-  CALL getin('p_nudging_v', p_nudging_v)
-  CALL getin('p_nudging_t', p_nudging_t)
-  CALL getin('p_nudging_qv', p_nudging_qv)
-
-  !Config  Key  = nudging_t
-  !Config  Desc = forcage ou non par nudging sur t
-  !Config  Def  = false
-  !Config  Help = forcage ou non par nudging sur t
-  nudging_t = 0
-  CALL getin('nudging_t', nudging_t)
-
-  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, *)' snowmass=', snowmass
-  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
-  write(lunout, *)' tadv =      ', tadv
-  write(lunout, *)' tadvv =     ', tadvv
-  write(lunout, *)' tadvh =     ', tadvh
-  write(lunout, *)' thadv =     ', thadv
-  write(lunout, *)' thadvv =    ', thadvv
-  write(lunout, *)' thadvh =    ', thadvh
-  write(lunout, *)' qadv =      ', qadv
-  write(lunout, *)' qadvv =     ', qadvv
-  write(lunout, *)' qadvh =     ', qadvh
-  write(lunout, *)' trad =      ', trad
-  write(lunout, *)' forc_omega = ', forc_omega
-  write(lunout, *)' forc_w     = ', forc_w
-  write(lunout, *)' forc_geo   = ', forc_geo
-  write(lunout, *)' forc_ustar = ', forc_ustar
-  write(lunout, *)' nudging_u  = ', nudging_u
-  write(lunout, *)' nudging_v  = ', nudging_v
-  write(lunout, *)' nudging_t  = ', nudging_t
-  write(lunout, *)' nudging_qv  = ', nudging_qv
-  IF (forcing_type ==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
-  USE comconst_mod, ONLY: im, jm, lllm
-  USE logic_mod, ONLY: fxyhypb, ysinus
-  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn
-  USE netcdf, ONLY: nf90_open, nf90_write, nf90_noerr
-
-  IMPLICIT NONE
-  !=======================================================
-  ! Ecriture du fichier de redemarrage sous format NetCDF
-  !=======================================================
-  !   Declarations:
-  !   -------------
-  include "dimensions.h"
-  !!#include "control.h"
-
-  !   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
-  DO iq = 1, nqtot
-    nmq(iq) = trim(tracers(iq)%name)
-  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)==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)==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
-  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
-  USE logic_mod, ONLY: fxyhypb, ysinus
-  USE temps_mod, ONLY: annee_ref, day_end, day_ref, itau_dyn, itaufin
-  USE netcdf, ONLY: nf90_open, nf90_write, nf90_noerr
-
-  IMPLICIT NONE
-  !=======================================================
-  ! Ecriture du fichier de redemarrage sous format NetCDF
-  !=======================================================
-  !   Declarations:
-  !   -------------
-  include "dimensions.h"
-  !!#include "control.h"
-
-  !   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 pass
-
-  CALL open_restartphy(fichnom)
-  PRINT*, 'redm1 ', fichnom, klon, klev, nqtot
-  !!      nmq(1)="vap"
-  !!      nmq(2)="cond"
-  !!      nmq(3)="tra1"
-  !!      nmq(4)="tra2"
-  DO iq = 1, nqtot
-    nmq(iq) = trim(tracers(iq)%name)
-  ENDDO
-
-  !     modname = 'dyn1dredem'
-  !     ierr = nf90_open(fichnom, nf90_write, nid)
-  !     IF (ierr .NE. nf90_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)
-
-  DO pass = 1, 2
-    CALL put_var(pass, "controle", "Param. de controle Dyn1D", tab_cntrl)
-
-    !  Ecriture/extension de la coordonnee temps
-
-
-    !  Ecriture des champs
-
-    CALL put_field(pass, "plev", "p interfaces sauf la nulle", plev)
-    CALL put_field(pass, "play", "", play)
-    CALL put_field(pass, "phi", "geopotentielle", phi)
-    CALL put_field(pass, "phis", "geopotentiell de surface", phis)
-    CALL put_field(pass, "presnivs", "", presnivs)
-    CALL put_field(pass, "ucov", "", ucov)
-    CALL put_field(pass, "vcov", "", vcov)
-    CALL put_field(pass, "temp", "", temp)
-    CALL put_field(pass, "omega2", "", omega2)
+MODULE lmdz_1dutils
+  IMPLICIT NONE; PRIVATE
+  PUBLIC fq_sat, conf_unicol, dyn1deta0, dyn1dredem, gr_fi_dyn, abort_gcm, gr_dyn_fi, &
+          disvert0, advect_vert, advect_va, lstendh, nudge_rht_init, nudge_uv_init, &
+          nudge_rht, nudge_uv, interp2_case_vertical
+CONTAINS
+  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, INTENT(IN) :: 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 <= 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
+  END FUNCTION fq_sat
+
+  SUBROUTINE conf_unicol
+
+    use IOIPSL
+    USE print_control_mod, ONLY: lunout
+    !-----------------------------------------------------------------------
+    !     Auteurs :   A. Lahellec  .
+
+    !   Declarations :
+    !   --------------
+
+    include "compar1d.h"
+    include "flux_arp.h"
+    include "tsoilnudge.h"
+    include "fcg_gcssold.h"
+    include "fcg_racmo.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 debogage
+    !Config  Def  = 0
+    !Config  Help = Niveau d'impression pour le debogage
+    !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
+    !         > 100 ==> forcing_case = .TRUE. or forcing_case2 = .TRUE.
+    !             initial profiles from case.nc file
+
+    forcing_type = 0
+    CALL getin('forcing_type', forcing_type)
+    imp_fcg_gcssold = .FALSE.
+    ts_fcg_gcssold = .FALSE.
+    Tp_fcg_gcssold = .FALSE.
+    Tp_ini_gcssold = .FALSE.
+    xTurb_fcg_gcssold = .FALSE.
+    IF (forcing_type ==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
+
+    !Parametres de forcage
+    !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_forc_tsurf
+    !Config  Desc = forcage ou non par la Ts
+    !Config  Def  = false
+    !Config  Help = forcage ou non par la Ts
+    ok_forc_tsurf = .FALSE.
+    CALL getin('ok_forc_tsurf', ok_forc_tsurf)
+
+    !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_prescr_beta
+    !Config  Desc = betaevap impose ou non
+    !Config  Def  = false
+    !Config  Help = betaevap impose ou non
+    ok_prescr_beta = .FALSE.
+    CALL getin('ok_prescr_beta', ok_prescr_beta)
+
+    !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 =
+    time_ini = 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 = surface temperature
+    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)
+    ! EV pour accord avec format standard
+    CALL getin('zorog', 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)
+    ! FH/2020/04/08/confinement: Pour le nouveau format standard, la rugosite s'appelle z0
+    CALL getin('z0', rugos)
+
+    !Config  Key  = rugosh
+    !Config  Desc = coefficient de frottement
+    !Config  Def  = rugos
+    !Config  Help = calcul du Cdrag
+    rugosh = rugos
+    CALL getin('rugosh', rugosh)
+
+
+
+    !Config  Key  = snowmass
+    !Config  Desc = mass de neige de la surface en kg/m2
+    !Config  Def  = 0.0000
+    !Config  Help = snowmass
+    snowmass = 0.0000
+    CALL getin('snowmass', snowmass)
+
+    !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  = betaevap
+    !Config  Desc = beta for actual evaporation when prescribed
+    !Config  Def  = 1.0
+    !Config  Help =
+    betaevap = 1.
+    CALL getin('betaevap', betaevap)
+
+    !Config  Key  = zpicinp
+    !Config  Desc = denivellation orographie
+    !Config  Def  = 0.
+    !Config  Help =  input brise
+    zpicinp = 0.
+    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)
+
+    !----------------------------------------------------------
+    ! Param??tres de for??age pour les forcages communs:
+    ! Pour les forcages communs: ces entiers valent 0 ou 1
+    ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
+    ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
+    ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
+    ! forcages en omega, w, vent geostrophique ou ustar
+    ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
+    !----------------------------------------------------------
+
+    !Config  Key  = tadv
+    !Config  Desc = forcage ou non par advection totale de T
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection totale de T
+    tadv = 0
+    CALL getin('tadv', tadv)
+
+    !Config  Key  = tadvv
+    !Config  Desc = forcage ou non par advection verticale de T
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection verticale de T
+    tadvv = 0
+    CALL getin('tadvv', tadvv)
+
+    !Config  Key  = tadvh
+    !Config  Desc = forcage ou non par advection horizontale de T
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection horizontale de T
+    tadvh = 0
+    CALL getin('tadvh', tadvh)
+
+    !Config  Key  = thadv
+    !Config  Desc = forcage ou non par advection totale de Theta
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection totale de Theta
+    thadv = 0
+    CALL getin('thadv', thadv)
+
+    !Config  Key  = thadvv
+    !Config  Desc = forcage ou non par advection verticale de Theta
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection verticale de Theta
+    thadvv = 0
+    CALL getin('thadvv', thadvv)
+
+    !Config  Key  = thadvh
+    !Config  Desc = forcage ou non par advection horizontale de Theta
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection horizontale de Theta
+    thadvh = 0
+    CALL getin('thadvh', thadvh)
+
+    !Config  Key  = qadv
+    !Config  Desc = forcage ou non par advection totale de Q
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection totale de Q
+    qadv = 0
+    CALL getin('qadv', qadv)
+
+    !Config  Key  = qadvv
+    !Config  Desc = forcage ou non par advection verticale de Q
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection verticale de Q
+    qadvv = 0
+    CALL getin('qadvv', qadvv)
+
+    !Config  Key  = qadvh
+    !Config  Desc = forcage ou non par advection horizontale de Q
+    !Config  Def  = false
+    !Config  Help = forcage ou non par advection horizontale de Q
+    qadvh = 0
+    CALL getin('qadvh', qadvh)
+
+    !Config  Key  = trad
+    !Config  Desc = forcage ou non par tendance radiative
+    !Config  Def  = false
+    !Config  Help = forcage ou non par tendance radiative
+    trad = 0
+    CALL getin('trad', trad)
+
+    !Config  Key  = forc_omega
+    !Config  Desc = forcage ou non par omega
+    !Config  Def  = false
+    !Config  Help = forcage ou non par omega
+    forc_omega = 0
+    CALL getin('forc_omega', forc_omega)
+
+    !Config  Key  = forc_u
+    !Config  Desc = forcage ou non par u
+    !Config  Def  = false
+    !Config  Help = forcage ou non par u
+    forc_u = 0
+    CALL getin('forc_u', forc_u)
+
+    !Config  Key  = forc_v
+    !Config  Desc = forcage ou non par v
+    !Config  Def  = false
+    !Config  Help = forcage ou non par v
+    forc_v = 0
+    CALL getin('forc_v', forc_v)
+    !Config  Key  = forc_w
+    !Config  Desc = forcage ou non par w
+    !Config  Def  = false
+    !Config  Help = forcage ou non par w
+    forc_w = 0
+    CALL getin('forc_w', forc_w)
+
+    !Config  Key  = forc_geo
+    !Config  Desc = forcage ou non par geo
+    !Config  Def  = false
+    !Config  Help = forcage ou non par geo
+    forc_geo = 0
+    CALL getin('forc_geo', forc_geo)
+
+    ! Meme chose que ok_precr_ust
+    !Config  Key  = forc_ustar
+    !Config  Desc = forcage ou non par ustar
+    !Config  Def  = false
+    !Config  Help = forcage ou non par ustar
+    forc_ustar = 0
+    CALL getin('forc_ustar', forc_ustar)
+    IF (forc_ustar == 1) ok_prescr_ust = .TRUE.
+
+
+    !Config  Key  = nudging_u
+    !Config  Desc = forcage ou non par nudging sur u
+    !Config  Def  = false
+    !Config  Help = forcage ou non par nudging sur u
+    nudging_u = 0
+    CALL getin('nudging_u', nudging_u)
+
+    !Config  Key  = nudging_v
+    !Config  Desc = forcage ou non par nudging sur v
+    !Config  Def  = false
+    !Config  Help = forcage ou non par nudging sur v
+    nudging_v = 0
+    CALL getin('nudging_v', nudging_v)
+
+    !Config  Key  = nudging_w
+    !Config  Desc = forcage ou non par nudging sur w
+    !Config  Def  = false
+    !Config  Help = forcage ou non par nudging sur w
+    nudging_w = 0
+    CALL getin('nudging_w', nudging_w)
+
+    ! RELIQUE ANCIENS FORMAT. ECRASE PAR LE SUIVANT
+    !Config  Key  = nudging_q
+    !Config  Desc = forcage ou non par nudging sur q
+    !Config  Def  = false
+    !Config  Help = forcage ou non par nudging sur q
+    nudging_qv = 0
+    CALL getin('nudging_q', nudging_qv)
+    CALL getin('nudging_qv', nudging_qv)
+
+    p_nudging_u = 11000.
+    p_nudging_v = 11000.
+    p_nudging_t = 11000.
+    p_nudging_qv = 11000.
+    CALL getin('p_nudging_u', p_nudging_u)
+    CALL getin('p_nudging_v', p_nudging_v)
+    CALL getin('p_nudging_t', p_nudging_t)
+    CALL getin('p_nudging_qv', p_nudging_qv)
+
+    !Config  Key  = nudging_t
+    !Config  Desc = forcage ou non par nudging sur t
+    !Config  Def  = false
+    !Config  Help = forcage ou non par nudging sur t
+    nudging_t = 0
+    CALL getin('nudging_t', nudging_t)
+
+    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, *)' snowmass=', snowmass
+    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
+    write(lunout, *)' tadv =      ', tadv
+    write(lunout, *)' tadvv =     ', tadvv
+    write(lunout, *)' tadvh =     ', tadvh
+    write(lunout, *)' thadv =     ', thadv
+    write(lunout, *)' thadvv =    ', thadvv
+    write(lunout, *)' thadvh =    ', thadvh
+    write(lunout, *)' qadv =      ', qadv
+    write(lunout, *)' qadvv =     ', qadvv
+    write(lunout, *)' qadvh =     ', qadvh
+    write(lunout, *)' trad =      ', trad
+    write(lunout, *)' forc_omega = ', forc_omega
+    write(lunout, *)' forc_w     = ', forc_w
+    write(lunout, *)' forc_geo   = ', forc_geo
+    write(lunout, *)' forc_ustar = ', forc_ustar
+    write(lunout, *)' nudging_u  = ', nudging_u
+    write(lunout, *)' nudging_v  = ', nudging_v
+    write(lunout, *)' nudging_t  = ', nudging_t
+    write(lunout, *)' nudging_qv  = ', nudging_qv
+    IF (forcing_type ==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, *)
+
+  END SUBROUTINE conf_unicol
+
+
+  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
+    USE comconst_mod, ONLY: im, jm, lllm
+    USE logic_mod, ONLY: fxyhypb, ysinus
+    USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn
+    USE netcdf, ONLY: nf90_open, nf90_write, nf90_noerr
+
+    IMPLICIT NONE
+    !=======================================================
+    ! Ecriture du fichier de redemarrage sous format NetCDF
+    !=======================================================
+    !   Declarations:
+    !   -------------
+    include "dimensions.h"
+
+    !   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
+    DO iq = 1, nqtot
+      nmq(iq) = trim(tracers(iq)%name)
+    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)==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)==1.) ysinus = .TRUE.
+    ENDIF
+
+    day_ini = tab_cntrl(30)
+    itau_dyn = tab_cntrl(31)
+
+    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 put_field(pass, "q" // nmq(iq), "eau vap ou condens et traceurs", &
-              &                                                      q(:, :, iq))
+      CALL get_field("q" // nmq(iq), q(:, :, iq), found)
+      IF (.NOT.found)PRINT*, modname // 'Le champ <q' // nmq // '> est absent'
     EndDo
-    IF (pass==1) CALL enddef_restartphy
-    IF (pass==2) CALL close_restartphy
-
-  ENDDO
-
-  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
+
+    CALL close_startphy
+    PRINT*, ' close startphy', fichnom, play(1, 1), play(1, klev), temp(1, klev)
+  END SUBROUTINE dyn1deta0
+
+
+  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
+    USE comconst_mod, ONLY: cpp, daysec, dtvr, g, kappa, omeg, rad
+    USE logic_mod, ONLY: fxyhypb, ysinus
+    USE temps_mod, ONLY: annee_ref, day_end, day_ref, itau_dyn, itaufin
+    USE netcdf, ONLY: nf90_open, nf90_write, nf90_noerr
+
+    IMPLICIT NONE
+    !=======================================================
+    ! Ecriture du fichier de redemarrage sous format NetCDF
+    !=======================================================
+    !   Declarations:
+    !   -------------
+    include "dimensions.h"
+
+    !   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 pass
+
+    CALL open_restartphy(fichnom)
+    PRINT*, 'redm1 ', fichnom, klon, klev, nqtot
+    !!      nmq(1)="vap"
+    !!      nmq(2)="cond"
+    !!      nmq(3)="tra1"
+    !!      nmq(4)="tra2"
+    DO iq = 1, nqtot
+      nmq(iq) = trim(tracers(iq)%name)
+    ENDDO
+
+    !     modname = 'dyn1dredem'
+    !     ierr = nf90_open(fichnom, nf90_write, nid)
+    !     IF (ierr .NE. nf90_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)
+
+    DO pass = 1, 2
+      CALL put_var(pass, "controle", "Param. de controle Dyn1D", tab_cntrl)
+
+      !  Ecriture/extension de la coordonnee temps
+
+
+      !  Ecriture des champs
+
+      CALL put_field(pass, "plev", "p interfaces sauf la nulle", plev)
+      CALL put_field(pass, "play", "", play)
+      CALL put_field(pass, "phi", "geopotentielle", phi)
+      CALL put_field(pass, "phis", "geopotentiell de surface", phis)
+      CALL put_field(pass, "presnivs", "", presnivs)
+      CALL put_field(pass, "ucov", "", ucov)
+      CALL put_field(pass, "vcov", "", vcov)
+      CALL put_field(pass, "temp", "", temp)
+      CALL put_field(pass, "omega2", "", omega2)
+
+      Do iq = 1, nqtot
+        CALL put_field(pass, "q" // nmq(iq), "eau vap ou condens et traceurs", &
+                &                                                      q(:, :, iq))
+      EndDo
+      IF (pass==1) CALL enddef_restartphy
+      IF (pass==2) CALL close_restartphy
+
+    ENDDO
+
+    RETURN
+  END SUBROUTINE dyn1dredem
+
+
+  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 gr_fi_dyn
+
+
+  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 == 0) then
+      write(*, *) 'Everything is cool'
+    else
+      write(*, *) 'Houston, we have a problem ', ierr
+    endif
+    STOP
+  END SUBROUTINE abort_gcm
+
+
+  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/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
+            &    STOP 'probleme de dim'
     !   traitement des poles
-    DO i = 1, im
-      pdyn(i, 1, ifield) = pfi(1, ifield)
-      pdyn(i, jm, ifield) = pfi(ngrid, ifield)
+    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
-
-    !   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)
+  END SUBROUTINE gr_dyn_fi
+
+
+  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==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 l = 1, llm
+        dsig(l) = (alpha + (1. - alpha) * exp(-beta * (llm - l))) * &
+                &          ((tanh(gama * l) / tanh(gama * llm))**np + &
+                        &            (1. - l / FLOAT(llm)) * delta)
+      END DO
+
+      sig(1) = 1.
+      DO l = 1, llm - 1
+        sig(l + 1) = sig(l) * (1. - dsig(l)) / (1. + dsig(l))
+      END DO
+      sig(llm + 1) = 0.
+
+      DO l = 1, llm
+        dsig(l) = sig(l) - sig(l + 1)
+      END DO
+
+    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
-  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 == 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 <= 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/=2 + (jm - 2) * (im - 1).AND.ngrid/=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)
+
+    DO l = 1, llmp1
+      nivsig(l) = FLOAT(l)
     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==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)
+
+    !    ....  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
-      dsig(l) = (alpha + (1. - alpha) * exp(-beta * (llm - l))) * &
-              &          ((tanh(gama * l) / tanh(gama * llm))**np + &
-                      &            (1. - l / FLOAT(llm)) * delta)
-    END DO
-
-    sig(1) = 1.
-    DO l = 1, llm - 1
-      sig(l + 1) = sig(l) * (1. - dsig(l)) / (1. + dsig(l))
-    END DO
-    sig(llm + 1) = 0.
+      !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
-      dsig(l) = sig(l) - sig(l + 1)
-    END DO
-
-  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)
+      dpres(l) = bp(l) - bp(l + 1)
+      presnivs(l) = 0.5 * (ap(l) + bp(l) * preff + ap(l + 1) + bp(l + 1) * preff)
     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
-  !   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
-  !   a les memes caracteristiques 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==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==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
-  !   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
-  !   a les memes caracteristiques 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
-
-!======================================================================
-
-!  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)<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, rhnew
-
-  ! 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) > 10000.) THEN
+
+    PRINT *, ' PRESNIVS '
+    PRINT *, presnivs
+  END SUBROUTINE disvert0
+
+  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
+  end SUBROUTINE advect_vert
+
+  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
+    !   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
+    !   a les memes caracteristiques 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==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==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
+  end SUBROUTINE advect_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
+    !   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
+    !   a les memes caracteristiques 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)
+  end SUBROUTINE lstendH
+
+
+  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)<RTT) THEN
           zx_qs = qsats(t(i, k)) / (pplay(i, k))
@@ -1615 +1464 @@
           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) * dtime
-        !jyg<
-        !   Formule pour q :
-        !                         d_q = (1/tau) [rh_targ*qsat(T_new) - q]
-
-        !  Cette formule remplace d_q = (1/tau) [rh_targ - rh] qsat(T_new)
-        !   qui n'etait pas correcte.
-
-        IF (tnew<RTT) THEN
-          zx_qs = qsats(tnew) / (pplay(i, k))
-        ELSE
-          zx_qs = qsatl(tnew) / (pplay(i, k))
+        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_rht_init
+
+  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, rhnew
+
+    ! 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) > 10000.) THEN
+          IF (t(i, k)<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) * dtime
+          !jyg<
+          !   Formule pour q :
+          !                         d_q = (1/tau) [rh_targ*qsat(T_new) - q]
+
+          !  Cette formule remplace d_q = (1/tau) [rh_targ - rh] qsat(T_new)
+          !   qui n'etait pas correcte.
+
+          IF (tnew<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
+          d_q(i, k) = d_q(i, k) + (1. / tau) * (rh_targ(i, k) * zx_qs - q(i, k))
+          rhnew = (q(i, k) + d_q(i, k) * dtime) / zx_qs
+
+          print *, ' k,d_t,rh,d_rh,rhnew,d_q ', &
+                  k, d_t(i, k), rh, d_rh, rhnew, d_q(i, k)
         ENDIF
-        !!            d_q(i,k) = d_q(i,k) + d_rh*zx_qs
-        d_q(i, k) = d_q(i, k) + (1. / tau) * (rh_targ(i, k) * zx_qs - q(i, k))
-        rhnew = (q(i, k) + d_q(i, k) * dtime) / zx_qs
-
-        print *, ' k,d_t,rh,d_rh,rhnew,d_q ', &
-                k, d_t(i, k), rh, d_rh, rhnew, d_q(i, k)
-      ENDIF
-
+
+      ENDDO
     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./
-  DATA tau /43200./
-
-  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
-      !CR: nudging everywhere
-      !           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
-
+
+    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./
+    DATA tau /43200./
+
+    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
+        !CR: nudging everywhere
+        !           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
-  ENDDO
-
-  RETURN
-END
-
-!=====================================================================
-SUBROUTINE interp2_case_vertical(play, nlev_cas, plev_prof_cas                                    &
-        &, t_prof_cas, th_prof_cas, thv_prof_cas, thl_prof_cas                                       &
-        &, qv_prof_cas, ql_prof_cas, qi_prof_cas, u_prof_cas, v_prof_cas                              &
-        &, ug_prof_cas, vg_prof_cas, vitw_prof_cas, omega_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 &
-        &, dth_prof_cas, hth_prof_cas, vth_prof_cas                                                 &
-
-        &, t_mod_cas, theta_mod_cas, thv_mod_cas, thl_mod_cas                                        &
-        &, qv_mod_cas, ql_mod_cas, qi_mod_cas, u_mod_cas, v_mod_cas                                   &
-        &, ug_mod_cas, vg_mod_cas, w_mod_cas, omega_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        &
-        &, dth_mod_cas, hth_mod_cas, vth_mod_cas, mxcalc)
-
-  implicit none
-
-  include "YOMCST.h"
-  include "dimensions.h"
-
-  !-------------------------------------------------------------------------
-  ! Vertical interpolation of generic case 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), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
-  real qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_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), omega_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 dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_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), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
-  real qv_mod_cas(llm), ql_mod_cas(llm), qi_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), omega_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 dth_mod_cas(llm), hth_mod_cas(llm), vth_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
-  !       print *,'debut interp2, play=',l,play(l)
-  !       enddo
-  !      do l = 1, nlev_cas
-  !      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
-  !      enddo
-
-  do l = 1, llm
-
-    if (play(l)>=plev_prof_cas(nlev_cas)) then
-
-      mxcalc = l
-      !        print *,'debut interp2, mxcalc=',mxcalc
-      k1 = 0
-      k2 = 0
-
-      if (play(l)<=plev_prof_cas(1)) then
-
-        do k = 1, nlev_cas - 1
-          if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k + 1)) then
-            k1 = k
-            k2 = k + 1
+
+    RETURN
+  END
+
+  SUBROUTINE interp2_case_vertical(play, nlev_cas, plev_prof_cas                                    &
+          &, t_prof_cas, th_prof_cas, thv_prof_cas, thl_prof_cas                                       &
+          &, qv_prof_cas, ql_prof_cas, qi_prof_cas, u_prof_cas, v_prof_cas                              &
+          &, ug_prof_cas, vg_prof_cas, vitw_prof_cas, omega_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 &
+          &, dth_prof_cas, hth_prof_cas, vth_prof_cas                                                 &
+
+          &, t_mod_cas, theta_mod_cas, thv_mod_cas, thl_mod_cas                                        &
+          &, qv_mod_cas, ql_mod_cas, qi_mod_cas, u_mod_cas, v_mod_cas                                   &
+          &, ug_mod_cas, vg_mod_cas, w_mod_cas, omega_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        &
+          &, dth_mod_cas, hth_mod_cas, vth_mod_cas, mxcalc)
+
+    implicit none
+
+    include "YOMCST.h"
+    include "dimensions.h"
+
+    !-------------------------------------------------------------------------
+    ! Vertical interpolation of generic case 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), th_prof_cas(nlev_cas), thv_prof_cas(nlev_cas), thl_prof_cas(nlev_cas)
+    real qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_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), omega_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 dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_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), theta_mod_cas(llm), thv_mod_cas(llm), thl_mod_cas(llm)
+    real qv_mod_cas(llm), ql_mod_cas(llm), qi_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), omega_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 dth_mod_cas(llm), hth_mod_cas(llm), vth_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
+    !       print *,'debut interp2, play=',l,play(l)
+    !       enddo
+    !      do l = 1, nlev_cas
+    !      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
+    !      enddo
+
+    do l = 1, llm
+
+      if (play(l)>=plev_prof_cas(nlev_cas)) then
+
+        mxcalc = l
+        !        print *,'debut interp2, mxcalc=',mxcalc
+        k1 = 0
+        k2 = 0
+
+        if (play(l)<=plev_prof_cas(1)) then
+
+          do k = 1, nlev_cas - 1
+            if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k + 1)) then
+              k1 = k
+              k2 = k + 1
+            endif
+          enddo
+
+          if (k1==0 .or. k2==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
-        enddo
-
-        if (k1==0 .or. k2==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))
-        theta_mod_cas(l) = th_prof_cas(k2) - frac * (th_prof_cas(k2) - th_prof_cas(k1))
-        if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
-        thv_mod_cas(l) = thv_prof_cas(k2) - frac * (thv_prof_cas(k2) - thv_prof_cas(k1))
-        thl_mod_cas(l) = thl_prof_cas(k2) - frac * (thl_prof_cas(k2) - thl_prof_cas(k1))
-        qv_mod_cas(l) = qv_prof_cas(k2) - frac * (qv_prof_cas(k2) - qv_prof_cas(k1))
-        ql_mod_cas(l) = ql_prof_cas(k2) - frac * (ql_prof_cas(k2) - ql_prof_cas(k1))
-        qi_mod_cas(l) = qi_prof_cas(k2) - frac * (qi_prof_cas(k2) - qi_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))
-        omega_mod_cas(l) = omega_prof_cas(k2) - frac * (omega_prof_cas(k2) - omega_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))
-        dth_mod_cas(l) = dth_prof_cas(k2) - frac * (dth_prof_cas(k2) - dth_prof_cas(k1))
-        hth_mod_cas(l) = hth_prof_cas(k2) - frac * (hth_prof_cas(k2) - hth_prof_cas(k1))
-        vth_mod_cas(l) = vth_prof_cas(k2) - frac * (vth_prof_cas(k2) - vth_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))
-        dtrad_mod_cas(l) = dtrad_prof_cas(k2) - frac * (dtrad_prof_cas(k2) - dtrad_prof_cas(k1))
-
-      else !play>plev_prof_cas(1)
-
-        k1 = 1
-        k2 = 2
-        print *, 'interp2_vert, k1,k2=', plev_prof_cas(k1), plev_prof_cas(k2)
-        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)
-        theta_mod_cas(l) = frac1 * th_prof_cas(k1) - frac2 * th_prof_cas(k2)
-        if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
-        thv_mod_cas(l) = frac1 * thv_prof_cas(k1) - frac2 * thv_prof_cas(k2)
-        thl_mod_cas(l) = frac1 * thl_prof_cas(k1) - frac2 * thl_prof_cas(k2)
-        qv_mod_cas(l) = frac1 * qv_prof_cas(k1) - frac2 * qv_prof_cas(k2)
-        ql_mod_cas(l) = frac1 * ql_prof_cas(k1) - frac2 * ql_prof_cas(k2)
-        qi_mod_cas(l) = frac1 * qi_prof_cas(k1) - frac2 * qi_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)
-        omega_mod_cas(l) = frac1 * omega_prof_cas(k1) - frac2 * omega_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)
-        dth_mod_cas(l) = frac1 * dth_prof_cas(k1) - frac2 * dth_prof_cas(k2)
-        hth_mod_cas(l) = frac1 * hth_prof_cas(k1) - frac2 * hth_prof_cas(k2)
-        vth_mod_cas(l) = frac1 * vth_prof_cas(k1) - frac2 * vth_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)
-        dtrad_mod_cas(l) = frac1 * dtrad_prof_cas(k1) - frac2 * dtrad_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
-      theta_mod_cas(l) = th_prof_cas(nlev_cas)                       !jyg
-      thv_mod_cas(l) = thv_prof_cas(nlev_cas)                        !jyg
-      thl_mod_cas(l) = thl_prof_cas(nlev_cas)                        !jyg
-      qv_mod_cas(l) = qv_prof_cas(nlev_cas) * fact                     !jyg
-      ql_mod_cas(l) = ql_prof_cas(nlev_cas) * fact                     !jyg
-      qi_mod_cas(l) = qi_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
-      omega_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
-      dth_mod_cas(l) = dth_prof_cas(nlev_cas)
-      hth_mod_cas(l) = hth_prof_cas(nlev_cas)                        !jyg
-      vth_mod_cas(l) = vth_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
-      dtrad_mod_cas(l) = dtrad_prof_cas(nlev_cas) * fact               !jyg
-
-    endif ! play
-
-  enddo ! l
-
-  return
-end
-!***************************************************************************** 
-
-
-
-
+
+          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))
+          theta_mod_cas(l) = th_prof_cas(k2) - frac * (th_prof_cas(k2) - th_prof_cas(k1))
+          if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
+          thv_mod_cas(l) = thv_prof_cas(k2) - frac * (thv_prof_cas(k2) - thv_prof_cas(k1))
+          thl_mod_cas(l) = thl_prof_cas(k2) - frac * (thl_prof_cas(k2) - thl_prof_cas(k1))
+          qv_mod_cas(l) = qv_prof_cas(k2) - frac * (qv_prof_cas(k2) - qv_prof_cas(k1))
+          ql_mod_cas(l) = ql_prof_cas(k2) - frac * (ql_prof_cas(k2) - ql_prof_cas(k1))
+          qi_mod_cas(l) = qi_prof_cas(k2) - frac * (qi_prof_cas(k2) - qi_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))
+          omega_mod_cas(l) = omega_prof_cas(k2) - frac * (omega_prof_cas(k2) - omega_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))
+          dth_mod_cas(l) = dth_prof_cas(k2) - frac * (dth_prof_cas(k2) - dth_prof_cas(k1))
+          hth_mod_cas(l) = hth_prof_cas(k2) - frac * (hth_prof_cas(k2) - hth_prof_cas(k1))
+          vth_mod_cas(l) = vth_prof_cas(k2) - frac * (vth_prof_cas(k2) - vth_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))
+          dtrad_mod_cas(l) = dtrad_prof_cas(k2) - frac * (dtrad_prof_cas(k2) - dtrad_prof_cas(k1))
+
+        else !play>plev_prof_cas(1)
+
+          k1 = 1
+          k2 = 2
+          print *, 'interp2_vert, k1,k2=', plev_prof_cas(k1), plev_prof_cas(k2)
+          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)
+          theta_mod_cas(l) = frac1 * th_prof_cas(k1) - frac2 * th_prof_cas(k2)
+          if(theta_mod_cas(l)/=0) t_mod_cas(l) = theta_mod_cas(l) * (play(l) / 100000.)**(RD / RCPD)
+          thv_mod_cas(l) = frac1 * thv_prof_cas(k1) - frac2 * thv_prof_cas(k2)
+          thl_mod_cas(l) = frac1 * thl_prof_cas(k1) - frac2 * thl_prof_cas(k2)
+          qv_mod_cas(l) = frac1 * qv_prof_cas(k1) - frac2 * qv_prof_cas(k2)
+          ql_mod_cas(l) = frac1 * ql_prof_cas(k1) - frac2 * ql_prof_cas(k2)
+          qi_mod_cas(l) = frac1 * qi_prof_cas(k1) - frac2 * qi_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)
+          omega_mod_cas(l) = frac1 * omega_prof_cas(k1) - frac2 * omega_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)
+          dth_mod_cas(l) = frac1 * dth_prof_cas(k1) - frac2 * dth_prof_cas(k2)
+          hth_mod_cas(l) = frac1 * hth_prof_cas(k1) - frac2 * hth_prof_cas(k2)
+          vth_mod_cas(l) = frac1 * vth_prof_cas(k1) - frac2 * vth_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)
+          dtrad_mod_cas(l) = frac1 * dtrad_prof_cas(k1) - frac2 * dtrad_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
+        theta_mod_cas(l) = th_prof_cas(nlev_cas)                       !jyg
+        thv_mod_cas(l) = thv_prof_cas(nlev_cas)                        !jyg
+        thl_mod_cas(l) = thl_prof_cas(nlev_cas)                        !jyg
+        qv_mod_cas(l) = qv_prof_cas(nlev_cas) * fact                     !jyg
+        ql_mod_cas(l) = ql_prof_cas(nlev_cas) * fact                     !jyg
+        qi_mod_cas(l) = qi_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
+        omega_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
+        dth_mod_cas(l) = dth_prof_cas(nlev_cas)
+        hth_mod_cas(l) = hth_prof_cas(nlev_cas)                        !jyg
+        vth_mod_cas(l) = vth_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
+        dtrad_mod_cas(l) = dtrad_prof_cas(nlev_cas) * fact               !jyg
+
+      endif ! play
+
+    enddo ! l
+
+    return
+  end
+
+END MODULE lmdz_1dutils

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

@@ -1 @@
-
-! $Id$
-
-        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
+MODULE lmdz_old_1dconv
+  IMPLICIT NONE; PRIVATE
+  PUBLIC get_uvd, copie
+CONTAINS
+
+  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>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) == 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>=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
-         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)
+          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 == '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) == 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)
+
+    !-------------------------------------------------------------------
+
+    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)
+    !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 == '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) < 10000.) then
+      do mlz = 1, nblvlm
+        playm(mlz) = playm(mlz) * 100.
+      enddo
+    endif
+    PRINT*, (playm(mlz), mlz = 1, nblvlm)
+
+    1000 format (a4)
+
+    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 > 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 > playm(nblvlm)) then
+        do mlz = 1, nblvlm
+          if (val <= playm(mlz).and. val > 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
-        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
+      else
+        JM(k) = nblvlm - 1
+        coef1(k) = 0.
+        coef2(k) = 0.
       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 ->'
-
+    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>0) THEN
+      IF(TRM==DEL) THEN
+        LENGTH = LEN(STR)
+      ELSE
+        LENGTH = INDEX(STR, TRM) - 1
+        IF(LENGTH<0) LENGTH = LEN(STR)
+      ENDIF
+      !*     Find beginning and end of the NTH DEL-limited substring in STR
+      END = -1
+      DO N = 1, NTH
+        IF(END==LENGTH) RETURN
+        BEG = END + 2
+        END = BEG + INDEX(STR(BEG:LENGTH), DEL) - 2
+        IF(END==BEG - 2) END = LENGTH
+        !*        PRINT *,'NTH,LENGTH,N,BEG,END=',NTH,LENGTH,N,BEG,END
+      end do
+      NCH = END - BEG + 1
+      IF(NCH>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
+    INTEGER nspace
+
+    LENSPA = LEN(SPACES)
+    SPACES = ' '
+    IF (NSPACE<0) NSPACE = 0
+    IBLANK = 1
+    ISPACE = 1
+    100 INONBL = INDEXC(STR(IBLANK:), ' ')
+    IF (INONBL==0) THEN
+      SPACES(ISPACE:) = STR(IBLANK:)
       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
+    INONBL = INONBL + IBLANK - 1
+    IBLANK = INDEX(STR(INONBL:), ' ')
+    IF (IBLANK==0) THEN
+      SPACES(ISPACE:) = STR(INONBL:)
+      RETURN
+    ENDIF
+    IBLANK = IBLANK + INONBL - 1
+    SPACES(ISPACE:) = STR(INONBL:IBLANK - 1)
+    ISPACE = ISPACE + IBLANK - INONBL + NSPACE
+    IF (ISPACE<=LENSPA)                         GO TO 100
+  END
+  INTEGER 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
+    INTEGER I
+
+    LENS = LEN(STR)
+    LENSS = LEN(SSTR)
+
+    DO I = 1, LENS - LENSS + 1
+      IF (STR(I:I + LENSS - 1)/=SSTR) THEN
+        INDEXC = I
+        RETURN
       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
+    END DO
+    INDEXC = 0
+  END
+END MODULE lmdz_old_1dconv

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_lmdz1d.F90

@@ -1 +1 @@
 ! $Id: lmdz1d.F90 3540 2019-06-25 14:50:13Z fairhead $
 
-SUBROUTINE old_lmdz1d
-
-  USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
-  USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
-          clwcon, detr_therm, &
-          qsol, fevap, z0m, z0h, agesno, &
-          du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
-          falb_dir, falb_dif, &
-          ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
-          rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
-          solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
-          wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
-          wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, &
-          awake_dens, cv_gen, wake_cstar, &
-          zgam, zmax0, zmea, zpic, zsig, &
-          zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
-          prlw_ancien, prsw_ancien, prw_ancien, &
-          u10m, v10m, ale_wake, ale_bl_stat
-
-  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_cases_read2
-  USE mod_1D_amma_read
-  USE print_control_mod, ONLY: lunout, prt_level
-  USE iniphysiq_mod, ONLY: iniphysiq
-  USE mod_const_mpi, ONLY: comm_lmdz
-  USE physiq_mod, ONLY: physiq
-  USE comvert_mod, ONLY: presnivs, ap, bp, dpres, nivsig, nivsigs, pa, &
-          preff, aps, bps, pseudoalt, scaleheight
-  USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
-          itau_dyn, itau_phy, start_time, year_len
-  USE phys_cal_mod, ONLY: year_len_phys_cal_mod => year_len
-  USE mod_1D_cases_read, ONLY: interp_case_time ! used in included old_1D_read_forc_cases.h
-  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM
-
-  implicit none
-  INCLUDE "dimensions.h"
-  INCLUDE "YOMCST.h"
-  !!      INCLUDE "control.h"
-  INCLUDE "clesphys.h"
-  INCLUDE "dimsoil.h"
-  !      INCLUDE "indicesol.h"
-
-  INCLUDE "compar1d.h"
-  INCLUDE "flux_arp.h"
-  INCLUDE "date_cas.h"
-  INCLUDE "tsoilnudge.h"
-  INCLUDE "fcg_gcssold.h"
-  !!!      INCLUDE "fbforcing.h"
-  INCLUDE "compbl.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_gabls4 = .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.
-  logical :: forcing_case2 = .FALSE.
-  logical :: forcing_SCM = .FALSE.
-  integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
-  !                                                            (cf read_tsurf1d.F)
-
-  real wwww
-  !vertical advection computation
-  !       real d_t_z(llm), d_q_z(llm)
-  !       real d_t_dyn_z(llm), dq_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 "old_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)
-
-  !---------------------------------------------------------------------
-  !  Declarations related to variables
-  !---------------------------------------------------------------------
-
-  real :: phi(llm)
-  real :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
-  REAL rot(1, llm) ! relative vorticity, in s-1
-  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_t_adv(llm), d_t_nudge(llm)
-  real :: d_u_nudge(llm), d_v_nudge(llm)
-  real :: du_adv(llm), dv_adv(llm)
-  real :: du_age(llm), dv_age(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(1) = 0.0
-  real :: dpsrf(1)
-
-  !---------------------------------------------------------------------
-  !  Initializations of boundary conditions
-  !---------------------------------------------------------------------
-  real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
-  real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
-  real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
-  real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
-  real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
-  real, allocatable :: phy_ice (:) ! Fraction de glace
-  real, allocatable :: phy_fter(:) ! Fraction de terre
-  real, allocatable :: phy_foce(:) ! Fraction de ocean
-  real, allocatable :: phy_fsic(:) ! Fraction de glace
-  real, allocatable :: phy_flic(:) ! Fraction de glace
-
-  !---------------------------------------------------------------------
-  !  Fichiers et d'autres variables
-  !---------------------------------------------------------------------
-  integer :: k, l, i, it = 1, mxcalc
-  integer :: nsrf
-  integer jcode
-  INTEGER read_climoz
-
-  integer :: it_end ! iteration number of the last call
-  !Al1
-  integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
-  data ecrit_slab_oc/-1/
-
-  !     if flag_inhib_forcing = 0, tendencies of forcing are added
-  !                           <> 0, tendencies of forcing are not added
-  INTEGER :: flag_inhib_forcing = 0
-
-  !=====================================================================
-  ! INITIALIZATIONS
-  !=====================================================================
-  du_phys(:) = 0.
-  dv_phys(:) = 0.
-  dt_phys(:) = 0.
-  dt_dyn(:) = 0.
-  dt_cooling(:) = 0.
-  d_t_adv(:) = 0.
-  d_t_nudge(:) = 0.
-  d_u_nudge(:) = 0.
-  d_v_nudge(:) = 0.
-  du_adv(:) = 0.
-  dv_adv(:) = 0.
-  du_age(:) = 0.
-  dv_age(:) = 0.
-
-  ! 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 = 8 ==> forcing_gabls4 = .TRUE.
-  !             initial profiles and large scale forcings in gabls4_driver.nc
-  !forcing_type >= 100 ==> forcing_case = .TRUE.
-  !             initial profiles and large scale forcings in cas.nc
-  !             LS convergence, omega and SST imposed from CINDY-DYNAMO files
-  !             101=cindynamo
-  !             102=bomex
-  !forcing_type >= 100 ==> forcing_case2 = .TRUE.
-  !             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
-  !             103=arm_cu2 ie arm_cu with new forcing format
-  !             104=rico2 ie rico with new forcing format
-  !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 <=0) THEN
-    forcing_les = .TRUE.
-  elseif (forcing_type ==1) THEN
-    forcing_radconv = .TRUE.
-  elseif (forcing_type ==2) THEN
-    forcing_toga = .TRUE.
-  elseif (forcing_type ==3) THEN
-    forcing_GCM2SCM = .TRUE.
-  elseif (forcing_type ==4) THEN
-    forcing_twpice = .TRUE.
-  elseif (forcing_type ==5) THEN
-    forcing_rico = .TRUE.
-  elseif (forcing_type ==6) THEN
-    forcing_amma = .TRUE.
-  elseif (forcing_type ==7) THEN
-    forcing_dice = .TRUE.
-  elseif (forcing_type ==8) THEN
-    forcing_gabls4 = .TRUE.
-  elseif (forcing_type ==101) THEN ! Cindynamo starts 1-10-2011 0h
-    forcing_case = .TRUE.
-    year_ini_cas = 2011
-    mth_ini_cas = 10
-    day_deb = 1
-    heure_ini_cas = 0.
-    pdt_cas = 3 * 3600.         ! forcing frequency
-  elseif (forcing_type ==102) THEN ! Bomex starts 24-6-1969 0h
-    forcing_case = .TRUE.
-    year_ini_cas = 1969
-    mth_ini_cas = 6
-    day_deb = 24
-    heure_ini_cas = 0.
-    pdt_cas = 1800.         ! forcing frequency
-  elseif (forcing_type ==103) THEN ! Arm_cu starts 21-6-1997 11h30
-    forcing_case2 = .TRUE.
-    year_ini_cas = 1997
-    mth_ini_cas = 6
-    day_deb = 21
-    heure_ini_cas = 11.5
-    pdt_cas = 1800.         ! forcing frequency
-  elseif (forcing_type ==104) THEN ! rico starts 16-12-2004 0h
-    forcing_case2 = .TRUE.
-    year_ini_cas = 2004
-    mth_ini_cas = 12
-    day_deb = 16
-    heure_ini_cas = 0.
-    pdt_cas = 1800.         ! forcing frequency
-  elseif (forcing_type ==105) THEN ! bomex starts 16-12-2004 0h
-    forcing_case2 = .TRUE.
-    year_ini_cas = 1969
-    mth_ini_cas = 6
-    day_deb = 24
-    heure_ini_cas = 0.
-    pdt_cas = 1800.         ! forcing frequency
-  elseif (forcing_type ==106) THEN ! ayotte_24SC starts 6-11-1992 0h
-    forcing_case2 = .TRUE.
-    year_ini_cas = 1992
-    mth_ini_cas = 11
-    day_deb = 6
-    heure_ini_cas = 10.
-    pdt_cas = 86400.        ! forcing frequency
-  elseif (forcing_type ==113) THEN ! Arm_cu starts 21-6-1997 11h30
-    forcing_SCM = .TRUE.
-    year_ini_cas = 1997
-    ! It is possible that those parameters are run twice.
-    CALL getin('anneeref', year_ini_cas)
-    CALL getin('dayref', day_deb)
-    mth_ini_cas = 1 ! pour le moment on compte depuis le debut de l'annee
-    CALL getin('time_ini', heure_ini_cas)
-  elseif (forcing_type ==40) THEN
-    forcing_GCSSold = .TRUE.
-  elseif (forcing_type ==50) THEN
-    forcing_fire = .TRUE.
-  elseif (forcing_type ==59) THEN
-    forcing_sandu = .TRUE.
-  elseif (forcing_type ==60) THEN
-    forcing_astex = .TRUE.
-  elseif (forcing_type ==61) THEN
-    forcing_armcu = .TRUE.
-    IF(llm/=19.AND.llm/=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) >= 1
-    jcode = jcode / 10
-  enddo
-  !---------------------------------------------------------------------
-  !  Definition of the run
-  !---------------------------------------------------------------------
-
-  CALL conf_gcm(99, .TRUE.)
-
-  !-----------------------------------------------------------------------
-  allocate(phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
-  phy_nat(:) = 0.0
-  allocate(phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
-  allocate(phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
-  allocate(phy_bil (year_len))  ! Ne sert que pour les slab_ocean
-  phy_bil(:) = 1.0
-  allocate(phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
-  allocate(phy_ice (year_len)) ! Fraction de glace
-  phy_ice(:) = 0.0
-  allocate(phy_fter(year_len)) ! Fraction de terre
-  phy_fter(:) = 0.0
-  allocate(phy_foce(year_len)) ! Fraction de ocean
-  phy_foce(:) = 0.0
-  allocate(phy_fsic(year_len)) ! Fraction de glace
-  phy_fsic(:) = 0.0
-  allocate(phy_flic(year_len)) ! Fraction de glace
-  phy_flic(:) = 0.0
-  !-----------------------------------------------------------------------
-  !   Choix du calendrier
-  !   -------------------
-
-  !      calend = 'earth_365d'
-  if (calend == 'earth_360d') then
-    CALL ioconf_calendar('360_day')
-    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
-    stop 'gregorian calend should not be used by normal user'
-    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
-  print *, 'fnday=', fnday
-  !     start_time doit etre en FRACTION DE JOUR
-  start_time = time_ini / 24.
-
-  ! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
-  IF(forcing_type == 61) fnday = 53100. / 86400.
-  IF(forcing_type == 103) fnday = 53100. / 86400.
-  ! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
-  IF(forcing_type == 6) fnday = 64800. / 86400.
-  !     IF(forcing_type .EQ. 6) fnday=50400./86400.
-  IF(forcing_type == 8) fnday = 129600. / 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 + int(fnday)
-
-  IF (forcing_type ==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 ==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 ==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 ==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 ==8) THEN
-    ! Convert the initial date of GABLS4 to Julian day
-    CALL ymds2ju                                                         &
-            (year_ini_gabls4, mth_ini_gabls4, day_ini_gabls4, heure_ini_gabls4     &
-            , day_ju_ini_gabls4)
-  ELSEIF (forcing_type >100) THEN
-    ! Convert the initial date to Julian day
-    day_ini_cas = day_deb
-    PRINT*, 'time case', year_ini_cas, mth_ini_cas, day_ini_cas
-    CALL ymds2ju                                                         &
-            (year_ini_cas, mth_ini_cas, day_ini_cas, heure_ini_cas * 3600            &
-            , day_ju_ini_cas)
-    PRINT*, 'time case 2', day_ini_cas, day_ju_ini_cas
-  ELSEIF (forcing_type ==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 ==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 ==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
-
-  IF (forcing_type >100) THEN
-    daytime = day + heure_ini_cas / 24. ! 1st day and initial time of the simulation
-  ELSE
-    daytime = day + time_ini / 24. ! 1st day and initial time of the simulation
-  ENDIF
-  ! 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/)) ! job now done via iniphysiq
-  !     but we still need to initialize dimphy module (klon,klev,etc.)  here.
-  CALL init_dimphy1D(1, llm)
-  CALL suphel
-  CALL init_infotrac
-
-  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))
-
-  q(:, :) = 0.
-  dq(:, :) = 0.
-  dq_dyn(:, :) = 0.
-  d_q_adv(:, :) = 0.
-  d_q_nudge(:, :) = 0.
-
-  !   No ozone climatology need be read in this pre-initialization
-  !          (phys_state_var_init is called again in physiq)
-  read_climoz = 0
-  nsw = 6          ! EV et LF: sinon, falb_dir et falb_dif ne peuvent etre alloues
-
-  CALL phys_state_var_init(read_climoz)
-
-  if (ngrid/=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.)
-  beta_surf = 1.
-  beta_aridity(:, :) = beta_surf
-  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'
-    aps(1:llm) = 0.5 * (ap(1:llm) + ap(2:llm + 1))
-    bps(1:llm) = 0.5 * (bp(1:llm) + bp(2:llm + 1))
-    scaleheight = 8.
-    pseudoalt(1:llm) = -scaleheight * log(presnivs(1:llm) / preff)
-  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))
-  zlay = -rd * 300. * log(play / psurf) / rg ! moved after reading profiles
-
-  IF (forcing_type == 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)<=70000) then
-        llm700 = l
-        print *, 'llm700,play=', llm700, play(l) / 100.
-        trouve_700 = .FALSE.
-      endif
+MODULE lmdz_old_lmdz1d
+  IMPLICIT NONE; PRIVATE
+  PUBLIC old_lmdz1d
+CONTAINS
+
+  SUBROUTINE old_lmdz1d
+
+    USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
+    USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
+            clwcon, detr_therm, &
+            qsol, fevap, z0m, z0h, agesno, &
+            du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
+            falb_dir, falb_dif, &
+            ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
+            rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
+            solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
+            wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
+            wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, &
+            awake_dens, cv_gen, wake_cstar, &
+            zgam, zmax0, zmea, zpic, zsig, &
+            zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
+            prlw_ancien, prsw_ancien, prw_ancien, &
+            u10m, v10m, ale_wake, ale_bl_stat
+
+    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
+    USE control_mod
+    USE indice_sol_mod
+    USE phyaqua_mod
+    USE mod_1D_cases_read2
+    USE mod_1D_amma_read
+    USE print_control_mod, ONLY: lunout, prt_level
+    USE iniphysiq_mod, ONLY: iniphysiq
+    USE mod_const_mpi, ONLY: comm_lmdz
+    USE physiq_mod, ONLY: physiq
+    USE comvert_mod, ONLY: presnivs, ap, bp, dpres, nivsig, nivsigs, pa, &
+            preff, aps, bps, pseudoalt, scaleheight
+    USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
+            itau_dyn, itau_phy, start_time, year_len
+    USE phys_cal_mod, ONLY: year_len_phys_cal_mod => year_len
+    USE mod_1D_cases_read, ONLY: interp_case_time ! used in included old_1D_read_forc_cases.h
+    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM
+    USE lmdz_1dutils, ONLY: fq_sat, conf_unicol, dyn1deta0, dyn1dredem
+
+    INCLUDE "dimensions.h"
+    INCLUDE "YOMCST.h"
+    INCLUDE "clesphys.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "compar1d.h"
+    INCLUDE "flux_arp.h"
+    INCLUDE "date_cas.h"
+    INCLUDE "tsoilnudge.h"
+    INCLUDE "fcg_gcssold.h"
+    INCLUDE "compbl.h"
+
+    !=====================================================================
+    ! DECLARATIONS
+    !=====================================================================
+    !---------------------------------------------------------------------
+    !  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_gabls4 = .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.
+    logical :: forcing_case2 = .FALSE.
+    logical :: forcing_SCM = .FALSE.
+    integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
+    !                                                            (cf read_tsurf1d.F)
+
+    real wwww
+    !vertical advection computation
+    !       real d_t_z(llm), d_q_z(llm)
+    !       real d_t_dyn_z(llm), dq_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 "old_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)
+
+    !---------------------------------------------------------------------
+    !  Declarations related to variables
+    !---------------------------------------------------------------------
+
+    real :: phi(llm)
+    real :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
+    REAL rot(1, llm) ! relative vorticity, in s-1
+    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_t_adv(llm), d_t_nudge(llm)
+    real :: d_u_nudge(llm), d_v_nudge(llm)
+    real :: du_adv(llm), dv_adv(llm)
+    real :: du_age(llm), dv_age(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(1) = 0.0
+    real :: dpsrf(1)
+
+    !---------------------------------------------------------------------
+    !  Initializations of boundary conditions
+    !---------------------------------------------------------------------
+    real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+    real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+    real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+    real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+    real, allocatable :: phy_ice (:) ! Fraction de glace
+    real, allocatable :: phy_fter(:) ! Fraction de terre
+    real, allocatable :: phy_foce(:) ! Fraction de ocean
+    real, allocatable :: phy_fsic(:) ! Fraction de glace
+    real, allocatable :: phy_flic(:) ! Fraction de glace
+
+    !---------------------------------------------------------------------
+    !  Fichiers et d'autres variables
+    !---------------------------------------------------------------------
+    integer :: k, l, i, it = 1, mxcalc
+    integer :: nsrf
+    integer jcode
+    INTEGER read_climoz
+
+    integer :: it_end ! iteration number of the last call
+    !Al1
+    integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+    data ecrit_slab_oc/-1/
+
+    !     if flag_inhib_forcing = 0, tendencies of forcing are added
+    !                           <> 0, tendencies of forcing are not added
+    INTEGER :: flag_inhib_forcing = 0
+
+    !=====================================================================
+    ! INITIALIZATIONS
+    !=====================================================================
+    du_phys(:) = 0.
+    dv_phys(:) = 0.
+    dt_phys(:) = 0.
+    dt_dyn(:) = 0.
+    dt_cooling(:) = 0.
+    d_t_adv(:) = 0.
+    d_t_nudge(:) = 0.
+    d_u_nudge(:) = 0.
+    d_v_nudge(:) = 0.
+    du_adv(:) = 0.
+    dv_adv(:) = 0.
+    du_age(:) = 0.
+    dv_age(:) = 0.
+
+    ! 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 = 8 ==> forcing_gabls4 = .TRUE.
+    !             initial profiles and large scale forcings in gabls4_driver.nc
+    !forcing_type >= 100 ==> forcing_case = .TRUE.
+    !             initial profiles and large scale forcings in cas.nc
+    !             LS convergence, omega and SST imposed from CINDY-DYNAMO files
+    !             101=cindynamo
+    !             102=bomex
+    !forcing_type >= 100 ==> forcing_case2 = .TRUE.
+    !             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
+    !             103=arm_cu2 ie arm_cu with new forcing format
+    !             104=rico2 ie rico with new forcing format
+    !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 <=0) THEN
+      forcing_les = .TRUE.
+    elseif (forcing_type ==1) THEN
+      forcing_radconv = .TRUE.
+    elseif (forcing_type ==2) THEN
+      forcing_toga = .TRUE.
+    elseif (forcing_type ==3) THEN
+      forcing_GCM2SCM = .TRUE.
+    elseif (forcing_type ==4) THEN
+      forcing_twpice = .TRUE.
+    elseif (forcing_type ==5) THEN
+      forcing_rico = .TRUE.
+    elseif (forcing_type ==6) THEN
+      forcing_amma = .TRUE.
+    elseif (forcing_type ==7) THEN
+      forcing_dice = .TRUE.
+    elseif (forcing_type ==8) THEN
+      forcing_gabls4 = .TRUE.
+    elseif (forcing_type ==101) THEN ! Cindynamo starts 1-10-2011 0h
+      forcing_case = .TRUE.
+      year_ini_cas = 2011
+      mth_ini_cas = 10
+      day_deb = 1
+      heure_ini_cas = 0.
+      pdt_cas = 3 * 3600.         ! forcing frequency
+    elseif (forcing_type ==102) THEN ! Bomex starts 24-6-1969 0h
+      forcing_case = .TRUE.
+      year_ini_cas = 1969
+      mth_ini_cas = 6
+      day_deb = 24
+      heure_ini_cas = 0.
+      pdt_cas = 1800.         ! forcing frequency
+    elseif (forcing_type ==103) THEN ! Arm_cu starts 21-6-1997 11h30
+      forcing_case2 = .TRUE.
+      year_ini_cas = 1997
+      mth_ini_cas = 6
+      day_deb = 21
+      heure_ini_cas = 11.5
+      pdt_cas = 1800.         ! forcing frequency
+    elseif (forcing_type ==104) THEN ! rico starts 16-12-2004 0h
+      forcing_case2 = .TRUE.
+      year_ini_cas = 2004
+      mth_ini_cas = 12
+      day_deb = 16
+      heure_ini_cas = 0.
+      pdt_cas = 1800.         ! forcing frequency
+    elseif (forcing_type ==105) THEN ! bomex starts 16-12-2004 0h
+      forcing_case2 = .TRUE.
+      year_ini_cas = 1969
+      mth_ini_cas = 6
+      day_deb = 24
+      heure_ini_cas = 0.
+      pdt_cas = 1800.         ! forcing frequency
+    elseif (forcing_type ==106) THEN ! ayotte_24SC starts 6-11-1992 0h
+      forcing_case2 = .TRUE.
+      year_ini_cas = 1992
+      mth_ini_cas = 11
+      day_deb = 6
+      heure_ini_cas = 10.
+      pdt_cas = 86400.        ! forcing frequency
+    elseif (forcing_type ==113) THEN ! Arm_cu starts 21-6-1997 11h30
+      forcing_SCM = .TRUE.
+      year_ini_cas = 1997
+      ! It is possible that those parameters are run twice.
+      CALL getin('anneeref', year_ini_cas)
+      CALL getin('dayref', day_deb)
+      mth_ini_cas = 1 ! pour le moment on compte depuis le debut de l'annee
+      CALL getin('time_ini', heure_ini_cas)
+    elseif (forcing_type ==40) THEN
+      forcing_GCSSold = .TRUE.
+    elseif (forcing_type ==50) THEN
+      forcing_fire = .TRUE.
+    elseif (forcing_type ==59) THEN
+      forcing_sandu = .TRUE.
+    elseif (forcing_type ==60) THEN
+      forcing_astex = .TRUE.
+    elseif (forcing_type ==61) THEN
+      forcing_armcu = .TRUE.
+      IF(llm/=19.AND.llm/=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) >= 1
+      jcode = jcode / 10
     enddo
-    write(*, *) '***********************'
-  ENDIF
-
-  !=====================================================================
-  ! EVENTUALLY, READ FORCING DATA :
-  !=====================================================================
-
-  INCLUDE "old_1D_read_forc_cases.h"
-
-IF (forcing_GCM2SCM) then
+    !---------------------------------------------------------------------
+    !  Definition of the run
+    !---------------------------------------------------------------------
+
+    CALL conf_gcm(99, .TRUE.)
+
+    !-----------------------------------------------------------------------
+    allocate(phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    phy_nat(:) = 0.0
+    allocate(phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
+    allocate(phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
+    allocate(phy_bil (year_len))  ! Ne sert que pour les slab_ocean
+    phy_bil(:) = 1.0
+    allocate(phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
+    allocate(phy_ice (year_len)) ! Fraction de glace
+    phy_ice(:) = 0.0
+    allocate(phy_fter(year_len)) ! Fraction de terre
+    phy_fter(:) = 0.0
+    allocate(phy_foce(year_len)) ! Fraction de ocean
+    phy_foce(:) = 0.0
+    allocate(phy_fsic(year_len)) ! Fraction de glace
+    phy_fsic(:) = 0.0
+    allocate(phy_flic(year_len)) ! Fraction de glace
+    phy_flic(:) = 0.0
+    !-----------------------------------------------------------------------
+    !   Choix du calendrier
+    !   -------------------
+
+    !      calend = 'earth_365d'
+    if (calend == 'earth_360d') then
+      CALL ioconf_calendar('360_day')
+      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
+      stop 'gregorian calend should not be used by normal user'
+      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
+    print *, 'fnday=', fnday
+    !     start_time doit etre en FRACTION DE JOUR
+    start_time = time_ini / 24.
+
+    ! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
+    IF(forcing_type == 61) fnday = 53100. / 86400.
+    IF(forcing_type == 103) fnday = 53100. / 86400.
+    ! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
+    IF(forcing_type == 6) fnday = 64800. / 86400.
+    !     IF(forcing_type .EQ. 6) fnday=50400./86400.
+    IF(forcing_type == 8) fnday = 129600. / 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 + int(fnday)
+
+    IF (forcing_type ==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 ==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 ==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 ==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 ==8) THEN
+      ! Convert the initial date of GABLS4 to Julian day
+      CALL ymds2ju                                                         &
+              (year_ini_gabls4, mth_ini_gabls4, day_ini_gabls4, heure_ini_gabls4     &
+              , day_ju_ini_gabls4)
+    ELSEIF (forcing_type >100) THEN
+      ! Convert the initial date to Julian day
+      day_ini_cas = day_deb
+      PRINT*, 'time case', year_ini_cas, mth_ini_cas, day_ini_cas
+      CALL ymds2ju                                                         &
+              (year_ini_cas, mth_ini_cas, day_ini_cas, heure_ini_cas * 3600            &
+              , day_ju_ini_cas)
+      PRINT*, 'time case 2', day_ini_cas, day_ju_ini_cas
+    ELSEIF (forcing_type ==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 ==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 ==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
+
+    IF (forcing_type >100) THEN
+      daytime = day + heure_ini_cas / 24. ! 1st day and initial time of the simulation
+    ELSE
+      daytime = day + time_ini / 24. ! 1st day and initial time of the simulation
+    ENDIF
+    ! 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/)) ! job now done via iniphysiq
+    !     but we still need to initialize dimphy module (klon,klev,etc.)  here.
+    CALL init_dimphy1D(1, llm)
+    CALL suphel
+    CALL init_infotrac
+
+    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))
+
+    q(:, :) = 0.
+    dq(:, :) = 0.
+    dq_dyn(:, :) = 0.
+    d_q_adv(:, :) = 0.
+    d_q_nudge(:, :) = 0.
+
+    !   No ozone climatology need be read in this pre-initialization
+    !          (phys_state_var_init is called again in physiq)
+    read_climoz = 0
+    nsw = 6          ! EV et LF: sinon, falb_dir et falb_dif ne peuvent etre alloues
+
+    CALL phys_state_var_init(read_climoz)
+
+    if (ngrid/=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.)
+    beta_surf = 1.
+    beta_aridity(:, :) = beta_surf
+    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'
+      aps(1:llm) = 0.5 * (ap(1:llm) + ap(2:llm + 1))
+      bps(1:llm) = 0.5 * (bp(1:llm) + bp(2:llm + 1))
+      scaleheight = 8.
+      pseudoalt(1:llm) = -scaleheight * log(presnivs(1:llm) / preff)
+    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))
+    zlay = -rd * 300. * log(play / psurf) / rg ! moved after reading profiles
+
+    IF (forcing_type == 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)<=70000) then
+          llm700 = l
+          print *, 'llm700,play=', llm700, play(l) / 100.
+          trouve_700 = .FALSE.
+        endif
+      enddo
+      write(*, *) '***********************'
+    ENDIF
+
+    !=====================================================================
+    ! EVENTUALLY, READ FORCING DATA :
+    !=====================================================================
+
+    INCLUDE "old_1D_read_forc_cases.h"
+
+  IF (forcing_GCM2SCM) then
   write (*, *) 'forcing_GCM2SCM not yet implemented'
   stop 'in initialization'
 END IF ! forcing_GCM2SCM
 
-PRINT*, 'mxcalc=', mxcalc
-!     PRINT*,'zlay=',zlay(mxcalc)
+        PRINT*, 'mxcalc=', mxcalc
+        !     PRINT*,'zlay=',zlay(mxcalc)
 PRINT*, 'play=', play(mxcalc)
 
-!Al1 pour SST forced, appell?? depuis ocean_forced_noice
-! EV tg instead of ts_cur
-
-tg = 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(1) = xlat * rpi / 180.
-rlon_rad(1) = xlon * rpi / 180.
-
-! iniphysiq will CALL iniaqua who needs year_len from phys_cal_mod
-year_len_phys_cal_mod = year_len
-
-! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
-! e.g. for cell boundaries, which are meaningless in 1D; so pad these
-! with '0.' when necessary
-CALL iniphysiq(iim, jjm, llm, &
-        1, comm_lmdz, &
-        rday, day_ini, timestep, &
-        (/rlat_rad(1), 0./), (/0./), &
-        (/0., 0./), (/rlon_rad(1), 0./), &
-        (/ (/airefi, 0./), (/0., 0./) /), &
-        (/zcufi, 0., 0., 0./), &
-        (/zcvfi, 0./), &
-        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, :) = snowmass ! masse de neige des sous surface
-  print *, 'snsrf', snsrf
-  qsurfsrf(1, :) = qsurf ! humidite de l'air des sous surface
-  fevap = 0.
-  z0m(1, :) = rugos     ! couverture de neige des sous surface
-  z0h(1, :) = rugosh    ! 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==0.) then
-    pctsrf(1, is_oce) = 1.
-    pctsrf(1, is_ter) = 0.
-    pctsrf(1, is_lic) = 0.
-    pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 1) then
-    pctsrf(1, is_oce) = 0.
-    pctsrf(1, is_ter) = 1.
-    pctsrf(1, is_lic) = 0.
-    pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 2) then
-    pctsrf(1, is_oce) = 0.
-    pctsrf(1, is_ter) = 0.
-    pctsrf(1, is_lic) = 1.
-    pctsrf(1, is_sic) = 0.
-  else if (nat_surf == 3) then
-    pctsrf(1, is_oce) = 0.
-    pctsrf(1, is_ter) = 0.
-    pctsrf(1, is_lic) = 0.
-    pctsrf(1, is_sic) = 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
-  falb_dir = albedo
-  falb_dif = albedo
-  rugoro = rugos
-  t_ancien(1, :) = temp(:)
-  q_ancien(1, :) = q(:, 1)
-  ql_ancien = 0.
-  qs_ancien = 0.
-  prlw_ancien = 0.
-  prsw_ancien = 0.
-  prw_ancien = 0.
-  !jyg<
-  !!        pbl_tke(:,:,:)=1.e-8
-  pbl_tke(:, :, :) = 0.
-  pbl_tke(:, 2, :) = 1.e-2
-  PRINT *, ' pbl_tke dans lmdz1d '
-  if (prt_level >= 5) then
-    DO nsrf = 1, 4
-      PRINT *, 'pbl_tke(1,:,', nsrf, ') ', pbl_tke(1, :, nsrf)
-    ENDDO
-  end if
-
-  !>jyg
-
-  rain_fall = 0.
-  snow_fall = 0.
-  solsw = 0.
-  solswfdiff = 0.
-  sollw = 0.
-  sollwdown = rsigma * tsurf**4
-  radsol = 0.
-  rnebcon = 0.
-  ratqs = 0.
-  clwcon = 0.
-  zmax0 = 0.
-  zmea = zsurf
-  zstd = 0.
-  zsig = 0.
-  zgam = 0.
-  zval = 0.
-  zthe = 0.
-  sig1 = 0.
-  w01 = 0.
-
-  wake_deltaq = 0.
-  wake_deltat = 0.
-  wake_delta_pbl_TKE(:, :, :) = 0.
-  delta_tsurf = 0.
-  wake_fip = 0.
-  wake_pe = 0.
-  wake_s = 0.
-  awake_s = 0.
-  wake_dens = 0.
-  awake_dens = 0.
-  cv_gen = 0.
-  wake_cstar = 0.
-  ale_bl = 0.
-  ale_bl_trig = 0.
-  alp_bl = 0.
-  IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
-  IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
-  entr_therm = 0.
-  detr_therm = 0.
-  f0 = 0.
-  fm_therm = 0.
-  u_ancien(1, :) = u(:)
-  v_ancien(1, :) = v(:)
-  rneb_ancien(1, :) = 0.
-
-  u10m = 0.
-  v10m = 0.
-  ale_wake = 0.
-  ale_bl_stat = 0.
-
-  !------------------------------------------------------------------------
-  ! Make file containing restart for the physics (startphy.nc)
-
-  ! NB: List of the variables to be written by phyredem (via put_field):
-  ! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
-  ! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
-  ! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
-  ! radsol,solsw,solswfdiff,sollw, sollwdown,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,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
-  ! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
-
-  ! NB2: The content of the startphy.nc file depends on some flags defined in
-  ! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
-  ! to be set at some arbitratry convenient values.
-  !------------------------------------------------------------------------
-  !Al1 =============== restart option ==========================
-  iflag_physiq = 0
-  CALL getin('iflag_physiq', iflag_physiq)
-
-  if (.not.restart) then
-    iflag_pbl = 5
-    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'
-
-END IF ! 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, year_len
-  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)
-END DO
-
-! 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
-END IF
-!Al1 ================  end restart =================================
-IF (ecrit_slab_oc==1) then
-  open(97, file = 'div_slab.dat', STATUS = 'UNKNOWN')
-elseif (ecrit_slab_oc==0) then
-  open(97, file = 'div_slab.dat', STATUS = 'OLD')
-END IF
-
-!---------------------------------------------------------------------
-!    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)
-END IF
-IF (nudge(inudge_UV)) then
-  CALL nudge_UV_init(plev, play, u, v, u_targ, v_targ)
-END IF
-
-!=====================================================================
-IF (CPPKEY_OUTPUTPHYSSCM)
-  CALL iophys_ini(timestep)
-END IF
-! START OF THE TEMPORAL LOOP :
-!=====================================================================
-
-it_end = nint(fnday * day_step)
-!test JLD     it_end = 10
-DO while(it<=it_end)
-
-  if (prt_level>=1) then
-    PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
-            it, day, time, it_end, day_step
-    PRINT*, 'PAS DE TEMPS ', timestep
-  endif
-  !Al1 demande de restartphy.nc
-  if (it==it_end) lastcall = .True.
-
-  !---------------------------------------------------------------------
-  !  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
-
-  !---------------------------------------------------------------------
-  ! Interpolation of forcings in time and onto model levels
-  !---------------------------------------------------------------------
-
-  INCLUDE "old_1D_interp_cases.h"
-
-IF (forcing_GCM2SCM) then
-  write (*, *) 'forcing_GCM2SCM not yet implemented'
-  stop 'in time loop'
-END IF ! 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
-end if
-IF (prt_level>=5) then
-  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)
-END IF
-
-!---------------------------------------------------------------------
-!   Call physiq :
-!---------------------------------------------------------------------
-CALL physiq(ngrid, llm, &
+                !Al1 pour SST forced, appell?? depuis ocean_forced_noice
+                ! EV tg instead of ts_cur
+
+                tg = 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(1) = xlat * rpi / 180.
+                rlon_rad(1) = xlon * rpi / 180.
+
+                ! iniphysiq will CALL iniaqua who needs year_len from phys_cal_mod
+                year_len_phys_cal_mod = year_len
+
+                ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
+                ! e.g. for cell boundaries, which are meaningless in 1D; so pad these
+                ! with '0.' when necessary
+                CALL iniphysiq(iim, jjm, llm, &
+                1, comm_lmdz, &
+                rday, day_ini, timestep, &
+                (/rlat_rad(1), 0./), (/0./), &
+                (/0., 0./), (/rlon_rad(1), 0./), &
+                (/ (/airefi, 0./), (/0., 0./) /), &
+                (/zcufi, 0., 0., 0./), &
+                (/zcvfi, 0./), &
+                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, :) = snowmass ! masse de neige des sous surface
+        print *, 'snsrf', snsrf
+        qsurfsrf(1, :) = qsurf ! humidite de l'air des sous surface
+        fevap = 0.
+        z0m(1, :) = rugos     ! couverture de neige des sous surface
+        z0h(1, :) = rugosh    ! 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==0.) then
+        pctsrf(1, is_oce) = 1.
+        pctsrf(1, is_ter) = 0.
+        pctsrf(1, is_lic) = 0.
+        pctsrf(1, is_sic) = 0.
+        else if (nat_surf == 1) then
+        pctsrf(1, is_oce) = 0.
+        pctsrf(1, is_ter) = 1.
+        pctsrf(1, is_lic) = 0.
+        pctsrf(1, is_sic) = 0.
+        else if (nat_surf == 2) then
+        pctsrf(1, is_oce) = 0.
+        pctsrf(1, is_ter) = 0.
+        pctsrf(1, is_lic) = 1.
+        pctsrf(1, is_sic) = 0.
+        else if (nat_surf == 3) then
+        pctsrf(1, is_oce) = 0.
+        pctsrf(1, is_ter) = 0.
+        pctsrf(1, is_lic) = 0.
+        pctsrf(1, is_sic) = 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
+        falb_dir = albedo
+        falb_dif = albedo
+        rugoro = rugos
+                t_ancien(1, :) = temp(:)
+                q_ancien(1, :) = q(:, 1)
+        ql_ancien = 0.
+        qs_ancien = 0.
+        prlw_ancien = 0.
+        prsw_ancien = 0.
+        prw_ancien = 0.
+                !jyg<
+                !!        pbl_tke(:,:,:)=1.e-8
+                pbl_tke(:, :, :) = 0.
+                pbl_tke(:, 2, :) = 1.e-2
+                PRINT *, ' pbl_tke dans lmdz1d '
+                if (prt_level >= 5) then
+                DO nsrf = 1, 4
+                PRINT *, 'pbl_tke(1,:,', nsrf, ') ', pbl_tke(1, :, nsrf)
+        ENDDO
+        end if
+
+        !>jyg
+
+        rain_fall = 0.
+        snow_fall = 0.
+        solsw = 0.
+        solswfdiff = 0.
+        sollw = 0.
+        sollwdown = rsigma * tsurf**4
+        radsol = 0.
+        rnebcon = 0.
+        ratqs = 0.
+        clwcon = 0.
+                zmax0 = 0.
+                zmea = zsurf
+                zstd = 0.
+        zsig = 0.
+        zgam = 0.
+                zval = 0.
+                zthe = 0.
+                sig1 = 0.
+        w01 = 0.
+
+        wake_deltaq = 0.
+                wake_deltat = 0.
+                wake_delta_pbl_TKE(:, :, :) = 0.
+        delta_tsurf = 0.
+        wake_fip = 0.
+                wake_pe = 0.
+                wake_s = 0.
+                awake_s = 0.
+                wake_dens = 0.
+                awake_dens = 0.
+                cv_gen = 0.
+                wake_cstar = 0.
+                ale_bl = 0.
+                ale_bl_trig = 0.
+                alp_bl = 0.
+                IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
+                IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
+                entr_therm = 0.
+                detr_therm = 0.
+        f0 = 0.
+        fm_therm = 0.
+        u_ancien(1, :) = u(:)
+                v_ancien(1, :) = v(:)
+                rneb_ancien(1, :) = 0.
+
+        u10m = 0.
+        v10m = 0.
+                ale_wake = 0.
+                ale_bl_stat = 0.
+
+                !------------------------------------------------------------------------
+                ! Make file containing restart for the physics (startphy.nc)
+
+                ! NB: List of the variables to be written by phyredem (via put_field):
+                ! rlon,rlat,zmasq,pctsrf(:,is_ter),pctsrf(:,is_lic),pctsrf(:,is_oce)
+                ! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
+                ! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
+                ! radsol,solsw,solswfdiff,sollw, sollwdown,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,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
+                ! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
+
+                ! NB2: The content of the startphy.nc file depends on some flags defined in
+                ! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
+                ! to be set at some arbitratry convenient values.
+                !------------------------------------------------------------------------
+                !Al1 =============== restart option ==========================
+                iflag_physiq = 0
+                CALL getin('iflag_physiq', iflag_physiq)
+
+                if (.not.restart) then
+                iflag_pbl = 5
+                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'
+
+        END IF ! 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, year_len
+                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)
+                END DO
+
+                ! 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
+        END IF
+        !Al1 ================  end restart =================================
+        IF (ecrit_slab_oc==1) then
+        open(97, file = 'div_slab.dat', STATUS = 'UNKNOWN')
+                elseif (ecrit_slab_oc==0) then
+                open(97, file = 'div_slab.dat', STATUS = 'OLD')
+                END IF
+
+                !---------------------------------------------------------------------
+                !    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)
+                END IF
+                IF (nudge(inudge_UV)) then
+                CALL nudge_UV_init(plev, play, u, v, u_targ, v_targ)
+                END IF
+
+                !=====================================================================
+                IF (CPPKEY_OUTPUTPHYSSCM) THEN
+                CALL iophys_ini(timestep)
+        END IF
+        ! START OF THE TEMPORAL LOOP :
+        !=====================================================================
+
+        it_end = nint(fnday * day_step)
+                !test JLD     it_end = 10
+                DO while(it<=it_end)
+
+                if (prt_level>=1) then
+        PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
+        it, day, time, it_end, day_step
+        PRINT*, 'PAS DE TEMPS ', timestep
+        endif
+        !Al1 demande de restartphy.nc
+        if (it==it_end) lastcall = .True.
+
+        !---------------------------------------------------------------------
+        !  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
+
+                !---------------------------------------------------------------------
+                ! Interpolation of forcings in time and onto model levels
+                !---------------------------------------------------------------------
+
+                INCLUDE "old_1D_interp_cases.h"
+
+                IF (forcing_GCM2SCM) then
+        write (*, *) 'forcing_GCM2SCM not yet implemented'
+        stop 'in time loop'
+        END IF ! 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
+                end if
+                IF (prt_level>=5) then
+        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)
+                END IF
+
+                !---------------------------------------------------------------------
+                !   Call physiq :
+                !---------------------------------------------------------------------
+                CALL physiq(ngrid, llm, &
         firstcall, lastcall, timestep, &
         plev, play, phi, phis, presnivs, &
         u, v, rot, temp, q, omega2, &
         du_phys, dv_phys, dt_phys, dq, dpsrf)
-firstcall = .FALSE.
-
-!---------------------------------------------------------------------
-! Listing output for debug
-!---------------------------------------------------------------------
-IF (prt_level>=5) 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
-END IF
-!---------------------------------------------------------------------
-!   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_t_adv = 0.0
-  d_q_adv = 0.0
-END IF
-!      PRINT*, 'calcul de fcoriolis ', fcoriolis
-
-IF (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
-        .or.forcing_amma .or. forcing_type==101) then
-  fcoriolis = 0.0 ; ug = 0. ; vg = 0.
-END IF
-
-IF(forcing_rico) then
-  dt_cooling = 0.
-END IF
-
-!CRio:Attention modif sp??cifique cas de Caroline
+                firstcall = .FALSE.
+
+                !---------------------------------------------------------------------
+                ! Listing output for debug
+                !---------------------------------------------------------------------
+                IF (prt_level>=5) 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
+                END IF
+                !---------------------------------------------------------------------
+                !   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_t_adv = 0.0
+                d_q_adv = 0.0
+                END IF
+                !      PRINT*, 'calcul de fcoriolis ', fcoriolis
+
+                IF (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
+                .or.forcing_amma .or. forcing_type==101) then
+                fcoriolis = 0.0 ; ug = 0. ; vg = 0.
+                END IF
+
+                IF(forcing_rico) then
+                dt_cooling = 0.
+                END IF
+
+                !CRio:Attention modif sp??cifique cas de Caroline
 IF (forcing_type==-1) then
-  fcoriolis = 0.
-  !Nudging
-
-  !on calcule dt_cooling
-  do l = 1, llm
-    if (play(l)>=20000.) then
-      dt_cooling(l) = -1.5 / 86400.
-    elseif ((play(l)>=10000.).and.((play(l)<20000.))) then
-      dt_cooling(l) = -1.5 / 86400. * (play(l) - 10000.) / (10000.) - 1. / 86400. * (20000. - play(l)) / 10000. * (temp(l) - 200.)
-    else
-      dt_cooling(l) = -1. * (temp(l) - 200.) / 86400.
-    endif
-  enddo
-
-END IF
-!RC
-IF (forcing_sandu) then
-  ug(1:llm) = u_mod(1:llm)
-  vg(1:llm) = v_mod(1:llm)
-END IF
-
-IF (prt_level >= 5) PRINT*, 'fcoriolis, xlat,mxcalc ', &
-        fcoriolis, xlat, mxcalc
-
-!       print *,'u-ug=',u-ug
-
-!!!!!!!!!!!!!!!!!!!!!!!!
-! Geostrophic wind
-! Le calcul ci dessous est insuffisamment precis
-!      du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
-!      dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
-!!!!!!!!!!!!!!!!!!!!!!!!
-sfdt = sin(0.5 * fcoriolis * timestep)
-cfdt = cos(0.5 * fcoriolis * timestep)
-!       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,timestep
-
-du_age(1:mxcalc) = -2. * sfdt / timestep * &
+        fcoriolis = 0.
+        !Nudging
+
+        !on calcule dt_cooling
+        do l = 1, llm
+        if (play(l)>=20000.) then
+        dt_cooling(l) = -1.5 / 86400.
+        elseif ((play(l)>=10000.).and.((play(l)<20000.))) then
+        dt_cooling(l) = -1.5 / 86400. * (play(l) - 10000.) / (10000.) - 1. / 86400. * (20000. - play(l)) / 10000. * (temp(l) - 200.)
+                else
+                dt_cooling(l) = -1. * (temp(l) - 200.) / 86400.
+        endif
+        enddo
+
+        END IF
+                !RC
+                IF (forcing_sandu) then
+                ug(1:llm) = u_mod(1:llm)
+                vg(1:llm) = v_mod(1:llm)
+                END IF
+
+                IF (prt_level >= 5) PRINT*, 'fcoriolis, xlat,mxcalc ', &
+                fcoriolis, xlat, mxcalc
+
+                !       print *,'u-ug=',u-ug
+
+                !!!!!!!!!!!!!!!!!!!!!!!!
+                ! Geostrophic wind
+                ! Le calcul ci dessous est insuffisamment precis
+                !      du_age(1:mxcalc)=fcoriolis*(v(1:mxcalc)-vg(1:mxcalc))
+                !      dv_age(1:mxcalc)=-fcoriolis*(u(1:mxcalc)-ug(1:mxcalc))
+                !!!!!!!!!!!!!!!!!!!!!!!!
+                sfdt = sin(0.5 * fcoriolis * timestep)
+                cfdt = cos(0.5 * fcoriolis * timestep)
+        !       print *,'fcoriolis,sfdt,cfdt,timestep',fcoriolis,sfdt,cfdt,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 * &
+                !!     : 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))
-END IF
-IF (nudge(inudge_UV)) then
-  CALL nudge_UV(timestep, plev, play, u_targ, v_targ, u, v, &
-          d_u_nudge, d_v_nudge)
-END IF
-
-IF (forcing_fire) THEN
-
-  !let ww=if ( alt le 1100 ) then alt*-0.00001 else 0
-  !let wt=if ( alt le 1100 ) then min( -3.75e-5 , -7.5e-8*alt)  else 0
-  !let wq=if ( alt le 1100 ) then max( 1.5e-8 , 3e-11*alt)  else 0
-  d_t_adv = 0.
-  d_q_adv = 0.
-  teta = temp * (pzero / play)**rkappa
-  d_t_adv = 0.
-  d_q_adv = 0.
-  do l = 2, llm - 1
-    if (zlay(l)<=1100) then
-      wwww = -0.00001 * zlay(l)
-      d_t_adv(l) = -wwww * (teta(l) - teta(l + 1)) / (zlay(l) - zlay(l + 1)) / (pzero / play(l))**rkappa
-      d_q_adv(l, 1:2) = -wwww * (q(l, 1:2) - q(l + 1, 1:2)) / (zlay(l) - zlay(l + 1))
-      d_t_adv(l) = d_t_adv(l) + min(-3.75e-5, -7.5e-8 * zlay(l))
-      d_q_adv(l, 1) = d_q_adv(l, 1) + max(1.5e-8, 3e-11 * zlay(l))
-    endif
-  enddo
-
-END IF
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!         call  writefield_phy('dv_age' ,dv_age,llm)
+                !!     : -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))
+        END IF
+        IF (nudge(inudge_UV)) then
+        CALL nudge_UV(timestep, plev, play, u_targ, v_targ, u, v, &
+        d_u_nudge, d_v_nudge)
+                END IF
+
+                IF (forcing_fire) THEN
+
+        !let ww=if ( alt le 1100 ) then alt*-0.00001 else 0
+        !let wt=if ( alt le 1100 ) then min( -3.75e-5 , -7.5e-8*alt)  else 0
+        !let wq=if ( alt le 1100 ) then max( 1.5e-8 , 3e-11*alt)  else 0
+        d_t_adv = 0.
+        d_q_adv = 0.
+        teta = temp * (pzero / play)**rkappa
+        d_t_adv = 0.
+        d_q_adv = 0.
+        do l = 2, llm - 1
+        if (zlay(l)<=1100) then
+        wwww = -0.00001 * zlay(l)
+                d_t_adv(l) = -wwww * (teta(l) - teta(l + 1)) / (zlay(l) - zlay(l + 1)) / (pzero / play(l))**rkappa
+        d_q_adv(l, 1:2) = -wwww * (q(l, 1:2) - q(l + 1, 1:2)) / (zlay(l) - zlay(l + 1))
+                d_t_adv(l) = d_t_adv(l) + min(-3.75e-5, -7.5e-8 * zlay(l))
+                d_q_adv(l, 1) = d_q_adv(l, 1) + max(1.5e-8, 3e-11 * zlay(l))
+        endif
+        enddo
+
+        END IF
+
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        !         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
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
-
-  ! 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>=3) then
-      print *, &
-              'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
-              temp(1), dt_phys(1), d_t_adv(1), dt_cooling(1)
-      PRINT*, 'dv_phys=', dv_phys
-      PRINT*, 'dv_age=', dv_age
-      PRINT*, 'dv_adv=', dv_adv
-      PRINT*, 'd_v_nudge=', d_v_nudge
-      PRINT*, v
-      PRINT*, vg
-    endif
-
-    temp(1:mxcalc) = temp(1:mxcalc) + timestep * (&
-            dt_phys(1:mxcalc)                                       &
-                    + d_t_adv(1:mxcalc)                                      &
-                    + d_t_nudge(1:mxcalc)                                      &
-                    + dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
-
-    IF (CPPKEY_OUTPUTPHYSSCM)
-      CALL iophys_ecrit('d_t_adv', klev, 'd_t_adv', 'm/s', d_t_adv)
-      CALL iophys_ecrit('d_t_nudge', klev, 'd_t_nudge', 'm/s', d_t_nudge)
-    END IF
-
-  endif  ! forcing_sandu or forcing_astex
-
-  teta = temp * (pzero / play)**rkappa
-
-  !---------------------------------------------------------------------
-  !   Nudge soil temperature if requested
-  !---------------------------------------------------------------------
-
-  IF (nudge_tsoil .AND. .NOT. lastcall) 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)
-
-END IF ! end if tendency of tendency should be added
-
-!---------------------------------------------------------------------
-!   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.
-END IF
-
-!  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
-
-END DO
-
-!Al1
-IF (ecrit_slab_oc/=-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 SUBROUTINE old_lmdz1d
-
-        INCLUDE "old_1DUTILS_read_interp.h"
+        !         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
+        !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
+
+        ! 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>=3) then
+                print *, &
+                'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
+                temp(1), dt_phys(1), d_t_adv(1), dt_cooling(1)
+                PRINT*, 'dv_phys=', dv_phys
+                PRINT*, 'dv_age=', dv_age
+                PRINT*, 'dv_adv=', dv_adv
+                PRINT*, 'd_v_nudge=', d_v_nudge
+                PRINT*, v
+                PRINT*, vg
+                endif
+
+                temp(1:mxcalc) = temp(1:mxcalc) + timestep * (&
+        dt_phys(1:mxcalc)                                       &
+        + d_t_adv(1:mxcalc)                                      &
+        + d_t_nudge(1:mxcalc)                                      &
+        + dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+        IF (CPPKEY_OUTPUTPHYSSCM) THEN
+        CALL iophys_ecrit('d_t_adv', klev, 'd_t_adv', 'm/s', d_t_adv)
+                CALL iophys_ecrit('d_t_nudge', klev, 'd_t_nudge', 'm/s', d_t_nudge)
+                END IF
+
+                endif  ! forcing_sandu or forcing_astex
+
+                teta = temp * (pzero / play)**rkappa
+
+        !---------------------------------------------------------------------
+        !   Nudge soil temperature if requested
+        !---------------------------------------------------------------------
+
+        IF (nudge_tsoil .AND. .NOT. lastcall) 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)
+
+                END IF ! end if tendency of tendency should be added
+
+                !---------------------------------------------------------------------
+                !   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.
+                END IF
+
+                !  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
+
+                        END DO
+
+                        !Al1
+                        IF (ecrit_slab_oc/=-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 SUBROUTINE old_lmdz1d
+
+                        INCLUDE "old_1DUTILS_read_interp.h"
+        END MODULE lmdz_old_lmdz1d

LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_scm.F90

@@ -1 @@
-SUBROUTINE scm
-
-   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar,getin
-   USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
-       clwcon, detr_therm, &
-       qsol, fevap, z0m, z0h, agesno, &
-       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
-       falb_dir, falb_dif, &
-       ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
-       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
-       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
-       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
-       wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, &
-       awake_dens, cv_gen, wake_cstar, &
-       zgam, zmax0, zmea, zpic, zsig, &
-       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
-       prlw_ancien, prsw_ancien, prw_ancien, &
-       u10m,v10m,ale_wake,ale_bl_stat, ratqs_inter_
-
-  
-   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_cases_read_std
-   !USE mod_1D_amma_read
-   USE print_control_mod, ONLY: lunout, prt_level
-   USE iniphysiq_mod, ONLY: iniphysiq
-   USE mod_const_mpi, ONLY: comm_lmdz
-   USE physiq_mod, ONLY: physiq
-   USE comvert_mod, ONLY: presnivs, ap, bp, dpres,nivsig, nivsigs, pa, &
-                          preff, aps, bps, pseudoalt, scaleheight
-   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
-                        itau_dyn, itau_phy, start_time, year_len
-   USE phys_cal_mod, ONLY: year_len_phys_cal_mod => year_len
-
-      implicit none
-      INCLUDE "dimensions.h"
-      INCLUDE "YOMCST.h"
-!!      INCLUDE "control.h"
-      INCLUDE "clesphys.h"
-      INCLUDE "dimsoil.h"
-!      INCLUDE "indicesol.h"
-
-      INCLUDE "compar1d.h"
-      INCLUDE "flux_arp.h"
-      INCLUDE "date_cas.h"
-      INCLUDE "tsoilnudge.h"
-      INCLUDE "fcg_gcssold.h"
-      INCLUDE "compbl.h"
-
-!=====================================================================
-! DECLARATIONS
-!=====================================================================
-
-#undef OUTPUT_PHYS_SCM
-
-!---------------------------------------------------------------------
-!  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 :: 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_gabls4  = .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.
-        logical :: forcing_case2   = .FALSE.
-        logical :: forcing_SCM   = .FALSE.
-
-!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)
-
-!---------------------------------------------------------------------
-!  Declarations related to variables
-!---------------------------------------------------------------------
-
-      real :: phi(llm)
-      real :: teta(llm),tetal(llm),temp(llm),u(llm),v(llm),w(llm)
-      REAL rot(1, llm) ! relative vorticity, in s-1
-      real :: rlat_rad(1),rlon_rad(1)
-      real :: omega(llm),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 :: w_adv(llm),z_adv(llm)
-      real :: d_t_vert_adv(llm),d_u_vert_adv(llm),d_v_vert_adv(llm)
-      real :: dt_cooling(llm),d_t_adv(llm),d_t_nudge(llm)
-      real :: d_u_nudge(llm),d_v_nudge(llm)
-!      real :: d_u_adv(llm),d_v_adv(llm)
-      real :: d_u_age(llm),d_v_age(llm)
-      real :: alpha
-      real :: ttt
-
-      REAL, ALLOCATABLE, DIMENSION(:,:):: q
-      REAL, ALLOCATABLE, DIMENSION(:,:):: dq
-      REAL, ALLOCATABLE, DIMENSION(:,:):: d_q_vert_adv
-      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(1)    = 0.0
-      real :: dpsrf(1)
-
-!---------------------------------------------------------------------
-!  Initializations of boundary conditions 
-!---------------------------------------------------------------------
-      real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
-      real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
-      real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
-      real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
-      real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
-      real, allocatable :: phy_ice (:) ! Fraction de glace
-      real, allocatable :: phy_fter(:) ! Fraction de terre
-      real, allocatable :: phy_foce(:) ! Fraction de ocean
-      real, allocatable :: phy_fsic(:) ! Fraction de glace
-      real, allocatable :: phy_flic(:) ! Fraction de glace
-
-!---------------------------------------------------------------------
-!  Fichiers et d'autres variables
-!---------------------------------------------------------------------
-      integer :: k,l,i,it=1,mxcalc
-      integer :: nsrf
-      integer jcode
-      INTEGER read_climoz 
-
-      integer :: it_end ! iteration number of the last call
-!Al1,plev,play,phi,phis,presnivs,
-      integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
-      data ecrit_slab_oc/-1/
-
-!     if flag_inhib_forcing = 0, tendencies of forcing are added
-!                           <> 0, tendencies of forcing are not added
-      INTEGER :: flag_inhib_forcing = 0
-
-
-      PRINT*,'VOUS ENTREZ DANS LE 1D FORMAT STANDARD'
-
-!=====================================================================
-! INITIALIZATIONS 
-!=====================================================================
-      du_phys(:)=0.
-      dv_phys(:)=0.
-      dt_phys(:)=0.
-      d_t_vert_adv(:)=0.
-      d_u_vert_adv(:)=0.
-      d_v_vert_adv(:)=0.
-      dt_cooling(:)=0.
-      d_t_adv(:)=0.
-      d_t_nudge(:)=0.
-      d_u_nudge(:)=0.
-      d_v_nudge(:)=0.
-      d_u_adv(:)=0.
-      d_v_adv(:)=0.
-      d_u_age(:)=0.
-      d_v_age(:)=0.
-      
-      
-! 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)
-!---------------------------------------------------------------------
-        CALL conf_unicol
-!Al1 moves this gcssold var from common fcg_gcssold to 
-        Turb_fcg_gcssold = xTurb_fcg_gcssold
-! --------------------------------------------------------------------
-        close(1)
-        write(*,*) 'lmdz1d.def lu => unicol.def'
-
-       forcing_SCM = .TRUE.
-       year_ini_cas=1997
-       ! It is possible that those parameters are run twice.
-       ! A REVOIR : LIRE PEUT ETRE AN MOIS JOUR DIRECETEMENT
-
-
-       CALL getin('anneeref',year_ini_cas)
-       CALL getin('dayref',day_deb)
-       mth_ini_cas=1 ! pour le moment on compte depuis le debut de l'annee
-       CALL getin('time_ini',heure_ini_cas)
-
-      PRINT*,'NATURE DE LA SURFACE ',nat_surf
-
-! Initialization of the logical switch for nudging
-
-     jcode = iflag_nudge
-     do i = 1,nudge_max
-       nudge(i) = mod(jcode,10) >= 1
-       jcode = jcode/10
-     enddo
-!-----------------------------------------------------------------------
-!  Definition of the run
-!-----------------------------------------------------------------------
-
-      CALL conf_gcm( 99, .TRUE. )
-      
-!-----------------------------------------------------------------------
-      allocate( phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
-      phy_nat(:)=0.0
-      allocate( phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
-      allocate( phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
-      allocate( phy_bil (year_len))  ! Ne sert que pour les slab_ocean
-      phy_bil(:)=1.0
-      allocate( phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
-      allocate( phy_ice (year_len)) ! Fraction de glace
-      phy_ice(:)=0.0
-      allocate( phy_fter(year_len)) ! Fraction de terre
-      phy_fter(:)=0.0
-      allocate( phy_foce(year_len)) ! Fraction de ocean
-      phy_foce(:)=0.0
-      allocate( phy_fsic(year_len)) ! Fraction de glace
-      phy_fsic(:)=0.0
-      allocate( phy_flic(year_len)) ! Fraction de glace
-      phy_flic(:)=0.0
-
-
-!-----------------------------------------------------------------------
-!   Choix du calendrier
-!   -------------------
-
-!      calend = 'earth_365d'
-      if (calend == 'earth_360d') then
-        CALL ioconf_calendar('360_day')
-        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
-        stop 'gregorian calend should not be used by normal user'
-        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
-      print *,'fnday=',fnday
-!     start_time doit etre en FRACTION DE JOUR
-      start_time=time_ini/24.
-
-      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 + int(fnday)
-
-! Convert the initial date to Julian day
-      day_ini_cas=day_deb
-      PRINT*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
-      CALL ymds2ju                                                         &
-   (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
-   ,day_ju_ini_cas)
-      PRINT*,'time case 2',day_ini_cas,day_ju_ini_cas
-      daytime = day + heure_ini_cas/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/)) ! job now done via iniphysiq
-!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
-      CALL init_dimphy1D(1,llm)
-      CALL suphel
-      CALL init_infotrac
-
-      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
-      allocate(q(llm,nqtot)) ; q(:,:)=0.
-      allocate(dq(llm,nqtot)) 
-      allocate(d_q_vert_adv(llm,nqtot)) 
-      allocate(d_q_adv(llm,nqtot)) 
-      allocate(d_q_nudge(llm,nqtot)) 
-!      allocate(d_th_adv(llm)) 
-
-      q(:,:) = 0.
-      dq(:,:) = 0.
-      d_q_vert_adv(:,:) = 0.
-      d_q_adv(:,:) = 0.
-      d_q_nudge(:,:) = 0.
-
-!   No ozone climatology need be read in this pre-initialization
-!          (phys_state_var_init is called again in physiq)
-      read_climoz = 0
-      nsw=6
-
-      CALL phys_state_var_init(read_climoz)
-
-      if (ngrid/=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)
-!!!=====================================================================
-!!
-      qsol = qsolinp
-      qsurf = fq_sat(tsurf,psurf/100.)
-      beta_aridity(:,:) = beta_surf
-      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
-
-! 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'
-        aps(1:llm)=0.5*(ap(1:llm)+ap(2:llm+1))
-        bps(1:llm)=0.5*(bp(1:llm)+bp(2:llm+1))
-        scaleheight=8.
-        pseudoalt(1:llm)=-scaleheight*log(presnivs(1:llm)/preff)
-      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))
-      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles. 
-
-      IF (forcing_type == 59) THEN
-! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
-      write(*,*) '***********************'
+MODULE lmdz_scm
+  ; PRIVATE
+  PUBLIC scm
+CONTAINS
+  SUBROUTINE scm
+    USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
+    USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
+            clwcon, detr_therm, &
+            qsol, fevap, z0m, z0h, agesno, &
+            du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
+            falb_dir, falb_dif, &
+            ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
+            rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
+            solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, rneb_ancien, &
+            wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
+            wake_deltaq, wake_deltat, wake_s, awake_s, wake_dens, &
+            awake_dens, cv_gen, wake_cstar, &
+            zgam, zmax0, zmea, zpic, zsig, &
+            zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
+            prlw_ancien, prsw_ancien, prw_ancien, &
+            u10m, v10m, ale_wake, ale_bl_stat, ratqs_inter_
+
+    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
+    USE control_mod
+    USE indice_sol_mod
+    USE phyaqua_mod
+    USE mod_1D_cases_read_std
+    USE print_control_mod, ONLY: lunout, prt_level
+    USE iniphysiq_mod, ONLY: iniphysiq
+    USE mod_const_mpi, ONLY: comm_lmdz
+    USE physiq_mod, ONLY: physiq
+    USE comvert_mod, ONLY: presnivs, ap, bp, dpres, nivsig, nivsigs, pa, &
+            preff, aps, bps, pseudoalt, scaleheight
+    USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
+            itau_dyn, itau_phy, start_time, year_len
+    USE phys_cal_mod, ONLY: year_len_phys_cal_mod => year_len
+    USE lmdz_1dutils, ONLY: fq_sat, conf_unicol, dyn1deta0, dyn1dredem
+    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM
+    END SUBROUTINE scm
+    
+    INCLUDE "dimensions.h"
+    INCLUDE "YOMCST.h"
+    INCLUDE "clesphys.h"
+    INCLUDE "dimsoil.h"
+    INCLUDE "compar1d.h"
+    INCLUDE "flux_arp.h"
+    INCLUDE "date_cas.h"
+    INCLUDE "tsoilnudge.h"
+    INCLUDE "fcg_gcssold.h"
+    INCLUDE "compbl.h"
+
+    !=====================================================================
+    ! DECLARATIONS
+    !=====================================================================
+
+    !---------------------------------------------------------------------
+    !  Arguments d' initialisations de la physique (USER DEFINE)
+    !---------------------------------------------------------------------
+
+    integer, parameter :: ngrid = 1
+    real :: zcufi = 1.
+    real :: zcvfi = 1.
+    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_gabls4 = .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.
+    logical :: forcing_case2 = .FALSE.
+    logical :: forcing_SCM = .FALSE.
+
+    !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)
+
+    !---------------------------------------------------------------------
+    !  Declarations related to variables
+    !---------------------------------------------------------------------
+
+    real :: phi(llm)
+    real :: teta(llm), tetal(llm), temp(llm), u(llm), v(llm), w(llm)
+    REAL rot(1, llm) ! relative vorticity, in s-1
+    real :: rlat_rad(1), rlon_rad(1)
+    real :: omega(llm), 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 :: w_adv(llm), z_adv(llm)
+    real :: d_t_vert_adv(llm), d_u_vert_adv(llm), d_v_vert_adv(llm)
+    real :: dt_cooling(llm), d_t_adv(llm), d_t_nudge(llm)
+    real :: d_u_nudge(llm), d_v_nudge(llm)
+    !      real :: d_u_adv(llm),d_v_adv(llm)
+    real :: d_u_age(llm), d_v_age(llm)
+    real :: alpha
+    real :: ttt
+
+    REAL, ALLOCATABLE, DIMENSION(:, :) :: q
+    REAL, ALLOCATABLE, DIMENSION(:, :) :: dq
+    REAL, ALLOCATABLE, DIMENSION(:, :) :: d_q_vert_adv
+    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(1) = 0.0
+    real :: dpsrf(1)
+
+    !---------------------------------------------------------------------
+    !  Initializations of boundary conditions
+    !---------------------------------------------------------------------
+    real, allocatable :: phy_nat (:)  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    real, allocatable :: phy_alb (:)  ! Albedo land only (old value condsurf_jyg=0.3)
+    real, allocatable :: phy_sst (:)  ! SST (will not be used; cf read_tsurf1d.F)
+    real, allocatable :: phy_bil (:)  ! Ne sert que pour les slab_ocean
+    real, allocatable :: phy_rug (:) ! Longueur rugosite utilisee sur land only
+    real, allocatable :: phy_ice (:) ! Fraction de glace
+    real, allocatable :: phy_fter(:) ! Fraction de terre
+    real, allocatable :: phy_foce(:) ! Fraction de ocean
+    real, allocatable :: phy_fsic(:) ! Fraction de glace
+    real, allocatable :: phy_flic(:) ! Fraction de glace
+
+    !---------------------------------------------------------------------
+    !  Fichiers et d'autres variables
+    !---------------------------------------------------------------------
+    integer :: k, l, i, it = 1, mxcalc
+    integer :: nsrf
+    integer jcode
+    INTEGER read_climoz
+
+    integer :: it_end ! iteration number of the last call
+    !Al1,plev,play,phi,phis,presnivs,
+    integer ecrit_slab_oc !1=ecrit,-1=lit,0=no file
+    data ecrit_slab_oc/-1/
+
+    !     if flag_inhib_forcing = 0, tendencies of forcing are added
+    !                           <> 0, tendencies of forcing are not added
+    INTEGER :: flag_inhib_forcing = 0
+
+    PRINT*, 'VOUS ENTREZ DANS LE 1D FORMAT STANDARD'
+
+    !=====================================================================
+    ! INITIALIZATIONS
+    !=====================================================================
+    du_phys(:) = 0.
+    dv_phys(:) = 0.
+    dt_phys(:) = 0.
+    d_t_vert_adv(:) = 0.
+    d_u_vert_adv(:) = 0.
+    d_v_vert_adv(:) = 0.
+    dt_cooling(:) = 0.
+    d_t_adv(:) = 0.
+    d_t_nudge(:) = 0.
+    d_u_nudge(:) = 0.
+    d_v_nudge(:) = 0.
+    d_u_adv(:) = 0.
+    d_v_adv(:) = 0.
+    d_u_age(:) = 0.
+    d_v_age(:) = 0.
+
+
+    ! 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)
+    !---------------------------------------------------------------------
+    CALL conf_unicol
+    !Al1 moves this gcssold var from common fcg_gcssold to
+    Turb_fcg_gcssold = xTurb_fcg_gcssold
+    ! --------------------------------------------------------------------
+    close(1)
+    write(*, *) 'lmdz1d.def lu => unicol.def'
+
+    forcing_SCM = .TRUE.
+    year_ini_cas = 1997
+    ! It is possible that those parameters are run twice.
+    ! A REVOIR : LIRE PEUT ETRE AN MOIS JOUR DIRECETEMENT
+
+    CALL getin('anneeref', year_ini_cas)
+    CALL getin('dayref', day_deb)
+    mth_ini_cas = 1 ! pour le moment on compte depuis le debut de l'annee
+    CALL getin('time_ini', heure_ini_cas)
+
+    PRINT*, 'NATURE DE LA SURFACE ', nat_surf
+
+    ! Initialization of the logical switch for nudging
+
+    jcode = iflag_nudge
+    do i = 1, nudge_max
+      nudge(i) = mod(jcode, 10) >= 1
+      jcode = jcode / 10
+    enddo
+    !-----------------------------------------------------------------------
+    !  Definition of the run
+    !-----------------------------------------------------------------------
+
+    CALL conf_gcm(99, .TRUE.)
+
+    !-----------------------------------------------------------------------
+    allocate(phy_nat (year_len))  ! 0=ocean libre,1=land,2=glacier,3=banquise
+    phy_nat(:) = 0.0
+    allocate(phy_alb (year_len))  ! Albedo land only (old value condsurf_jyg=0.3)
+    allocate(phy_sst (year_len))  ! SST (will not be used; cf read_tsurf1d.F)
+    allocate(phy_bil (year_len))  ! Ne sert que pour les slab_ocean
+    phy_bil(:) = 1.0
+    allocate(phy_rug (year_len)) ! Longueur rugosite utilisee sur land only
+    allocate(phy_ice (year_len)) ! Fraction de glace
+    phy_ice(:) = 0.0
+    allocate(phy_fter(year_len)) ! Fraction de terre
+    phy_fter(:) = 0.0
+    allocate(phy_foce(year_len)) ! Fraction de ocean
+    phy_foce(:) = 0.0
+    allocate(phy_fsic(year_len)) ! Fraction de glace
+    phy_fsic(:) = 0.0
+    allocate(phy_flic(year_len)) ! Fraction de glace
+    phy_flic(:) = 0.0
+
+
+    !-----------------------------------------------------------------------
+    !   Choix du calendrier
+    !   -------------------
+
+    !      calend = 'earth_365d'
+    if (calend == 'earth_360d') then
+      CALL ioconf_calendar('360_day')
+      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
+      stop 'gregorian calend should not be used by normal user'
+      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
+    print *, 'fnday=', fnday
+    !     start_time doit etre en FRACTION DE JOUR
+    start_time = time_ini / 24.
+
+    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 + int(fnday)
+
+    ! Convert the initial date to Julian day
+    day_ini_cas = day_deb
+    PRINT*, 'time case', year_ini_cas, mth_ini_cas, day_ini_cas
+    CALL ymds2ju                                                         &
+            (year_ini_cas, mth_ini_cas, day_ini_cas, heure_ini_cas * 3600            &
+            , day_ju_ini_cas)
+    PRINT*, 'time case 2', day_ini_cas, day_ju_ini_cas
+    daytime = day + heure_ini_cas / 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/)) ! job now done via iniphysiq
+    !     but we still need to initialize dimphy module (klon,klev,etc.)  here.
+    CALL init_dimphy1D(1, llm)
+    CALL suphel
+    CALL init_infotrac
+
+    if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'
+    allocate(q(llm, nqtot)) ; q(:, :) = 0.
+    allocate(dq(llm, nqtot))
+    allocate(d_q_vert_adv(llm, nqtot))
+    allocate(d_q_adv(llm, nqtot))
+    allocate(d_q_nudge(llm, nqtot))
+    !      allocate(d_th_adv(llm))
+
+    q(:, :) = 0.
+    dq(:, :) = 0.
+    d_q_vert_adv(:, :) = 0.
+    d_q_adv(:, :) = 0.
+    d_q_nudge(:, :) = 0.
+
+    !   No ozone climatology need be read in this pre-initialization
+    !          (phys_state_var_init is called again in physiq)
+    read_climoz = 0
+    nsw = 6
+
+    CALL phys_state_var_init(read_climoz)
+
+    if (ngrid/=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)
+    !!!=====================================================================
+    !!
+    qsol = qsolinp
+    qsurf = fq_sat(tsurf, psurf / 100.)
+    beta_aridity(:, :) = beta_surf
+    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
+
+    ! 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'
+      aps(1:llm) = 0.5 * (ap(1:llm) + ap(2:llm + 1))
+      bps(1:llm) = 0.5 * (bp(1:llm) + bp(2:llm + 1))
+      scaleheight = 8.
+      pseudoalt(1:llm) = -scaleheight * log(presnivs(1:llm) / preff)
+    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))
+    zlay = -rd * 300. * log(play / psurf) / rg ! moved after reading profiles.
+
+    IF (forcing_type == 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)<=70000) then
-         llm700=l
-         print *,'llm700,play=',llm700,play(l)/100.
-         trouve_700= .FALSE.
-       endif
+        write(*, *) 'l,play(l),presnivs(l): ', l, play(l), presnivs(l)
+        if (trouve_700 .and. play(l)<=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"
-   PRINT*,'A d_t_adv ',d_t_adv(1:20)*86400
-
-      if (forcing_GCM2SCM) then
-        write (*,*) 'forcing_GCM2SCM not yet implemented'
-        stop 'in initialization'
-      endif ! forcing_GCM2SCM
-
-
-!=====================================================================
-! 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(1)=xlat*rpi/180.
-      rlon_rad(1)=xlon*rpi/180.
-
-     ! iniphysiq will CALL iniaqua who needs year_len from phys_cal_mod
-     year_len_phys_cal_mod=year_len
-           
-     ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
-     ! e.g. for cell boundaries, which are meaningless in 1D; so pad these 
-     ! with '0.' when necessary
-
-      CALL iniphysiq(iim,jjm,llm, &
-           1,comm_lmdz, &
-           rday,day_ini,timestep,  &
-           (/rlat_rad(1),0./),(/0./), &
-           (/0.,0./),(/rlon_rad(1),0./),  &
-           (/ (/airefi,0./),(/0.,0./) /), &
-           (/zcufi,0.,0.,0./), &
-           (/zcvfi,0./), &
-           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,:)=snowmass ! masse 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,:)=rugosh    ! 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==0.) then
-          pctsrf(1,is_oce)=1.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf == 1) then
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=1.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf == 2) then
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=1.
-          pctsrf(1,is_sic)=0.
-        else if (nat_surf == 3) then
-          pctsrf(1,is_oce)=0.
-          pctsrf(1,is_ter)=0.
-          pctsrf(1,is_lic)=0.
-          pctsrf(1,is_sic)=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
-        falb_dir=albedo
-        falb_dif=albedo
-        rugoro=rugos 
-        t_ancien(1,:)=temp(:)
-        q_ancien(1,:)=q(:,1)
-        ql_ancien = 0.
-        qs_ancien = 0.
-        prlw_ancien = 0.
+      write(*, *) '***********************'
+    ENDIF
+
+    !=====================================================================
+    ! EVENTUALLY, READ FORCING DATA :
+    !=====================================================================
+
+    INCLUDE "1D_read_forc_cases.h"
+  PRINT*, 'A d_t_adv ', d_t_adv(1:20)*86400
+
+  if (forcing_GCM2SCM) then
+  write (*, *) 'forcing_GCM2SCM not yet implemented'
+  stop 'in initialization'
+  endif ! forcing_GCM2SCM
+
+
+  !=====================================================================
+  ! 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(1) = xlat*rpi/180.
+  rlon_rad(1) = xlon*rpi/180.
+
+  ! iniphysiq will CALL iniaqua who needs year_len from phys_cal_mod
+  year_len_phys_cal_mod = year_len
+
+  ! Ehouarn: iniphysiq requires arrays related to (3D) dynamics grid,
+  ! e.g. for cell boundaries, which are meaningless in 1D; so pad these
+  ! with '0.' when necessary
+
+  CALL iniphysiq(iim, jjm, llm, &
+        1, comm_lmdz, &
+        rday, day_ini, timestep, &
+        (/rlat_rad(1), 0./), (/0./), &
+        (/0., 0./), (/rlon_rad(1), 0./), &
+        (/ (/airefi, 0./), (/0., 0./) /), &
+        (/zcufi, 0., 0., 0./), &
+        (/zcvfi, 0./), &
+        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, :) = snowmass ! masse 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, :) = rugosh    ! 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==0.) then
+  pctsrf(1, is_oce) = 1.
+  pctsrf(1, is_ter) = 0.
+  pctsrf(1, is_lic) = 0.
+  pctsrf(1, is_sic) = 0.
+  else if (nat_surf == 1) then
+  pctsrf(1, is_oce) = 0.
+  pctsrf(1, is_ter) = 1.
+  pctsrf(1, is_lic) = 0.
+  pctsrf(1, is_sic) = 0.
+  else if (nat_surf == 2) then
+  pctsrf(1, is_oce) = 0.
+  pctsrf(1, is_ter) = 0.
+  pctsrf(1, is_lic) = 1.
+  pctsrf(1, is_sic) = 0.
+  else if (nat_surf == 3) then
+  pctsrf(1, is_oce) = 0.
+  pctsrf(1, is_ter) = 0.
+  pctsrf(1, is_lic) = 0.
+  pctsrf(1, is_sic) = 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
+                falb_dir= albedo
+                falb_dif = albedo
+                rugoro = rugos
+        t_ancien(1, :)= temp(:)
+                q_ancien(1, :)= q(:, 1)
+                ql_ancien = 0.
+                qs_ancien = 0.
+                prlw_ancien = 0.
         prsw_ancien = 0.
         prw_ancien = 0.
-!jyg<
-! Etienne: comment those lines since now the TKE is inialized in 1D_read_forc_cases
-!!      pbl_tke(:,:,:)=1.e-8
-!        pbl_tke(:,:,:)=0.
-!        pbl_tke(:,2,:)=1.e-2
-!>jyg
-        rain_fall=0.
-        snow_fall=0.
-        solsw=0.
-        solswfdiff=0.
-        sollw=0.
-        sollwdown=rsigma*tsurf**4
-        radsol=0.
-        rnebcon=0.
-        ratqs=0.
-        clwcon=0.
-        zmax0 = 0.
-        zmea=zsurf
-        zstd=0.
-        zsig=0.
-        zgam=0.
-        zval=0. 
-        zthe=0. 
-        sig1=0.
-        w01=0.
+        !jyg<
+        ! Etienne: comment those lines since now the TKE is inialized in 1D_read_forc_cases
+        !!      pbl_tke(:,:,:)=1.e-8
+        !        pbl_tke(:,:,:)=0.
+        !        pbl_tke(:,2,:)=1.e-2
+        !>jyg
+        rain_fall = 0.
+        snow_fall = 0.
+        solsw = 0.
+        solswfdiff= 0.
+        sollw = 0.
+        sollwdown = rsigma*tsurf**4
+        radsol = 0.
+        rnebcon= 0.
+        ratqs = 0.
+        clwcon = 0.
+                zmax0 = 0.
+                zmea = zsurf
+                zstd= 0.
+        zsig = 0.
+        zgam = 0.
+                zval = 0.
+                zthe = 0.
+                sig1= 0.
+        w01 = 0.
 
         wake_deltaq = 0.
-        wake_deltat = 0.
-        wake_delta_pbl_TKE(:,:,:) = 0.
+                wake_deltat = 0.
+                wake_delta_pbl_TKE(:, :, :) = 0.
         delta_tsurf = 0.
         wake_fip = 0.
-        wake_pe = 0.
-        wake_s = 0.
-        awake_s = 0.
-        wake_dens = 0.
-        awake_dens = 0.
-        cv_gen = 0.
-        wake_cstar = 0.
-        ale_bl = 0.
-        ale_bl_trig = 0.
-        alp_bl = 0.
-        IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
-        IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
-        entr_therm = 0.
-        detr_therm = 0.
+                wake_pe = 0.
+                wake_s = 0.
+                awake_s = 0.
+                wake_dens = 0.
+                awake_dens = 0.
+                cv_gen = 0.
+                wake_cstar = 0.
+                ale_bl = 0.
+                ale_bl_trig = 0.
+                alp_bl = 0.
+                IF (ALLOCATED(du_gwd_rando)) du_gwd_rando = 0.
+                IF (ALLOCATED(du_gwd_front)) du_gwd_front = 0.
+                entr_therm = 0.
+                detr_therm = 0.
         f0 = 0.
         fm_therm = 0.
-        u_ancien(1,:)=u(:)
-        v_ancien(1,:)=v(:)
-        rneb_ancien(1,:)=0.
- 
-        u10m=0.
-        v10m=0.
-        ale_wake=0.
-        ale_bl_stat=0.
-        ratqs_inter_(:,:)= 0.002
-
-!------------------------------------------------------------------------
-! 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,solswfdiff,sollw, sollwdown,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,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
-! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
-
-! NB2: The content of the startphy.nc file depends on some flags defined in
-! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have 
-! to be set at some arbitratry convenient values.
-!------------------------------------------------------------------------
-!Al1 =============== restart option ======================================
-        iflag_physiq=0
-        CALL getin('iflag_physiq',iflag_physiq)
-
-        if (.not.restart) then
-          iflag_pbl = 5
-          CALL phyredem ("startphy.nc")
+        u_ancien(1, :)= u(:)
+                v_ancien(1, :)= v(:)
+                rneb_ancien(1, :)= 0.
+
+        u10m = 0.
+        v10m = 0.
+        ale_wake = 0.
+        ale_bl_stat = 0.
+        ratqs_inter_(:, :)= 0.002
+
+        !------------------------------------------------------------------------
+        ! 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,solswfdiff,sollw, sollwdown,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,awake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
+                ! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
+
+                ! NB2: The content of the startphy.nc file depends on some flags defined in
+                ! the ".def" files. However, since conf_phys is not called in lmdz1d.F90, these flags have
+                ! to be set at some arbitratry convenient values.
+                !------------------------------------------------------------------------
+                !Al1 =============== restart option ======================================
+                iflag_physiq = 0
+                CALL getin('iflag_physiq', iflag_physiq)
+
+                if (.not.restart) then
+        iflag_pbl = 5
+        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,year_len
-        phy_nat(i)  = nat_surf
-        phy_alb(i)  = albedo
+        ! (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, year_len
+                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(1)
-! raz for safety
-       do l=1,llm
-         d_q_vert_adv(l,1) = 0.
-       enddo
-      endif
-!======================  end restart =================================
-      IF (ecrit_slab_oc==1) then
-         open(97,file='div_slab.dat',STATUS='UNKNOWN')
-       elseif (ecrit_slab_oc==0) then
-         open(97,file='div_slab.dat',STATUS='OLD')
-       endif
-
-!=====================================================================
-IF (CPP_OUTPUTPHYSSCM) THEN
-       CALL iophys_ini(timestep)
-END IF
-
-!=====================================================================
-! START OF THE TEMPORAL LOOP :
-!=====================================================================
-           
-      it_end = nint(fnday*day_step)
-      do while(it<=it_end)
-
-       if (prt_level>=1) then
-         PRINT*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
-               it,day,time,it_end,day_step
-         PRINT*,'PAS DE TEMPS ',timestep
-       endif
-       if (it==it_end) lastcall=.True.
-
-!---------------------------------------------------------------------
-! Interpolation of forcings in time and onto model levels
-!---------------------------------------------------------------------
-
-      INCLUDE "1D_interp_cases.h"
-
-!---------------------------------------------------------------------
-!  Geopotential :
-!---------------------------------------------------------------------
-        phis(1)=zsurf*RG
-!        phi(1)=phis(1)+RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
+        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(1)
+                ! raz for safety
+                do l = 1, llm
+                d_q_vert_adv(l, 1) = 0.
+                enddo
+                endif
+                !======================  end restart =================================
+                IF (ecrit_slab_oc==1) then
+        open(97, file = 'div_slab.dat', STATUS = 'UNKNOWN')
+                elseif (ecrit_slab_oc==0) then
+                open(97, file = 'div_slab.dat', STATUS = 'OLD')
+                endif
+
+                !=====================================================================
+                IF (CPPKEY_OUTPUTPHYSSCM) THEN
+                CALL iophys_ini(timestep)
+        END IF
+
+        !=====================================================================
+        ! START OF THE TEMPORAL LOOP :
+        !=====================================================================
+
+        it_end = nint(fnday*day_step)
+                do while(it<=it_end)
+
+                if (prt_level>=1) then
+        PRINT*, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', &
+        it, day, time, it_end, day_step
+        PRINT*,'PAS DE TEMPS ', timestep
+        endif
+        if (it==it_end) lastcall = .True.
+
+        !---------------------------------------------------------------------
+        ! Interpolation of forcings in time and onto model levels
+        !---------------------------------------------------------------------
+
+        INCLUDE "1D_interp_cases.h"
+
+                !---------------------------------------------------------------------
+                !  Geopotential :
+                !---------------------------------------------------------------------
+                phis(1)= zsurf*RG
+        !        phi(1)=phis(1)+RD*temp(1)*(plev(1)-play(1))/(.5*(plev(1)+play(1)))
 
         ! Calculate geopotential from the ground surface since phi and phis are added in physiq_mod
-        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
-
-!---------------------------------------------------------------------
-!  Vertical advection
-!---------------------------------------------------------------------
-
-   IF ( forc_w+forc_omega > 0 ) THEN
-
-      IF ( forc_w == 1 ) THEN
-         w_adv=w_mod_cas
-         z_adv=phi/RG
-      ELSE
-         w_adv=omega
-         z_adv=play
-      ENDIF
-
-      teta=temp*(pzero/play)**rkappa
-      do l=2,llm-1
+        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
+
+                !---------------------------------------------------------------------
+                !  Vertical advection
+                !---------------------------------------------------------------------
+
+                IF (forc_w+forc_omega > 0) THEN
+
+                IF (forc_w == 1) THEN
+                w_adv = w_mod_cas
+                z_adv = phi/RG
+                ELSE
+                w_adv = omega
+                z_adv =play
+        ENDIF
+
+        teta = temp*(pzero/play)**rkappa
+        do l = 2, llm-1
         ! vertical tendencies computed as d X / d t = -W  d X / d z
-        d_u_vert_adv(l)=-w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))
-        d_v_vert_adv(l)=-w_adv(l)*(v(l+1)-v(l-1))/(z_adv(l+1)-z_adv(l-1))
-        ! d theta / dt = -W d theta / d z, transformed into d temp / d t dividing by (pzero/play(l))**rkappa
-        d_t_vert_adv(l)=-w_adv(l)*(teta(l+1)-teta(l-1))/(z_adv(l+1)-z_adv(l-1)) / (pzero/play(l))**rkappa
-        d_q_vert_adv(l,1)=-w_adv(l)*(q(l+1,1)-q(l-1,1))/(z_adv(l+1)-z_adv(l-1))
-      enddo
-      d_u_adv(:)=d_u_adv(:)+d_u_vert_adv(:)
-      d_v_adv(:)=d_v_adv(:)+d_v_vert_adv(:)
-      d_t_adv(:)=d_t_adv(:)+d_t_vert_adv(:)
-      d_q_adv(:,1)=d_q_adv(:,1)+d_q_vert_adv(:,1)
-   
-   ENDIF
-
-!---------------------------------------------------------------------
-! 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
-       end if
-       if (prt_level>=5) then
-         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,timestep, &
-                    plev,play,phi,phis,presnivs, &
-                    u,v, rot, temp,q,omega2, &
-                    du_phys,dv_phys,dt_phys,dq,dpsrf)
-                firstcall=.FALSE.
-
-!---------------------------------------------------------------------
-! Listing output for debug
-!---------------------------------------------------------------------
-        if (prt_level>=5) 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
+        d_u_vert_adv(l)= -w_adv(l)*(u(l+1)-u(l-1))/(z_adv(l+1)-z_adv(l-1))
+                d_v_vert_adv(l)= -w_adv(l)*(v(l+1)-v(l-1))/(z_adv(l+1)-z_adv(l-1))
+                        ! d theta / dt = -W d theta / d z, transformed into d temp / d t dividing by (pzero/play(l))**rkappa
+                        d_t_vert_adv(l)= -w_adv(l)*(teta(l+1)-teta(l-1))/(z_adv(l+1)-z_adv(l-1)) / (pzero/play(l))**rkappa
+                d_q_vert_adv(l, 1)= -w_adv(l)*(q(l+1, 1)-q(l-1, 1))/(z_adv(l+1)-z_adv(l-1))
+                        enddo
+                        d_u_adv(:)= d_u_adv(:)+d_u_vert_adv(:)
+                        d_v_adv(:)= d_v_adv(:)+d_v_vert_adv(:)
+                        d_t_adv(:)= d_t_adv(:)+d_t_vert_adv(:)
+                        d_q_adv(:, 1)= d_q_adv(:, 1)+d_q_vert_adv(:, 1)
+
+                ENDIF
+
+                !---------------------------------------------------------------------
+                ! 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
+                end if
+                        if (prt_level>=5) then
+                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, timestep, &
+                        plev, play, phi, phis, presnivs, &
+                        u, v, rot, temp, q,omega2, &
+                        du_phys, dv_phys, dt_phys, dq,dpsrf)
+                        firstcall = .FALSE.
+
+                        !---------------------------------------------------------------------
+                        ! Listing output for debug
+                        !---------------------------------------------------------------------
+                        if (prt_level>=5) 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 (prt_level >= 5) PRINT*, 'fcoriolis, xlat,mxcalc ', &
+        fcoriolis, xlat, mxcalc
+
+        !---------------------------------------------------------------------
+        ! Geostrophic forcing
+        !---------------------------------------------------------------------
+
+        IF (forc_geo == 0) THEN
+        d_u_age(1:mxcalc)= 0.
+        d_v_age(1:mxcalc)= 0.
+        ELSE
+        sfdt = sin(0.5*fcoriolis*timestep)
+                cfdt = cos(0.5*fcoriolis*timestep)
+
+        d_u_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))
+
+                d_v_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))
+                ENDIF
+
+                !---------------------------------------------------------------------
+                !  Nudging
+                !  EV: rewrite the section to account for a time- and height-varying
+                !  nudging
+                !---------------------------------------------------------------------
+                d_t_nudge(:) = 0.
+        d_u_nudge(:) = 0.
+        d_v_nudge(:) = 0.
+        d_q_nudge(:, :) = 0.
+
+        DO l = 1, llm
+
+                IF (nudging_u < 0) THEN
+
+                d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))*invtau_u_nudg_mod_cas(l)
+
+                ELSE
+
+                IF (play(l) < p_nudging_u .AND. nint(nudging_u) /= 0) &
+                d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u
+
+        ENDIF
+
+
+        IF (nudging_v < 0) THEN
+
+        d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))*invtau_v_nudg_mod_cas(l)
+
+                ELSE
+
+
+                IF (play(l) < p_nudging_v .AND. nint(nudging_v) /= 0) &
+        d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v
+
+        ENDIF
+
+
+        IF (nudging_t < 0) THEN
+
+        d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))*invtau_temp_nudg_mod_cas(l)
+
+                ELSE
+
+
+                IF (play(l) < p_nudging_t .AND. nint(nudging_t) /= 0) &
+                d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t
+
+                ENDIF
+
+
+                IF (nudging_qv < 0) THEN
+
+        d_q_nudge(l, 1)=(qv_nudg_mod_cas(l)-q(l, 1))*invtau_qv_nudg_mod_cas(l)
+
+                ELSE
+
+                IF (play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0) &
+                d_q_nudge(l, 1)=(qv_nudg_mod_cas(l)-q(l, 1))/nudging_qv
+
+        ENDIF
+
+        ENDDO
+
+        !---------------------------------------------------------------------
+        !  Optional outputs
+        !---------------------------------------------------------------------
+
+                IF (CPPKEY_OUTPUTPHYSSCM) THEN
+                CALL iophys_ecrit('w_adv', klev, 'w_adv', 'K/day', w_adv)
+                CALL iophys_ecrit('z_adv', klev, 'z_adv', 'K/day', z_adv)
+                CALL iophys_ecrit('dtadv', klev, 'dtadv', 'K/day', 86400*d_t_adv)
+        CALL iophys_ecrit('dtdyn', klev, 'dtdyn', 'K/day', 86400*d_t_vert_adv)
+                CALL iophys_ecrit('qv', klev, 'qv', 'g/kg', 1000*q(:, 1))
+                CALL iophys_ecrit('qvnud', klev, 'qvnud', 'g/kg', 1000*u_nudg_mod_cas)
+                CALL iophys_ecrit('u', klev, 'u', 'm/s', u)
+                CALL iophys_ecrit('unud', klev, 'unud', 'm/s', u_nudg_mod_cas)
+        CALL iophys_ecrit('v', klev, 'v', 'm/s', v)
+                CALL iophys_ecrit('vnud', klev, 'vnud', 'm/s', v_nudg_mod_cas)
+                CALL iophys_ecrit('temp', klev, 'temp', 'K', temp)
+                CALL iophys_ecrit('tempnud', klev, 'temp_nudg_mod_cas', 'K', temp_nudg_mod_cas)
+                CALL iophys_ecrit('dtnud', klev, 'dtnud', 'K/day', 86400*d_t_nudge)
+        CALL iophys_ecrit('dqnud', klev, 'dqnud', 'K/day', 1000*86400*d_q_nudge(:, 1))
+                END IF
+
+                IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
+
+        u(1:mxcalc)= u(1:mxcalc) + timestep*(&
+        du_phys(1:mxcalc)                                       &
+        +d_u_age(1:mxcalc)+d_u_adv(1:mxcalc)                       &
+        +d_u_nudge(1:mxcalc))
+        v(1:mxcalc)= v(1:mxcalc) + timestep*(&
+        dv_phys(1:mxcalc)                                       &
+        +d_v_age(1:mxcalc)+d_v_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>=3) then
+                print *, &
+                'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &
+                temp(1), dt_phys(1), d_t_adv(1), dt_cooling(1)
+                PRINT*, 'dv_phys=', dv_phys
+                PRINT* , 'd_v_age=', d_v_age
+                PRINT*, 'd_v_adv=',d_v_adv
+                PRINT*, 'd_v_nudge=', d_v_nudge
+                PRINT*, v
+                PRINT*, vg
+                endif
+
+                temp(1:mxcalc)= temp(1:mxcalc)+timestep*(&
+        dt_phys(1:mxcalc)                                       &
+        +d_t_adv(1:mxcalc)                                       &
+        +d_t_nudge(1:mxcalc)                                     &
+        +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
+
+
+        !=======================================================================
+        !! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
+        !=======================================================================
+
+        teta = temp*(pzero/play)**rkappa
+
+        !---------------------------------------------------------------------
+        !   Nudge soil temperature if requested
+        !---------------------------------------------------------------------
+
+        IF (nudge_tsoil .AND. .NOT. lastcall) 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)
+
+                END IF ! end if tendency of tendency should be added
+
+                !---------------------------------------------------------------------
+                !   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
-!---------------------------------------------------------------------
-!   Add physical tendencies :
-!---------------------------------------------------------------------
-
-       fcoriolis=2.*sin(rpi*xlat/180.)*romega
-
-      IF (prt_level >= 5) PRINT*, 'fcoriolis, xlat,mxcalc ', &
-                                   fcoriolis, xlat,mxcalc
-
-!---------------------------------------------------------------------
-! Geostrophic forcing 
-!---------------------------------------------------------------------
-
-      IF ( forc_geo == 0 ) THEN
-              d_u_age(1:mxcalc)=0.
-              d_v_age(1:mxcalc)=0.
-      ELSE
-       sfdt = sin(0.5*fcoriolis*timestep)
-       cfdt = cos(0.5*fcoriolis*timestep)
-
-        d_u_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))
-
-       d_v_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))
-      ENDIF
-
-!---------------------------------------------------------------------
-!  Nudging
-!  EV: rewrite the section to account for a time- and height-varying
-!  nudging
-!---------------------------------------------------------------------
-      d_t_nudge(:) = 0.
-      d_u_nudge(:) = 0.
-      d_v_nudge(:) = 0.
-      d_q_nudge(:,:) = 0.
-
-      DO l=1,llm
-
-         IF (nudging_u < 0) THEN
-              
-             d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))*invtau_u_nudg_mod_cas(l)
-       
-         ELSE
-
-             IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) &
-   d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u
-
-         ENDIF 
-
-
-         IF (nudging_v < 0) THEN
-              
-             d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))*invtau_v_nudg_mod_cas(l)
-       
-         ELSE
-
-
-             IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) &
-   d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v
-
-         ENDIF
-
-
-         IF (nudging_t < 0) THEN
-              
-             d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))*invtau_temp_nudg_mod_cas(l)
-       
-         ELSE
-
-
-             IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) &
-   d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t
-
-          ENDIF
-
-
-         IF (nudging_qv < 0) THEN
-              
-             d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))*invtau_qv_nudg_mod_cas(l)
-       
-         ELSE
-
-             IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) &
-   d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv
-
-         ENDIF
-
-      ENDDO
-
-!---------------------------------------------------------------------
-!  Optional outputs
-!---------------------------------------------------------------------
-
-IF (CPP_OUTPUTPHYSSCM) THEN
-      CALL iophys_ecrit('w_adv',klev,'w_adv','K/day',w_adv)
-      CALL iophys_ecrit('z_adv',klev,'z_adv','K/day',z_adv)
-      CALL iophys_ecrit('dtadv',klev,'dtadv','K/day',86400*d_t_adv)
-      CALL iophys_ecrit('dtdyn',klev,'dtdyn','K/day',86400*d_t_vert_adv)
-      CALL iophys_ecrit('qv',klev,'qv','g/kg',1000*q(:,1))
-      CALL iophys_ecrit('qvnud',klev,'qvnud','g/kg',1000*u_nudg_mod_cas)
-      CALL iophys_ecrit('u',klev,'u','m/s',u)
-      CALL iophys_ecrit('unud',klev,'unud','m/s',u_nudg_mod_cas)
-      CALL iophys_ecrit('v',klev,'v','m/s',v)
-      CALL iophys_ecrit('vnud',klev,'vnud','m/s',v_nudg_mod_cas)
-      CALL iophys_ecrit('temp',klev,'temp','K',temp)
-      CALL iophys_ecrit('tempnud',klev,'temp_nudg_mod_cas','K',temp_nudg_mod_cas)
-      CALL iophys_ecrit('dtnud',klev,'dtnud','K/day',86400*d_t_nudge)
-      CALL iophys_ecrit('dqnud',klev,'dqnud','K/day',1000*86400*d_q_nudge(:,1))
-END IF
-
-    IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
-
-        u(1:mxcalc)=u(1:mxcalc) + timestep*(                                &
-                du_phys(1:mxcalc)                                       &
-               +d_u_age(1:mxcalc)+d_u_adv(1:mxcalc)                       &
-               +d_u_nudge(1:mxcalc) )
-        v(1:mxcalc)=v(1:mxcalc) + timestep*(                                 &
-                dv_phys(1:mxcalc)                                       &
-               +d_v_age(1:mxcalc)+d_v_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>=3) then
-          print *,                                                          &
-      'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
-                temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)
-           PRINT* ,'dv_phys=',dv_phys
-           PRINT* ,'d_v_age=',d_v_age
-           PRINT* ,'d_v_adv=',d_v_adv
-           PRINT* ,'d_v_nudge=',d_v_nudge
-           PRINT*, v
-           PRINT*, vg
-        endif
-
-        temp(1:mxcalc)=temp(1:mxcalc)+timestep*(                            &
-                dt_phys(1:mxcalc)                                       &
-               +d_t_adv(1:mxcalc)                                       &
-               +d_t_nudge(1:mxcalc)                                     &
-               +dt_cooling(1:mxcalc))  ! Taux de chauffage ou refroid.
-
-
-!=======================================================================
-!! CONSERVE EN ATTENDANT QUE LE CAS EN QUESTION FONCTIONNE EN STD !!
-!=======================================================================
-
-        teta=temp*(pzero/play)**rkappa
-
-!---------------------------------------------------------------------
-!   Nudge soil temperature if requested
-!---------------------------------------------------------------------
-
-      IF (nudge_tsoil .AND. .NOT. lastcall) 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)
-
-   END IF ! end if tendency of tendency should be added
-
-!---------------------------------------------------------------------
-!   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
+
+        !  incremente day time
         daytime = daytime+1./day_step
         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
-        it=it+1
-
-      enddo
-
-      if (ecrit_slab_oc/=-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)
+                !        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
+                it = it+1
+
+                enddo
+
+                if (ecrit_slab_oc/=-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 SUBROUTINE scm
+END MODULE lmdz_scm