SUBROUTINE scm

   USE flux_arp_mod_h
   USE compbl_mod_h
   USE clesphys_mod_h
   USE ioipsl, only: ju2ymds, ymds2ju, ioconf_calendar, getin
   USE phyetat0_get_mod, ONLY: phyetat0_get, phyetat0_srf
   USE phys_state_var_mod, ONLY: phys_state_var_init, phys_state_var_end, &
                                 clwcon, detr_therm, &
                                 qsol, fevap, z0m, z0h, agesno, &
                                 frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, &
                                 albedo_tersrf, beta_tersrf, inertie_tersrf, &
                                 alpha_soil_tersrf, period_tersrf, hcond_tersrf, &
                                 tsurfi_tersrf, tsoili_tersrf, tsoil_depth, &
                                 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, &
                                 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, qbs_ancien, cf_ancien, rvc_ancien, &
                                 prlw_ancien, prsw_ancien, prbsw_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 simplehydrol_mod, only: simplehydrol_init, simplehydrol_final

   USE infotrac
   USE control_mod
   USE indice_sol_mod
   USE phyaqua_mod
   USE mod_1D_cases_read_std
   USE mod_1D_tools, ONLY: conf_unicol, dyn1deta0, dyn1dredem, fq_sat, disvert0
   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_cppkeys_wrapper, ONLY: CPPKEY_OUTPUTPHYSSCM

   USE dimensions_mod, ONLY: iim, jjm, llm, ndm
   USE dimsoil_mod_h, ONLY: nsoilmx
   USE yomcst_mod_h
   USE tsoilnudge_mod_h
   USE compar1d_mod_h
   USE date_cas_mod_h

   implicit none

!=====================================================================
! DECLARATIONS
!=====================================================================

!---------------------------------------------------------------------
!  initialisation arguments (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

        integer iflag_1d_vert_adv
        real timestep

!=====================================================================
! DECLARATIONS FOR EACH CASE
!=====================================================================

   real ts_prof
   real w_mod(llm), t_mod(llm), q_mod(llm)
   real u_mod(llm), v_mod(llm), ht_mod(llm), vt_mod(llm), ug_mod(llm), vg_mod(llm)
   real temp_nudg_mod(llm), qv_nudg_mod(llm), u_nudg_mod(llm), v_nudg_mod(llm)
   real hq_mod(llm), vq_mod(llm), qv_mod(llm), ql_mod(llm), qt_mod(llm)
   real th_mod(llm)

   ! forcing interpolating in time
   real adv_theta_prof, rad_theta_prof, adv_qt_prof
   real sens_prof, flat_prof, fact

   real, dimension(llm) :: relax_u, relax_v, relax_thl
   real, dimension(llm, 2) :: relax_q

   real thl_mod(llm), omega_mod(llm), o3mmr_mod(llm), tke_mod(llm)

   !vertical advection computation
   real d_t_z(llm), d_th_z(llm), d_q_z(llm)
   real d_t_dyn_z(llm), d_th_dyn_z(llm), d_q_dyn_z(llm)
   real d_u_z(llm), d_v_z(llm)
   real d_u_dyn(llm), d_v_dyn(llm)
   real d_u_dyn_z(llm), d_v_dyn_z(llm)
   real d_u_adv(llm), d_v_adv(llm)
   real zz(llm)
   real zfact

   real w_mod_cas(llm), t_mod_cas(llm), q_mod_cas(llm)
   real theta_mod_cas(llm), thl_mod_cas(llm), thv_mod_cas(llm)
   real qv_mod_cas(llm), ql_mod_cas(llm), qi_mod_cas(llm)
   real ug_mod_cas(llm), vg_mod_cas(llm)
   real temp_nudg_mod_cas(llm), qv_nudg_mod_cas(llm), v_nudg_mod_cas(llm), u_nudg_mod_cas(llm)
   real invtau_temp_nudg_mod_cas(llm), invtau_qv_nudg_mod_cas(llm), invtau_v_nudg_mod_cas(llm), invtau_u_nudg_mod_cas(llm)
   real u_mod_cas(llm), v_mod_cas(llm)
   real omega_mod_cas(llm), tke_mod_cas(llm + 1)
   real ht_mod_cas(llm), vt_mod_cas(llm), dt_mod_cas(llm), dtrad_mod_cas(llm)
   real hth_mod_cas(llm), vth_mod_cas(llm), dth_mod_cas(llm)
   real hq_mod_cas(llm), vq_mod_cas(llm), dq_mod_cas(llm)
   real hu_mod_cas(llm), vu_mod_cas(llm), du_mod_cas(llm)
   real hv_mod_cas(llm), vv_mod_cas(llm), dv_mod_cas(llm)
   integer day_ini_cas

!---------------------------------------------------------------------
!  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_age(llm), d_v_age(llm)

   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

!---------------------------------------------------------------------
!  Initialization of surface variables
!---------------------------------------------------------------------
   real :: run_off_lic_0(1)
   real :: fder(1), snsrf(1, nbsrf), qsurfsrf(1, nbsrf)
   real :: hice(1), tice(1), bilg_cumul(1)
   real :: tsoil(1, nsoilmx, nbsrf)
   REAL, ALLOCATABLE, DIMENSION(:, :) :: tsoil_ter_srf2 ! resized initial soil temperature on vertical levels (K)
   REAL, ALLOCATABLE, DIMENSION(:, :) :: tsoil_depths2  ! resized soil depth at which inititial temperature is given (m)

!---------------------------------------------------------------------
!  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,1=land,2=glacier,3=sea ice
   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(:)  ! only for slab_ocean
   real, allocatable :: phy_rug(:) ! roughness length over land only
   real, allocatable :: phy_ice(:) ! ice fraction
   real, allocatable :: phy_fter(:) ! land fraction
   real, allocatable :: phy_foce(:) ! ocean fraction
   real, allocatable :: phy_fsic(:) ! sea ice fraction
   real, allocatable :: phy_flic(:) ! land ice fraction

!---------------------------------------------------------------------
!  additional variables
!---------------------------------------------------------------------
   integer :: k, l, i, it = 1, mxcalc
   integer :: nsrf
   integer :: it_end ! iteration number of the last call

!     if flag_inhib_forcing = 0, tendencies of forcing are added
!                           <> 0, tendencies of forcing are not added
   INTEGER :: flag_inhib_forcing = 0
   CHARACTER(len=80) :: abort_message
   CHARACTER(len=20) :: modname = 'scm'
   LOGICAL :: found

!=====================================================================
! 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.

!---------------------------------------------------------------------
! OPTIONS OF THE 1D SIMULATION (lmdz1d.def => unicol.def)
!---------------------------------------------------------------------
   call conf_unicol

! --------------------------------------------------------------------
   close (1)

   year_ini_cas = 1997
   call getin('anneeref', year_ini_cas)
   call getin('dayref', day_deb)
   mth_ini_cas = 1 ! we count from the beginning of the year
   call getin('time_ini', heure_ini_cas)
   ! numerical scheme for vertical advection
   iflag_1d_vert_adv = 1
   call getin('iflag_1d_vert_adv', iflag_1d_vert_adv)
   iflag_hetero_surf = 0
   CALL getin('iflag_hetero_surf', iflag_hetero_surf)


!-----------------------------------------------------------------------
!  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

!-----------------------------------------------------------------------
!   Calendar
!-----------------------------------------------------------------------

   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'
   end if
!-----------------------------------------------------------------------
! Date :
!      date is supposed to be given as [year, number of day in the year]

   if (nday > 0) then
      fnday = nday
   else
      fnday = -nday/float(day_step)
   end if

! start_time should be in fraction of day
   start_time = time_ini/24.

   annee_ref = anneeref
   mois = 1
   day_ref = dayref
   heure = 0.
   itau_dyn = 0
   itau_phy = 0
! call ymdsju to convert in Julian day
   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
   call ymds2ju                                                         &
  & (year_ini_cas, mth_ini_cas, day_ini_cas, heure_ini_cas*3600            &
  & , day_ju_ini_cas)
   daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation

!---------------------------------------------------------------------
! 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, nb_ter_srf, nb_tsoil_depths)
   call suphel
   call init_infotrac

   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))

   q(:, :) = 0.
   dq(:, :) = 0.
   d_q_vert_adv(:, :) = 0.
   d_q_adv(:, :) = 0.
   d_q_nudge(:, :) = 0.

   NSW = 6

   call phys_state_var_init

   qsol = qsolinp
   CALL fq_sat(tsurf, psurf/100., qsurf)
   beta_aridity(:, :) = beta_surf
   day1 = day_ini
   time = daytime - day
   rho(1) = psurf/(rd*tsurf*(1.+(rv/rd - 1.)*qsurf))

   IF (.NOT. ok_flux_surf .or. max(abs(wtsurf), abs(wqsurf)) > 0.) THEN
      fsens = -wtsurf*rcpd*rho(1)
      flat = -wqsurf*rlvtt*rho(1)
   END IF

! Vertical discretization and pressure levels at half and mid levels:

   pa = 5e4
   preff = psurf
   IF (ok_old_disvert) THEN
      call disvert0(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
      print *, 'we use 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 *, 'we use disvert'
   END IF

   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.


!=====================================================================
! READ FORCING DATA :
!=====================================================================


   call read_SCM_cas


!Time interpolation for initial conditions using interpolation routine
   CALL interp_case_time_std(daytime, day1, annee_ref &
                             , nt_cas, nlev_cas &
                             , ts_cas, tskin_cas, ps_cas, plev_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, ql_cas, qi_cas &
                             , u_cas, v_cas, ug_cas, vg_cas &
                             , temp_nudg_cas, qv_nudg_cas, u_nudg_cas, v_nudg_cas &
                             , invtau_temp_nudg_cas, invtau_qv_nudg_cas, invtau_u_nudg_cas, invtau_v_nudg_cas &
                             , vitw_cas, omega_cas, tke_cas, du_cas, hu_cas, vu_cas &
                             , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas &
                             , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, lat_cas, sens_cas, ustar_cas &
                             , uw_cas, vw_cas, q1_cas, q2_cas, tkes_cas &
                             , ts_prof_cas, tskin_prof_cas, ps_prof_cas, plev_prof_cas, t_prof_cas, theta_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 &
                             , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas &
                             , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas &
                             , vitw_prof_cas, omega_prof_cas, tke_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, lat_prof_cas &
                             , sens_prof_cas, ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tkes_prof_cas)

! vertical interpolation using interpolation routine:
   CALL interp2_case_vertical_std(play, plev, nlev_cas, plev_prof_cas &
                                  , t_prof_cas, theta_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 &
                                  , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas &
                              , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas &
                                  , vitw_prof_cas, omega_prof_cas, tke_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 &
                                  , temp_nudg_mod_cas, qv_nudg_mod_cas, u_nudg_mod_cas, v_nudg_mod_cas &
                                  , invtau_temp_nudg_mod_cas, invtau_qv_nudg_mod_cas, invtau_u_nudg_mod_cas, invtau_v_nudg_mod_cas &
                                  , w_mod_cas, omega_mod_cas, tke_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)

! initial and boundary conditions :

   ! initial pressure
   psurf = ps_prof_cas

   !initial surface temperature
   if (tskin_prof_cas .NE. 0.) then
      ! we take the first value of the prescribed ts
      tsurf = tskin_prof_cas
   else if (ts_prof_cas .NE. 0) then
      ! if an initial ts value is present, we take it
      tsurf = ts_prof_cas
   else
      ! in case no surface temperature is prescribed at t=0 (for cases forced in fluxes only)
      ! we set an abitrary value here otherwise the model crashes when it compute surface fluxes
      ! (that are then replaced with forced values)     
      tsurf = 300.
   end if

   ! ts forcing during the run (if any)
   tg = ts_prof_cas
   if ((tg .eq. 0.) .and. (tskin_prof_cas .NE. 0.)) THEN
      tg = tskin_prof_cas
   end if

   do l = 1, llm
      temp(l) = t_mod_cas(l)
      q(l, 1) = qv_mod_cas(l)
      q(l, 2) = ql_mod_cas(l)
      q(l, 3) = qi_mod_cas(l)
      u(l) = u_mod_cas(l)
      ug(l) = ug_mod_cas(l)
      v(l) = v_mod_cas(l)
      vg(l) = vg_mod_cas(l)
      omega(l) = omega_mod_cas(l)
      omega2(l) = omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq

! On effectue la somme du forcage total et de la decomposition
! horizontal/vertical en supposant que soit l'un soit l'autre
! sont remplis mais jamais les deux

      d_t_adv(l) = dt_mod_cas(l) + ht_mod_cas(l) + vt_mod_cas(l)
      d_q_adv(l, 1) = dq_mod_cas(l) + hq_mod_cas(l) + vq_mod_cas(l)
      ! no advection of other water species than vapor
      d_u_adv(l) = du_mod_cas(l) + hu_mod_cas(l) + vu_mod_cas(l)
      d_v_adv(l) = dv_mod_cas(l) + hv_mod_cas(l) + vv_mod_cas(l)
   end do

! Etienne pour initialisation de TKE
   do l = 1, llm + 1
      pbl_tke(:, l, :) = tke_mod_cas(l)
   end do

        ! surface forcing in fluxes
   IF (ok_flux_surf) THEN
      fsens = -1.*sens_prof_cas
      flat = -1.*lat_prof_cas
   END IF
   IF (ok_prescr_ust) THEN
      ust = ustar_prof_cas
   END IF

!=====================================================================
! Physics initialization
!=====================================================================

! 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)
   timestep = rday/day_step
   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)

   ! 2 PARAMETERS THAT SHOULD BE read in the .def files BUT ARE NOT
   co2_ppm = 330.0
   solaire = 1370.0

!--------------------------------------------------------------------------
! 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 simplehydrol_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

      IF (iflag_hetero_surf .GT. 0) THEN
         IF ((nbtersrf .LT. 2) .OR. (nbtersrf .GT. max_nbtersrf)) THEN
            abort_message = 'The number of continental sub-surfaces (nb_ter_srf) must be between 2 and 5'
            CALL abort_physic(modname, abort_message, 1)
         END IF
         ! resized initial soil temperature on vertical levels and soil depth at which inititial temperature is given
         ALLOCATE (tsoil_ter_srf2(nbtsoildepths, nbtersrf))
         ALLOCATE (tsoil_depths2(nbtsoildepths, nbtersrf))
         tsoil_ter_srf2(:, :) = 0.
         tsoil_depths2(:, :) = 0.
         DO i = 1, nbtersrf
            DO l = 1, nbtsoildepths
               k = nbtsoildepths*(i - 1) + l
               tsoil_ter_srf2(l, i) = tsoil_ter_srf(k)
               tsoil_depths2(l, i) = tsoil_depths(k)
            END DO
         END DO
         !
         DO i = 1, nbtersrf
            frac_tersrf(:, i) = frac_ter_srf(i)                   ! fraction of land surface heterogeneity (-)
            z0m_tersrf(:, i) = rugos_ter_srf(i)                   ! roughness length for momentum of land sub-surfaces (m)
            ratio_z0m_z0h_tersrf(:, i) = ratio_z0m_z0h_ter_srf(i) ! ratio of heat to momentum roughness length of land sub-surfaces (-)
            albedo_tersrf(:, i) = albedo_ter_srf(i)               ! albedo of land sub-surfaces (-)
            beta_tersrf(:, i) = beta_ter_srf(i)                   ! evapotranspiration coef of land sub-surfaces (-)
            inertie_tersrf(:, i) = inertie_ter_srf(i)             ! soil thermal inertia of land sub-surfaces (J/m2/K/s1/2)
            hcond_tersrf(:, i) = hcond_ter_srf(i)                 ! soil heat conductivity (W/(m.K))
            tsurfi_tersrf(:, i) = tsurf_ter_srf(i)                ! initial surface temperature (K)
            DO l = 1, nbtsoildepths
               tsoili_tersrf(:, l, i) = tsoil_ter_srf2(l, i)         ! initial soil temperature on vertical levels (K)
               tsoil_depth(:, l, i) = tsoil_depths2(l, i)
            END DO
         END DO
         alpha_soil_tersrf = alpha_soil_ter_srf               ! ratio between the thicknesses of 2 successive layers (-)
         period_tersrf = period_ter_srf                       ! temperature oscillation amplitude period
         DEALLOCATE (tsoil_ter_srf2)
         DEALLOCATE (tsoil_depths2)
      END IF

!-----------------------------------------------------------------------

      found = phyetat0_get(hice, "hice", "Ice thickness", 0.)
      IF (.NOT. found) THEN
         PRINT *, "phyetat0: Le champ <hice> est absent"
         PRINT *, "Initialisation a hice=1m "
         hice(:) = 1.0
      END IF
      found = phyetat0_get(tice, "tice", "Sea Ice temperature", 0.)
      IF (.NOT. found) THEN
         PRINT *, "phyetat0: Le champ <tice> est absent"
         PRINT *, "Initialisation a tsol_sic"
         tice(:) = ftsol(:, is_sic)
      END IF
      found = phyetat0_get(bilg_cumul, "bilg_cumul", "Flux conductivite + transmit sea-ice", 0.)
      IF (.NOT. found) THEN
         PRINT *, "phyetat0: Le champ <bilg_cumul> est absent"
         PRINT *, "Initialisation a zero"
         bilg_cumul(:) = 0.0
      END IF

      call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil, hice, tice, bilg_cumul)

!------------------ prepare limit conditions for limit.nc -----------------

      pctsrf(1, :) = 0.
      if (nat_surf .eq. 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 .eq. 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 .eq. 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 .eq. 3) then
         pctsrf(1, is_oce) = 0.
         pctsrf(1, is_ter) = 0.
         pctsrf(1, is_lic) = 0.
         pctsrf(1, is_sic) = 1.

      end if

      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.
      IF (ok_bs) THEN
         qbs_ancien = 0.
         prbsw_ancien = 0.
      END IF
      IF (ok_ice_supersat) THEN
         cf_ancien = 0.
         rvc_ancien = 0.
      END IF
      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(:)

      u10m = 0.
      v10m = 0.
      ale_wake = 0.
      ale_bl_stat = 0.
      ratqs_inter_(:, :) = 0.002

!------------------------------------------------------------------------
! Make file containing start 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 scm.F90, these flags have
! to be set at some arbitratry convenient values.
!------------------------------------------------------------------------
      iflag_physiq = 0
      call getin('iflag_physiq', iflag_physiq)

      if (.not. restart) then
         iflag_pbl = 5
         call phyredem("startphy.nc")
      else
         ! (deallocations)
         call pbl_surface_final(fder, snsrf, qsurfsrf, tsoil)
         CALL simplehydrol_final(run_off_lic_0)
      end if


!------------------------------------------------------------------------
! Make file containing boundary conditions (limit.nc)
! --------------------------------------------------
! NB: List of the variables to be written in limit.nc
!        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

   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

   if (restart) then
      Call dyn1deta0("start1dyn.nc", plev, play, phi, phis, presnivs,          &
   &              u, v, temp, q, omega2)

      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)

      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)
      do l = 1, llm
         d_q_vert_adv(l, :) = 0.
      end do
   end if
!======================  end start =================================
   IF (CPPKEY_OUTPUTPHYSSCM) THEN
      CALL iophys_ini(timestep)
   END IF

!=====================================================================
! START OF THE TEMPORAL LOOP :
!=====================================================================

   it_end = nint(fnday*day_step)
   do while (it .le. it_end)

      if (prt_level .ge. 1) then
         print *, 'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
     &             it, day, time, it_end, day_step
         print *, 'PAS DE TEMPS ', timestep
      end if
      if (it .eq. it_end) lastcall = .True.

!---------------------------------------------------------------------
! Interpolation of forcings in time and onto model levels
!---------------------------------------------------------------------

! time interpolation:
      CALL interp_case_time_std(daytime, day1, annee_ref &
                                , nt_cas, nlev_cas &
                                , ts_cas, tskin_cas, ps_cas, plev_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, ql_cas, qi_cas &
                                , u_cas, v_cas, ug_cas, vg_cas &
                                , temp_nudg_cas, qv_nudg_cas, u_nudg_cas, v_nudg_cas &
                                , invtau_temp_nudg_cas, invtau_qv_nudg_cas, invtau_u_nudg_cas, invtau_v_nudg_cas &
                                , vitw_cas, omega_cas, tke_cas, du_cas, hu_cas, vu_cas &
                                , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas &
                                , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, lat_cas, sens_cas, ustar_cas &
                                , uw_cas, vw_cas, q1_cas, q2_cas, tkes_cas &
                               , ts_prof_cas, tskin_prof_cas, ps_prof_cas, plev_prof_cas, t_prof_cas, theta_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 &
                                , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas &
                              , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas &
                                , vitw_prof_cas, omega_prof_cas, tke_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, lat_prof_cas &
                                , sens_prof_cas, ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tkes_prof_cas)
        
      tg = ts_prof_cas
      if (tg .eq. 0.) then
         if (tskin_prof_cas .ne. 0.) then
            tg = tskin_prof_cas
         else
            tg = 300. ! we set an abitrary non 0 value to avoid model crash when
                        ! surface flux calculation (before they are replaced by forced values)
         end if
      end if

      psurf = ps_prof_cas

! vertical interpolation:
      CALL interp2_case_vertical_std(play, plev, nlev_cas, plev_prof_cas &
                                     , t_prof_cas, theta_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 &
                                     , temp_nudg_prof_cas, qv_nudg_prof_cas, u_nudg_prof_cas, v_nudg_prof_cas &
                              , invtau_temp_nudg_prof_cas, invtau_qv_nudg_prof_cas, invtau_u_nudg_prof_cas, invtau_v_nudg_prof_cas &
                                     , vitw_prof_cas, omega_prof_cas, tke_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 &
                                     , temp_nudg_mod_cas, qv_nudg_mod_cas, u_nudg_mod_cas, v_nudg_mod_cas &
                                  , invtau_temp_nudg_mod_cas, invtau_qv_nudg_mod_cas, invtau_u_nudg_mod_cas, invtau_v_nudg_mod_cas &
                                     , w_mod_cas, omega_mod_cas, tke_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)

      DO l = 1, llm
         teta(l) = temp(l)*(100000./play(l))**(rd/rcpd)
      END DO

! Vertical advection calculation from omega
! compute vertical gradients first
      d_t_z(:) = 0.
      d_th_z(:) = 0.
      d_q_z(:) = 0.
      d_u_z(:) = 0.
      d_v_z(:) = 0.
      d_t_dyn_z(:) = 0.
      d_th_dyn_z(:) = 0.
      d_q_dyn_z(:) = 0.
      d_u_dyn_z(:) = 0.
      d_v_dyn_z(:) = 0.

      DO l = 2, llm - 1
         IF (omega(l) > 0.) THEN
            d_t_z(l) = (temp(l + 1) - temp(l))/(play(l + 1) - play(l))
            d_th_z(l) = (teta(l + 1) - teta(l))/(play(l + 1) - play(l))
            d_q_z(l) = (q(l + 1, 1) - q(l, 1))/(play(l + 1) - play(l))
            d_u_z(l) = (u(l + 1) - u(l))/(play(l + 1) - play(l))
            d_v_z(l) = (v(l + 1) - v(l))/(play(l + 1) - play(l))
         ELSE
            d_t_z(l) = (temp(l - 1) - temp(l))/(play(l - 1) - play(l))
            d_th_z(l) = (teta(l - 1) - teta(l))/(play(l - 1) - play(l))
            d_q_z(l) = (q(l - 1, 1) - q(l, 1))/(play(l - 1) - play(l))
            d_u_z(l) = (u(l - 1) - u(l))/(play(l - 1) - play(l))
            d_v_z(l) = (v(l - 1) - v(l))/(play(l - 1) - play(l))
         END IF
      END DO

      d_t_z(1) = d_t_z(2)
      d_t_z(1) = d_t_z(2)
      d_th_z(1) = d_th_z(2)
      d_q_z(1) = d_q_z(2)
      d_u_z(1) = d_u_z(2)
      d_v_z(1) = d_v_z(2)
      d_t_z(llm) = d_t_z(llm - 1)
      d_th_z(llm) = d_th_z(llm - 1)
      d_q_z(llm) = d_q_z(llm - 1)
      d_u_z(llm) = d_u_z(llm - 1)
      d_v_z(llm) = d_v_z(llm - 1)

      do l = 1, llm
         omega(l) = -w_mod_cas(l)*play(l)*rg/(rd*temp(l))
      end do

      d_t_dyn_z(:) = omega(:)*d_t_z(:)
      d_th_dyn_z(:) = omega(:)*d_th_z(:)
      d_q_dyn_z(:) = omega(:)*d_q_z(:)
      d_u_dyn_z(:) = omega(:)*d_u_z(:)
      d_v_dyn_z(:) = omega(:)*d_v_z(:)

!geostrophic wind
      if (forc_geo .eq. 1) then
         do l = 1, llm
            ug(l) = ug_mod_cas(l)
            vg(l) = vg_mod_cas(l)
         end do
      end if

      do l = 1, llm

         omega(l) = omega_mod_cas(l)
         omega2(l) = omega_mod_cas(l)/rg*airefi ! flxmass_w calcule comme ds physiq

         d_t_adv(l) = dt_mod_cas(l) + ht_mod_cas(l) + vt_mod_cas(l)
         d_q_adv(l, 1) = dq_mod_cas(l) + hq_mod_cas(l) + vq_mod_cas(l)
         ! Note here that we do not consider advection of other water species than vapor (second index >1)
         d_u_adv(l) = du_mod_cas(l) + hu_mod_cas(l) + vu_mod_cas(l)
         d_v_adv(l) = dv_mod_cas(l) + hv_mod_cas(l) + vv_mod_cas(l)

         if (trad .eq. 1) then
            tend_rayo = 1
            dt_cooling(l) = dtrad_mod_cas(l)
         else
            dt_cooling(l) = 0.0
         end if
      end do

      IF (ok_flux_surf) THEN
         fsens = -1.*sens_prof_cas
         flat = -1.*lat_prof_cas
      END IF

      IF (ok_prescr_ust) THEN
         ust = ustar_prof_cas
      END IF
!---------------------------------------------------------------------
!  Geopotential :
!---------------------------------------------------------------------
      phis(1) = zsurf*RG

      ! 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))
      end do

!---------------------------------------------------------------------
!  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
         END IF

         ! calculation of potential temperature for the advection
         teta = temp*(pzero/play)**rkappa

         ! vertical tendencies computed as d X / d t = -W  d X / d z

         IF (iflag_1d_vert_adv .EQ. 0) THEN

            ! old centered numerical scheme
            do l = 2, llm - 1
               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, :) = -w_adv(l)*(q(l + 1, :) - q(l - 1, :))/(z_adv(l + 1) - z_adv(l - 1))
            end do

         ELSE IF (iflag_1d_vert_adv .EQ. 1) THEN
            ! upstream numerical scheme

            do l = 2, llm - 1
               IF (((forc_w .EQ. 1) .AND. (w_adv(l) .GT. 0.)) .OR. &
                   ((forc_w .NE. 1) .AND. (w_adv(l) .LT. 0.))) THEN
                  d_u_vert_adv(l) = -w_adv(l)*(u(l) - u(l - 1))/(z_adv(l) - z_adv(l - 1))
                  d_v_vert_adv(l) = -w_adv(l)*(v(l) - v(l - 1))/(z_adv(l) - 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) - teta(l - 1))/(z_adv(l) - z_adv(l - 1))/(pzero/play(l))**rkappa
                  d_q_vert_adv(l, :) = -w_adv(l)*(q(l, :) - q(l - 1, :))/(z_adv(l) - z_adv(l - 1))
               ELSE
                  d_u_vert_adv(l) = -w_adv(l)*(u(l + 1) - u(l))/(z_adv(l + 1) - z_adv(l))
                  d_v_vert_adv(l) = -w_adv(l)*(v(l + 1) - v(l))/(z_adv(l + 1) - z_adv(l))
                  ! 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))/(z_adv(l + 1) - z_adv(l))/(pzero/play(l))**rkappa
                  d_q_vert_adv(l, :) = -w_adv(l)*(q(l + 1, :) - q(l, :))/(z_adv(l + 1) - z_adv(l))
               END IF
            end do

         END IF ! numerical scheme for vertical advection

         IF (flag_inhib_forcing == 0) then ! if tendency of forcings should be added
            u(1:mxcalc) = u(1:mxcalc) + timestep*d_u_vert_adv(1:mxcalc)
            v(1:mxcalc) = v(1:mxcalc) + timestep*d_v_vert_adv(1:mxcalc)
            q(1:mxcalc, :) = q(1:mxcalc, :) + timestep*d_q_vert_adv(1:mxcalc, :)
            temp(1:mxcalc) = temp(1:mxcalc) + timestep*d_t_vert_adv(1:mxcalc)
            teta = temp*(pzero/play)**rkappa
         END IF

      END IF

!---------------------------------------------------------------------
! Listing output for debug prt_level>=1
!---------------------------------------------------------------------
      if (prt_level >= 1) then
         print *, ' before physiq : -------- day time ', day, time
         write (*, *) 'firstcall,lastcall,phis',                               &
     &               firstcall, lastcall, phis
      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
!---------------------------------------------------------------------
! Geostrophic forcing
!---------------------------------------------------------------------

      fcoriolis = 2.*sin(rpi*xlat/180.)*romega

      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)))
         d_v_age(1:mxcalc) = -2.*sfdt/timestep*                                 &
       &          (cfdt*(u(1:mxcalc) - ug(1:mxcalc)) +                           &
       &           sfdt*(v(1:mxcalc) - vg(1:mxcalc)))
      END IF
!---------------------------------------------------------------------
!  Nudging
!---------------------------------------------------------------------
      d_t_nudge(:) = 0.
      d_u_nudge(:) = 0.
      d_v_nudge(:) = 0.
      d_q_nudge(:, :) = 0.

      DO l = 1, llm

         IF (nudging_u .LT. 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

         END IF

         IF (nudging_v .LT. 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

         END IF

         IF (nudging_t .LT. 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

         END IF

         IF (nudging_qv .LT. 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

         END IF

      END DO

!-----------------------------------------------------------
! horizontal forcings (advection) and nudging
!-----------------------------------------------------------

      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, :))

         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))

!---------------------------------------------------------------------
!  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

         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)
         END IF

      END IF

!---------------------------------------------------------------------
!   Air temperature :
!---------------------------------------------------------------------
      if (lastcall) then
         print *, 'final time step ', it
         call ju2ymds(daytime, an, mois, jour, heure)
         print *, 'at date : y m d h', an, mois, jour, heure/3600.
      end if

!  incremente day time
      daytime = daytime + 1./day_step
      day = int(daytime + 0.1/day_step)
      time = time_ini/24.+real(mod(it, day_step))/day_step
      it = it + 1

   end do

! --------------------------------------------------------------------------   
! Call to 1D equivalent of dynredem 
! ---------------------------------------------------------------------------
   call dyn1dredem("restart1dyn.nc",                                    &
 &              plev, play, phi, phis, presnivs,                            &
 &              u, v, temp, q, omega2)

   CALL abort_gcm('lmdz1d   ', 'The End  ', 0)

END SUBROUTINE scm
