SUBROUTINE CNT4

USE PARKIND1  ,ONLY : JPIM, JPIB, JPRB
USE YOMHOOK   ,ONLY : LHOOK    ,DR_HOOK

USE YEMDIM   , ONLY : LECOBI
USE YOMLUN   , ONLY : NULOUT   ,NULFPOS  ,NULERR
USE YOMCT0   , ONLY : LNHDYN   ,CFPNCF   ,LFPART2  ,NCONF    ,NSTOP    ,&
 & NFRPOS   ,NFRISP   ,NFRHIS   ,NFSRHIS  ,NFRGDI   ,NFRSDI   ,&
 & NFRDHFG  ,NFRDHFZ  ,NFRDHFD  ,NFRDHP   ,NFRCO    ,&
 & NPROC    ,NPRINTLEV,NFRMASSCON,LFDBOP   ,&
 & LSMSSIG  ,LTWOTL   ,LFPOS    ,LIFSMIN  ,&
 & LOBSC1   ,LOBSREF  ,LELAM    ,LNF      ,&
 & LSITRIC  ,LPC_FULL ,&
 & LWRTCFOU ,LSLAG    ,LOBS    ,NFRCORM, LIFSTRAJ, LCOUPLO4_ENV
USE YOMCT2   , ONLY : NSTAR2   ,NSTOP2
USE YOMCT3   , ONLY : NSTEP
USE YOMVAR   , ONLY : NSIMU    ,NSIM4D   ,NFRREF   ,NFRANA   ,&
 & NFRGRA   ,NSIM4DL  ,LTWANA  ,LAVARC   ,LMODERR  , NUPTRA, MUPTRA , LJCDFI
USE YOMDYN   , ONLY : TSTEP    ,TDT      ,NSITER   ,LSTRHD   ,LSIDG    ,&
 & NCURRENT_ITER,LRHDI_LASTITERPC
USE YOMLDDH  , ONLY : LSDDH    ,LHDOUFG  ,LHDOUFZ  ,LHDOUFD  ,LHDOUP
USE YOMCFU   , ONLY : NFRCFU   ,LCUMFU   ,LREACFU
USE YOMXFU   , ONLY : NFRXFU   ,LXFU     ,LRESET   ,LREAXFU  ,NFRRAZ
USE YOMRES   , ONLY : NFRRES
USE YOEPHY   , ONLY : LEPHYS   ,LAGPHY
USE YOMCHK   , ONLY : LECHKEVO ,NFRQCHK
USE YOMPHY   , ONLY : LMPHYS   ,LRAYFM   ,LRAYFM15
USE YOMINI   , ONLY : NEINI    ,LSCRINI
USE YOMFPC   , ONLY : NFPINCR
USE YOMFPCT0 , ONLY : NFPCT0   ,FPINCR
USE YOMMCC   , ONLY : LMCC03   ,LMCC04   ,LMCC05   ,NFRCPL, NOACOMM
USE YOMMP    , ONLY : MYPROC   ,NOUTTYPE
USE YOMIO    , ONLY : LPPTSF
USE YOMOP    , ONLY : LINC
USE YOEWCOU  , ONLY : NSTPW    ,LWCOU
USE STOPH_MIX, ONLY : LSTOPH   ,LSTOPH_SPBS, LSTOPH_CASBS
USE YOMTIM   , ONLY : RSTART   ,RVSTART  ,RTIMEF
USE YOMVRTL  , ONLY : L131TL   ,LOBSTL
USE YOMOMPDIST , ONLY : GPP
USE YOMTLEVOL, ONLY : LTLEVOL
USE YOMSEP   , ONLY : LFINDVSEP,NVSEPC   ,NVSEPL   
USE YEMCT0   , ONLY : NFRLSG
USE YOMXFUB  , ONLY : XFUBUF
USE YOMGFUB  , ONLY : GFUBUF
USE MPL_MODULE, ONLY: MPL_BARRIER
USE YOMECTAB , ONLY : NTSLOTNO ,NTSLOTNOS
USE YOMSP    , ONLY : SPA3, SPD2D, SPSP, SPA1
USE TRAJECTORY_MOD, ONLY: LTRAJGP, LTRAJHR,LTRAJHR_ALTI, &
 & LREADGPTRAJ, LTRAJSAVE, &
 & GET_TRAJ_SPEC, READ_TRAJECTORY
USE YOMSIG   , ONLY : RESTART
USE YOMMODEL_ERROR,ONLY: NTYPE_MODERR, NDIM_MODERR, MSTEPERR, NPRTMODERR, &
                    & SPMODERR, GPMODERR, NPERIOD_4DVAR
USE SPECTRAL_FIELDS_MOD
USE YOMHCP   , ONLY : NHECP
USE YOMJQ    , ONLY : LSTATMERR
USE YOMDFI   , ONLY : NSTDFI, NOFFSETDFI
USE YOMJCDFI , ONLY : NSUBDFI
USE YOMVAREPS, ONLY : LVAREPS, L_INC_HDIF, NST_HDIF_INI
USE IOSTREAM_MIX  , ONLY : FLUSH_IOSTREAM, Y_IOSTREAM_FDB
USE YOMCHET  , ONLY : GCHETN
USE YOMMCUF  , ONLY : LMCUF
USE YOMGFL   , ONLY : GFL
USE YOM_YGFL , ONLY : YGFL     ,YGFLC 
USE YOMPPC   , ONLY : LMOVPH
USE YOMGLOBS , ONLY : LPREMPOBS
USE YEMJK    , ONLY : LEJK
USE YOMMASS  , ONLY : LMASDRY, LMASCOR, GMASSINC
USE YOMGRB   , ONLY : NGRBQ
USE GMV_SUBS_MOD

USE YOMECEARTH, ONLY: LECEARTH, LECEARTH_UNCOUP, LTM5, LLPJG 
USE CPLNG

!**** *CNT4*  - Controls integration job at level 4

!     Purpose.
!     --------
!     CONTROLS THE INTEGRATION

!**   Interface.
!     ----------
!        *CALL* *CNT4

!        Explicit arguments :
!        --------------------
!        None

!        Implicit arguments :
!        --------------------
!        None

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!        Called by CNT3.

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

! Modifications
! -------------
!   Original : 87-10-15
!   =15-01-91= DDH diagnostics output control , Alain Joly
!   =04-08-91= Rationalisation of calls to STEPO Philippe Courtier
!   =25-05-92= Coupled fields output control , Christine Dreveton
!   =15-09-92= Calls to Remark2, Ryad El Khatib
!   =92-11-27  Comparison to observations , J.N. thepaut
!   08/03/1993 Additional horizontal diffusion on not stretched sphere
!              (K. YESSAD).
!   =24-12-92= Gridpoint evolution diagnostics, Gabor Radnoti
!   Modified by K. YESSAD    : OCTOBER 1993. Semi-implicit scheme with
!                              not reduced divergence.
!   =27-10-93= Addition of SMS messages (D. Dent)
!   =27-10-93= Only one Fourier file (M. Hamrud)
!   =10-03-94= Full-POS implementation (R. El Khatib)
!   =27-10-94= cleaning (jn. T.)
!   K. YESSAD (APRIL 1994): Unified horizontal diffusion scheme.
!   Modified by C. Temperton 95-02-06: two-time-level scheme
!   =20-02-95= Frequency of gridpoint diagnostics, PLM and DG
!   =12-04-95= Moving gridpoint diagnostics, DG
!   Modified by T. Stockdale 95-08-25: send ifs fluxes to ocean
!   Modified by M. HAMRUD 95-02-06: New form of CLCONF
!   K. YESSAD (NOV 1995): removal of HDC horizontal diffusion scheme.
!   96-03-08 JJ Morcrette Reorganization call intermittent radiation
!   96-04-26 T Stockdale: Moved call to WRCOE for OASIS2
!   96-05-16 M. Hortal: Filtering of post-proc. geopot. in linear grid
!   Modified by C. Temperton 96-05-16: new semi-implicit solver
!   D. GIARD  (MAY 1996): initial instantaneous fluxes
!   M. TOLSTYKH  (OCT 1996): Fourier space horizontal diffusion
!   M. DEQUE     (MAY 1997): Frozen FMR
!   96-12-09 M.Janiskova: Transmission coefficients for simpl.rad.sch.
!   B. HANSEN    (APR 1997): Restart behaviour and wam coupling.
!   C. Temperton 97-02-24: modified first timestep when XIDT>0
!   R. El Khatib : 98-04-22 call to SUALSPA moved inside RDSPEC
!   R Buizza and L Isaksen 97-11-20:  Stochastic diabatic forcing
!   R. El Khatib : 98-07-02 Write model time and program clock on stderr
!   T. Bergot    98-08   : conf 601 and HISTS
!   C. Temperton 99-08-16: removed redundant RKROMA
!   M. Zitouni : 99-02-15 ECHKEVOSM/ECHKEVODM
!   Modified 99-02-17 by K. YESSAD: options LRETCFOU, LWRTCFOU.
!   R. El Khatib : 99-03-09 Simplify fullpos control
!   C. Soci:00-04-05 add array for large scale gradient timesteps managing
!   C. Temperton 00-02-10: NVSEP (used in adjoint of semi-Lagrangian)
!   C. Temperton 00-06-15: NVSEP -> NVSEPC,NVSEPL.
!   D. Giard : 00-07-11 screening during digital filter finalisation
!   R. El Khatib : 00-07-27
!    - fullpos aux. gp fields computed once for all in gridfpos
!   D. Giard : 00-08-24 unification of chkevo
!   Y. Tremolet  00-08-09: use module TRAJECTORY
!   D.Dent       00-09-01 : MPE to MPL conversion
!   C. Temperton 01-01-23: bugfix for NCONF=601,801 and LSLAG=.T.
!   D.Salmond (15-10-01) FULLIMP mods
!   R. El Khatib  01-07-11 : use LNF to fix restart
!   R. El Khatib : 01-08-07 Pruning options
!   R. El Khatib : 02-01-17 Fix to initialize E-zone in CFU buffers
!   J.Vivoda (03-2002) PC schemes for NH dynamics (LPC_XXXX keys)
!   V.Guidard&C.Fischer: 02-09-30 3dfgat coupling switched on
!   P.Smolikova 02-09-30 : GPPAUX for d4 in NH
!   A.Bogatchev 03-04-06 : Phasing to CY26
!   R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!   R. El Khatib : 03-04-17 Fullpos improvments
!   01-Oct-2003 M. Hamrud           CY28 Cleaning
!               F. Vana, K. YESSAD  diffusion for SLHD + cleanings.
!   09-Jun-2004 J. Masek            NH cleaning (LPC_NOTR, LFULLIMP)
!   30-Jun-2004 K. Yessad  Simplification of PC scheme.
!   01-Sep-2004 P. Termonia call to SPMCUF
!   T. Kovacic    04-03-01 Diagnostics on physical tendencies
!   M.Hamrud      01-Oct-2003 CY28 Cleaning
!   Y.Tremolet    18-Mar-2004 Model error changes
!   R Buizza      09-Mar-2005 Add call to SUHDFVAREPS to run with variable hor-diff in VAREPS
!   R. El Khatib : 05-02-21 specific frequency array to reset instant. fluxes
!   V.Guidard & C.Fischer: 01-Apr-2004 Jk event: call to EVARJKINI 
!   K. Yessad     08-Feb-2005 SI scheme for ARPEGE NH model
!   K. Yessad     21-Apr-2005 cleanings for SPNORM-printings.
!   G. Desroziers and K. Yessad (sept 2005):
!    - split option LTRAJHR into LTRAJHR_ALTI and LTRAJHR_SURF.
!    - adapt option LTRAJHR to METEO-FRANCE configurations.
!   A. Alias     : Jul-2005 GMGEC/EAC modifs.
!                Modification in coupling calls (NFRCPL instead of NFRCO)
!                M. Deque 05-07   Introduction of CORMASS2
!   J.Berner     07-09-2006 new stochastic physics update 
!   M. Drusch     17-Jan-2007 introduce nconf = 302
!   A. Alias     : Mar-2007 Mass Correction in ALADIN : CORMASS3B (M.Deque)
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!   Y. Seity     : 11-Jan-2008 add CDCONF(1:1)='S' for surfex output files 
!   Y.Tremolet    17-Nov-2008 Jc-DFI diagnostics in outer loop
!   F. Vana   13-Jan-2009 removed special set up of specHD when SLHD
!   T. van Noije Jan-2014 Included option for coupling to TM5 (for EC-Earth)
! End Modifications
!----------------------------------------------------------------

IMPLICIT NONE

CHARACTER (LEN = 20) ::  CLSETEV
CHARACTER (LEN = 9) ::  CLCONF
CHARACTER (LEN = 51) ::  CLDAYF
CHARACTER (LEN = 20) ::  CLCOMMAND
CHARACTER (LEN = 10) ::  CLTIMEOD,CLDAT(3)
CHARACTER (LEN = 256) ::  CLSMSNAME

CHARACTER (LEN = 7) ::  CL_CPENV
PARAMETER ( CL_CPENV = "SMSNAME" )

INTEGER(KIND=JPIM) :: IACTIM, ICPLEN, IFILE, IHOUR, IINC, ILAG,&
 & IAVARE, IMIN, IOUTTYPE, IPPTR, ISTEP, &
 & ISTOP, J, JSTEP, JSITER, JJ, JGFL, iweak, idiglst, ipersub, isub
INTEGER(KIND=JPIB) :: ITIME

LOGICAL :: LL2D, LLCFU, LLCOLA,&
 & LLECH, LLECRAD, LLFDBOP, &
 & LLMLPP, LLSMLPP, LLOVER, LLPISP, &
 & LLPLPP, LLRQCFU, LLRQXFU, LLSLOT, &
 & LLSPNRM, LLGPNRM, LLSTOP, LLSTRC, LLWRRC, LLWRRE, &
 & LLWRRW, LLWRTRA, LLWVTIME, LLXFU, LLFPOS, LLOBSC1, &
 & LLTLEVOL,LLASTRAJ,llevs,LLAGHIS, LLMASCOR

REAL(KIND=JPRB) :: ZCT, ZSEC, ZT1, ZT2, ZVT, ZWT

! - IVALUES: array containing configurations of WRTRA to SPC
!   1 : configuration of WRTRA      write the trajectory
!   2 : configuration of LTINV      inverse Legendre transform
!   3 : configuration of FTINV      inverse Fourier transform
!   4 : configuration of GPC        grid point computations
!   5 : configuration of POS        post processing
!   6 : configuration of OBS        comparison to observations
!   7 : configuration of FTDIR      direct Fourier transform
!   8 : configuration of LTDIR      direct Legendre transform
!   9 : configuration of SPC        spectral space computations
INTEGER(KIND=JPIM) :: IVALUES(9)

! - IPOSTS : ARRAY CONTAINING POST-PROCESSING TIME STEPS
INTEGER(KIND=JPIM) :: IPOSTS(0:NSTOP/NFRPOS)
! - IPISPS : ARRAY CONTAINING ISP (Animation !) TIME STEPS
INTEGER(KIND=JPIM) :: IPISPS(0:NSTOP/NFRISP)
! - IHISTS : ARRAY CONTAINING TRAJECTORY TIME STEPS
INTEGER(KIND=JPIM) :: IHISTS(0:NSTOP/NFRHIS)
! - ISHISTS : ARRAY CONTAINING TRAJECTORY TIME STEPS FOR SURFACE
INTEGER(KIND=JPIM) :: ISHISTS(0:NSTOP/NFSRHIS)
! - IMASSCONS: ARRAY CONTAINING mass conservation fixup time steps
INTEGER(KIND=JPIM) :: IMASSCONS(0:NSTOP/NFRMASSCON)
! - IRESTS : ARRAY CONTAINING RESTART TIME STEPS
INTEGER(KIND=JPIM) :: IRESTS(0:NSTOP/NFRRES)
! - IGDITS : GRID POINT DIAGNOSTICS TIME STEPS
INTEGER(KIND=JPIM) :: IGDITS(0:NSTOP/MAX(1,NFRGDI))
! - ISDITS : SPECTRAL DIAGNOSTICS TIME STEPS
INTEGER(KIND=JPIM) :: ISDITS(0:NSTOP/MAX(1,NFRSDI))
! - IDHFGTS : WRITE OUT TIME STEPS FOR GLOBAL MEANS DDH
INTEGER(KIND=JPIM) :: IDHFGTS(0:NSTOP/NFRDHFG)
! - IDHFZTS : WRITE OUT TIME STEPS FOR ZONAL MEANS DDH
INTEGER(KIND=JPIM) :: IDHFZTS(0:NSTOP/NFRDHFZ)
! - IDHFDTS : WRITE OUT TIME STEPS FOR LIMITED AREAS DDH
INTEGER(KIND=JPIM) :: IDHFDTS(0:NSTOP/NFRDHFD)
! - IDHPTS : PAS DE TEMPS DE SORTIES IMPRIMEES DES DDH
INTEGER(KIND=JPIM) :: IDHPTS(0:NSTOP/NFRDHP)
! - ICFUTS : CONTROLS ACCUMULATED FLUX WRITE-UP
INTEGER(KIND=JPIM) :: ICFUTS(0:NSTOP/NFRCFU)
! - IXFUTS : CONTROLS INSTANTANEOUS FLUX WRITE-UP
INTEGER(KIND=JPIM) :: IXFUTS(0:NSTOP/NFRXFU)
! - IRAZTS : CONTROLS INSTANTANEOUS FLUX RESET
INTEGER(KIND=JPIM) :: IRAZTS(0:NSTOP/NFRRAZ)
! - IANATS : ARRAY CONTAINING ITERATIONS FOR WHICH THE ANALYSIS
INTEGER(KIND=JPIM) :: IANATS(0:NSIM4DL/NFRANA)
INTEGER(KIND=JPIM) :: IGRATS(0:NSIM4DL/NFRGRA)
INTEGER(KIND=JPIM) :: IREFTS(0:NSTOP/NFRREF)
INTEGER(KIND=JPIM) :: IHECPS(0:NSTOP)
! - ILSGTS : ARRAY CONTAINING LSG TIMESTEPS
INTEGER(KIND=JPIM) :: ILSGTS(0:NSTOP/NFRLSG)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "user_clock.h"
END INTERFACE

#include "abor1.intfb.h"
#include "save_merr_tend.intfb.h"
#include "avarct.intfb.h"
#include "chkobtim.intfb.h"
#include "cprep4.intfb.h"
#include "cormass2.intfb.h"
#include "cormass3b.intfb.h"
#include "cormassdry.intfb.h"
#include "dealmod.intfb.h"
#include "digfil.intfb.h"
#include "dynfpos.intfb.h"
#include "chkevo.intfb.h"
#include "ecradfr.intfb.h"
#include "ecradfr15.intfb.h"
#include "elsrw.intfb.h"
#include "evarjkini.intfb.h"
#include "ewmovph.intfb.h"
#include "gpnorm_gfl.intfb.h"
#include "gridfpos.intfb.h"
#include "moevar.intfb.h"
#include "monio.intfb.h"
#include "monvar.intfb.h"
#include "obsv.intfb.h"
#include "ppclose.intfb.h"
#include "ppflush.intfb.h"
#include "post_obshor.intfb.h"
#include "rdspec.intfb.h"
#include "reset_accfie_vareps.intfb.h"
#include "sigcheck.intfb.h"
#include "spnorm.intfb.h"
#include "stepo.intfb.h"
#include "su4fpos.intfb.h"
#include "suallavt.intfb.h"
#include "sualspa.intfb.h"
#include "sucpl0.intfb.h"
#include "suhdfvareps.intfb.h"
#include "suhdu.intfb.h"
#include "suheg.intfb.h"
#include "suinif.intfb.h"
#include "sunhsi.intfb.h"
#include "surand2.intfb.h"
#include "sutric.intfb.h"
#include "updobs.intfb.h"
#include "updtim.intfb.h"
#include "wmovph.intfb.h"
#include "wrcfupp.intfb.h"
#include "wrcoe.intfb.h"
#include "wrcom.intfb.h"
#include "wrcpl.intfb.h"
#include "writechet.intfb.h"
#include "wrspec.intfb.h"
#include "wrxfupp.intfb.h"
#include "wvcouple.intfb.h"
#include "spmcuf.intfb.h"
#include "gridpoint_norm.intfb.h"
#include "couplo4_definitions.intfb.h"
#include "add_moderr_tl.intfb.h"
#include "weak_constraint.intfb.h"
#include "save4next.intfb.h"
!      ----------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CNT4',0,ZHOOK_HANDLE)

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

!*    1.    Initialize
!           ----------

WRITE(NULOUT,*)'START CNT4, NSIM4D=',NSIM4D

CALL GSTATS(1845,0)
IF(MYPROC==1.AND.LSMSSIG)CALL SIGMASTER()
CALL GSTATS(1845,1)

IF(NCONF/100 == 2.OR.&
   & NCONF/10 == 42.OR.&
   & NCONF/10 == 52) THEN  
  LL2D=.TRUE.
ELSE
  LL2D=.FALSE.
ENDIF
LLSTOP = .FALSE.
LLWRRE = .FALSE.
LLWRRC = .FALSE.
LLWRRW = .FALSE.
LLSTRC = .NOT. LWCOU
LLTLEVOL = (NCONF/100 == 5.AND.LTLEVOL)
LLOBSC1= LOBSC1 .AND. .NOT.LSCRINI

!*       1.2   Initial instantaneous fluxes.
!              -----------------------------

LLECRAD=LEPHYS.OR.(LMPHYS.AND.LRAYFM)
IF (LXFU.AND.(NCONF == 1.OR.NCONF == 302).AND.NSTOP > 0 .AND. LNF) THEN
  TDT=TSTEP
  NSTEP=0
  CALL UPDTIM(0,TDT,TSTEP,.FALSE.)
  IF(LLECRAD) CALL ECRADFR
  IF(LMPHYS.AND.LRAYFM15) THEN
    CALL ECRADFR15
  ENDIF
  CLCONF(1:9)='0AAX00000'
  RESTART=CLCONF(1:1)
  CALL WRSPEC
  XFUBUF%GPBUF(:)=0.0_JPRB ! at least to fill the extension zone
                           ! (specific to aladin)
  XFUBUF%LFILLED=.TRUE.
  CALL STEPO(CLCONF)
  CALL RDSPEC(LFPOS)
ENDIF
IF (LCUMFU.AND.(NCONF == 1.OR.NCONF == 302).AND.NSTOP > 0 .AND. LNF) THEN
  GFUBUF%GPBUF(:)=0.0_JPRB
  GFUBUF%LFILLED=.TRUE.
ENDIF

!*       1.3   Reset to 0 coupled fields

IF(NFRCPL > 0.AND.NFRCPL <= NSTOP) THEN
   CALL SUCPL0
ENDIF

!*       1.5   Lagged/not lagged physics outputs

LLAGHIS=(.NOT.LAGPHY).AND.(LMPHYS.OR.LEPHYS).AND.(NSTOP > 0)
   
!      ----------------------------------------------------------------

!*    2.       Prepare occurences of I/O events.
!           ---------------------------------

CALL MONIO(IPOSTS,IPISPS,IHISTS,ISHISTS,IGDITS,ISDITS,IDHFGTS,IDHFZTS,&
 & IDHFDTS,IDHPTS,ICFUTS,IXFUTS,IRESTS,IMASSCONS,IRAZTS)
CALL MONVAR(IREFTS,IANATS,IGRATS,IHECPS)
IF (LELAM) THEN
  CALL MOEVAR(ILSGTS)
ENDIF

IF (NPRINTLEV >= 1) THEN
  WRITE(NULOUT,'('' POST-PROCESSING EVENTS, IPOSTS '')')
  WRITE(NULOUT,'(40I2)')IPOSTS
  WRITE(NULOUT,'('' ISP (Animation !) EVENTS, IPISPS '')')
  WRITE(NULOUT,'(40I2)')IPISPS
  WRITE(NULOUT,'('' HISTORY WRITE-UP, IHISTS '')')
  WRITE(NULOUT,'(40I2)')IHISTS
  WRITE(NULOUT,'('' HISTORY SURFACE WRITE-UP, ISHISTS '')')
  WRITE(NULOUT,'(40I2)')ISHISTS
  WRITE(NULOUT,'('' MASS CONSERVATION FIXUP, IMASSCONS '')')
  WRITE(NULOUT,'(40I2)')IMASSCONS
  WRITE(NULOUT,'('' RESTART WRITE-UP, IRESTS '')')
  WRITE(NULOUT,'(40I2)')(IRESTS(J),J=0,NSTOP/NFRRES)
  WRITE(NULOUT,'('' SPECTRUM, ISDITS '')')
  WRITE(NULOUT,'(40I2)')ISDITS
  WRITE(NULOUT,'('' AVARC EVENTS    , IHECPS '')')
  WRITE(NULOUT,'(40I2)')IHECPS
  IF(NCONF == 1.OR.NCONF == 302) THEN
    WRITE(NULOUT,'('' IDHFGTS '')')
    WRITE(NULOUT,'(40I2)')IDHFGTS
    WRITE(NULOUT,'('' IDHFZTS '')')
    WRITE(NULOUT,'(40I2)')IDHFZTS
    WRITE(NULOUT,'('' IDHFDTS '')')
    WRITE(NULOUT,'(40I2)')IDHFDTS
    WRITE(NULOUT,'('' IDHPTS '')')
    WRITE(NULOUT,'(40I2)')IDHPTS
    WRITE(NULOUT,'('' ICFUTS '')')
    WRITE(NULOUT,'(40I2)')ICFUTS
    WRITE(NULOUT,'('' IXFUTS '')')
    WRITE(NULOUT,'(40I2)')IXFUTS
    WRITE(NULOUT,'('' IRAZTS '')')
    WRITE(NULOUT,'(40I2)')IRAZTS
  ENDIF
  WRITE(NULOUT,'('' AN WRITE-OUT EVENTS, IANATS '')')
  WRITE(NULOUT,'(40I2)') (IANATS(J),J=0,NSIMU/NFRANA)
ENDIF
LLWRTRA=.NOT.(NCONF/100 == 0.OR.NCONF/100 == 2.OR.NCONF == 302)
IACTIM=1


IF (LCOUPLO4_ENV) THEN

 CALL COUPLO4_DEFINITIONS 

ENDIF

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

!*    3.       Direct integration.
!              -------------------

!*       3.1   Main temporal loop

CALL GSTATS(737,0)
IF(NPROC > 1) THEN
  CALL MPL_BARRIER(CDSTRING='CNT4:')
ENDIF
CALL GSTATS(737,1)
CALL GSTATS(1,0)

IF(NSTOP2 == NSTOP)THEN
! For final time step (diagnostics, post-processing)
  ISTOP=NSTOP
ELSE
  ISTOP=NSTOP2-1
ENDIF

IF ((IHISTS(ISTOP/NFRHIS) == 1.AND.MOD(ISTOP,NFRHIS) == 0).AND.LLAGHIS) THEN
  ILAG=1
ELSE
  ILAG=0
ENDIF

IF(LAVARC.AND.LLWRTRA) THEN
!* allocate trajectory-reference spectral field for avarc
  CALL SUALLAVT(NULOUT)
  IAVARE = 1
ENDIF

IF (LSLAG.AND.(NCONF == 131.OR.NCONF == 401.OR.NCONF == 601&
   & .OR.NCONF == 801)) THEN  
  LFINDVSEP=.TRUE.
ELSE
  LFINDVSEP=.FALSE.
ENDIF

DO JSTEP=NSTAR2,ISTOP

  CALL USER_CLOCK(PTOTAL_CP=ZT1)

!        3.1.1  Time filtering constraint based on digital filter
!               is being computed.

  IF (LJCDFI.AND.NCONF==1) THEN
    isub=1
!   Step should be local to subwindow
    IF (NSUBDFI>1) THEN
      ipersub=NSTOP/NSUBDFI
      istep=MOD(jstep,ipersub)
      isub=jstep/ipersub+1
!     Add final contribution to previous subwindow if needed
      IF (istep==0.AND.isub>1) THEN
        WRITE(NULOUT,*)'CNT4: Calling DIGFIL, jstep,istep=',jstep,ipersub,isub-1
        CALL DIGFIL(ipersub, IDIGLST, isub-1, SPA3, SPD2D, SPA1, .TRUE.)
      ENDIF
    ELSE
      istep=JSTEP-NOFFSETDFI
    ENDIF
    IDIGLST=2*NSTDFI
    IF (istep>=0 .and. istep<=IDIGLST .and. isub<=NSUBDFI) THEN
      IF (NSUBDFI>1) WRITE(NULOUT,*)'CNT4: Calling DIGFIL, jstep,istep=',jstep,istep,isub
      CALL DIGFIL(istep, IDIGLST, isub, SPA3, SPD2D, SPA1, .TRUE.)
    ENDIF
  ENDIF

!*       3.2   Current value of the time step length

  IF(JSTEP == 0.OR.LTWOTL)THEN
    TDT=TSTEP
  ELSE
    TDT=2.0_JPRB*TSTEP
  ENDIF

!*       3.3   Reset of time dependant constants
!              (clock,astronomy,climatology...)
!              and send atmospheric fluxes to the ocean (if coupling)

 IF(NFRCPL > 0.AND.NFRCPL <= NSTOP) THEN

   IF(MOD(JSTEP,NFRCPL) == 0) THEN
     IF(LMCC03) THEN
       CALL WRCPL
     ENDIF
   ENDIF

   IF(JSTEP == ISTOP+ILAG) THEN
     IF(LMCC05) THEN
       CALL WRCOM
     ENDIF
   ENDIF

 ENDIF

  IF(NFRCORM /= 0 .AND. .NOT.LELAM) THEN
    IF(JSTEP /= 0.AND.NFRCORM > 0.AND.(MOD(JSTEP,NFRCORM) == 0)) THEN
      CALL CORMASS2
    ENDIF
    IF(JSTEP /= 0.AND.NFRCORM < 0.AND.(MOD(JSTEP*TSTEP,ABS(NFRCORM)*3600._JPRB) == 0)) THEN
      CALL CORMASS2
    ENDIF
  ENDIF
  IF(NFRCORM /= 0 .AND. LELAM) THEN
    IF(JSTEP /= 0.AND.NFRCORM > 0.AND.(MOD(JSTEP,NFRCORM) == 0)) THEN
      CALL CORMASS3B
    ENDIF
    IF(JSTEP /= 0.AND.NFRCORM < 0.AND.(MOD(JSTEP*TSTEP,ABS(NFRCORM)*3600._JPRB) == 0)) THEN
      CALL CORMASS3B
    ENDIF
  ENDIF

  CALL UPDTIM(JSTEP,TDT,TSTEP,.TRUE.)

!       3.3.1 Re-define HDIFF coefficient if it is a VAREPS
!             integration (LVAREPS) with a changing hor-diffusion
!             during the last forecast steps (after NST_HDIF_INI)

  IF (LVAREPS.AND.L_INC_HDIF.AND.(JSTEP >= NST_HDIF_INI)) THEN
    CALL SUHDFVAREPS (JSTEP)
  ENDIF

!*       3.4   Reset semi-implicit solver in the multilevel model, and the
!              additional horizontal diffusion operator.

  IF (NSTOP > 0.OR.NEINI /= 0) THEN
    IF (.NOT.LELAM) THEN

      ! * SI scheme:
      IF (LNHDYN) THEN
        CALL SUNHSI(NULOUT,.FALSE.)
      ELSE
        IF (LSIDG) THEN
          CALL SUHEG
        ENDIF
        IF (LSITRIC.AND.(JSTEP == NSTAR2.OR.(JSTEP == 1.AND..NOT.LTWOTL))) THEN
          CALL SUTRIC
        ENDIF
      ENDIF

      ! * HD scheme:
      IF (LSTRHD) THEN
        ! * This call to SUHDU actually does something in a leap-frog scheme if
        !   TDT=2*TSTEP for the current jstep, and TDT=TSTEP for the previous
        !   one
        CALL SUHDU
      ENDIF

    ELSE

      ! * SI scheme:
      IF (LNHDYN .AND. (NSTOP > 0 .AND. .NOT.LFPART2)) THEN
        CALL SUNHSI(NULOUT,.FALSE.)
      ENDIF

    ENDIF
  ENDIF

!        3.5 Generate new random numbers for Stochastic Physics
!            if LSTOPH is true, and if it is a model integration
!            after time step 0 (or after initial step when restarted)

  IF ((LSTOPH.OR.LSTOPH_SPBS.OR.LSTOPH_CASBS) .AND. JSTEP > NSTAR2) THEN
    CALL SURAND2(JSTEP)
  ENDIF

!*       3.6   Reset YOMCT3

  IF (.NOT.LFPART2) THEN
    NSTEP=JSTEP
  ENDIF

! Forcing spectral fields with interpolated trajectory
  IF (LIFSMIN.AND.LTRAJHR.AND.LTRAJSAVE) THEN
    LLASTRAJ=.FALSE.
    CALL READ_TRAJECTORY(nstep,LLASTRAJ,LREADGPTRAJ)
!!!    LTRAJRESET=.false.
!   Recomputing SLAG and PHYS trajectories.
!   Using the fact that just after READ_TRAJECTORY, spectral traj is still
!   there even if LTRAJGP.
    CALL GSTATS(15,0)
    IF (LTRAJHR_ALTI) THEN
      IF (LTRAJGP) THEN
        CALL GET_TRAJ_SPEC(SPA3,SPSP,SPA1)
      ELSE
        CALL GET_TRAJ_SPEC(SPA3,SPSP,SPA1,KSTEP=NSTEP)
      ENDIF
    ENDIF
    CALL GSTATS(15,1)
  ENDIF

!*       3.7   Control of time events for lateral boundary fields

  IF(LELAM.AND.LECOBI.AND.(NSTOP /= 0.OR.NEINI /= 0)) THEN
    IF (NCONF/100 == 0.OR.NCONF/100 == 2.OR.NCONF == 801.OR.&
       & NCONF == 302.OR.&
       & NCONF == 501.OR.NCONF == 401.OR.&
       & ((NCONF/100 == 1).AND.(NSTOP>0)).OR.&
       & NCONF == 601) THEN  
      CALL ELSRW(.FALSE.)
    ENDIF
  ENDIF

!*       3.8 Reset time dependent variables

  LLSPNRM=ISDITS(JSTEP/MAX(1,NFRSDI)) == 1.AND.MOD(JSTEP,MAX(1,NFRSDI)) == 0
  LLGPNRM=IGDITS(JSTEP/MAX(1,NFRGDI)) == 1.AND.MOD(JSTEP,MAX(1,NFRGDI)) == 0
  LLCFU  =ICFUTS(JSTEP/NFRCFU) == 1.AND.MOD(JSTEP,NFRCFU) == 0
  LLXFU  =IXFUTS(JSTEP/NFRXFU) == 1.AND.MOD(JSTEP,NFRXFU) == 0
  LRESET =IRAZTS(JSTEP/NFRRAZ) == 1.AND.MOD(JSTEP,NFRRAZ) == 0
  LHDOUFG=IDHFGTS(JSTEP/NFRDHFG) == 1.AND.MOD(JSTEP,NFRDHFG) == 0
  LHDOUFZ=IDHFZTS(JSTEP/NFRDHFZ) == 1.AND.MOD(JSTEP,NFRDHFZ) == 0
  LHDOUFD=IDHFDTS(JSTEP/NFRDHFD) == 1.AND.MOD(JSTEP,NFRDHFD) == 0
  LHDOUP =IDHPTS(JSTEP/NFRDHP) == 1.AND.MOD(JSTEP,NFRDHP) == 0
  LLPLPP =IPOSTS(JSTEP/NFRPOS) == 1.AND.MOD(JSTEP,NFRPOS) == 0
  LLPISP =IPISPS(JSTEP/NFRISP) == 1.AND.MOD(JSTEP,NFRISP) == 0
  LLMLPP =IHISTS(JSTEP/NFRHIS) == 1.AND.MOD(JSTEP,NFRHIS) == 0
  LLSMLPP =ISHISTS(JSTEP/NFSRHIS) == 1.AND.MOD(JSTEP,NFSRHIS) == 0
  LLMASCOR=IMASSCONS(JSTEP/NFRMASSCON) == 1.AND.MOD(JSTEP,NFRMASSCON) == 0
  LLRQCFU=((JSTEP > 0).OR.LREACFU).AND.LCUMFU
  LLRQXFU=LXFU.AND.(NCONF == 1.OR.NCONF == 302).AND.(LREAXFU.OR.NSTOP > 0)
  LLWVTIME=(MOD(JSTEP,NSTPW) == 0).AND.(NCONF == 1.OR.NCONF == 302)
  IF (LWCOU.AND.LLSTOP) THEN
    LLSTRC=(MOD(JSTEP-1,NSTPW) == 0).AND.(NCONF == 1.OR.NCONF == 302).AND.LLSTOP &
     & .AND.JSTEP > NSTPW
  ENDIF

!*       3.8.0.1  Prepare for AVARC
  IF(LLWRTRA.AND.LAVARC.AND.IHECPS(JSTEP)== 1) THEN
    WRITE (NULOUT,*) 'traj JSTEP = ', 'avarc active: event = ',IAVARE
    IF(IAVARE > NHECP(0)) THEN
      CALL ABOR1('AVARC ERROR : IAVARE > NHECP(0) ')
    ENDIF
    CALL AVARCT(IAVARE)
    IAVARE = IAVARE + 1
  ENDIF

! 3.8.0.2 Prepare for Jk
  CALL FLUSH(NULOUT)
  IF (LEJK) CALL EVARJKINI



!*       3.8.1  Prepare Full post-processing

  IF (LFPOS.AND.LLPLPP) THEN
    ITIME=JSTEP*TSTEP+0.5_JPRB
    CALL SU4FPOS(ITIME)
  ENDIF

  !*       3.8.2.0  Massfixer

  IF( LMASCOR.AND.LLMASCOR ) THEN
    IF( LMASDRY ) THEN
      DO JGFL=1,YGFL%NUMFLDS
        IF (YGFLC(JGFL)%LGP .AND. YGFLC(JGFL)%IGRBCODE == NGRBQ) THEN
          CALL CORMASSDRY(GFL,YGFL%NDIM,JGFL,JSTEP)
          EXIT
        ENDIF
      ENDDO
    ELSE
      CALL CORMASSDRY(GFL,YGFL%NDIM,1,JSTEP)
    ENDIF
  ELSE
    GMASSINC=0.0_JPRB
  ENDIF

  !*       3.8.2.1  Diagnostics

  IF (LLSPNRM) THEN
    IF (LMODERR.AND.JSTEP==0) THEN
      llevs=(NPRTMODERR>=2)
      DO jj=1,NDIM_MODERR
        CALL SPECTRAL_NORM (SPMODERR(jj),'CNT4 MODERR')
        CALL GRIDPOINT_NORM(GPMODERR(jj),'CNT4 MODERR',llevs)
      ENDDO
    ENDIF
    IF (NSITER > 0) THEN
      WRITE(UNIT=NULOUT,FMT='('' NORMS AT NSTEP CNT4 (PREDICTOR) '',I9)')JSTEP
    ELSE
      WRITE(UNIT=NULOUT,FMT='('' NORMS AT NSTEP CNT4 '',I9)')JSTEP
    ENDIF
    CALL SPNORM(0)
  ENDIF
  IF (LLGPNRM) THEN
    CALL GPNORM_GFL
  ENDIF
  IF (LMCUF) CALL SPMCUF

!*       3.8.3  Fluxes outputs

  IF(LLCFU.AND.LLRQCFU) CALL WRCFUPP
  IF(LLXFU.AND.LLRQXFU) CALL WRXFUPP

!*       3.8.4  Gridpoint evolution diagnostics

  LLECH= MOD( NINT(JSTEP*TSTEP,JPIB) , NFRQCHK )  == 0
  IF (LECHKEVO.AND.LLECH) CALL CHKEVO(JSTEP,TSTEP)

!*       3.8.5  Not-lagged Full-post-processing on physics and fluxes

  IF (LFPOS.AND.NFPCT0 >= 1.AND.LLPLPP) THEN
!   First horizontal interpolation with bogussed state (increment=+1.)
    IF (NFPINCR == 1) FPINCR=+1.0_JPRB
    CALL GRIDFPOS (LLRQCFU,LLRQXFU,.FALSE.)
!   2nd horizontal interpolation with boundary conditions (increment=-1.)
    IF (NFPINCR == 1) THEN
      NFPCT0=NFPCT0-1
      IF (NFPCT0 == 1) THEN
        IFILE=9
        IF (.NOT.ALLOCATED(SPA3)) CALL SUALSPA
        CALL SUINIF(IFILE)
        FPINCR=-1.0_JPRB
        CALL GRIDFPOS (LLRQCFU,LLRQXFU,.FALSE.)
      ELSE
        CALL ABOR1('CNT4 : INTERNAL ERROR NFPCT0')
      ENDIF
!     Reset initial state
      NFPCT0=NFPCT0+1
      IFILE=0
      IF (.NOT.ALLOCATED(SPA3)) CALL SUALSPA
      CALL SUINIF(IFILE)
    ENDIF
  ENDIF

  IF(LLPLPP.AND.LFPOS ) THEN
    LLFPOS=.TRUE.
  ELSE
    LLFPOS=.FALSE.
  ENDIF

  LLCOLA=(LSDDH.OR.LWCOU)

!*       3.X  Weak Constraints 4D-Var
  IF (LMODERR) THEN
    iweak=MSTEPERR(NSTEP)
    IF ((NTYPE_MODERR==1 .OR. NTYPE_MODERR==5).AND.iweak>0) CALL WEAK_CONSTRAINT
    ISTEP=NSTEP*TSTEP
    IF (LIFSTRAJ .AND. NUPTRA == MUPTRA .AND. &
    & NTYPE_MODERR == 5 .AND. ISTEP == NPERIOD_4DVAR*3600) CALL SAVE4NEXT
    IF (NTYPE_MODERR==4) CALL ADD_MODERR_TL(SPMODERR,GPMODERR,NSTEP)
  ENDIF

!*       3.9   Post-processing time step

  IF (LLPLPP.AND.&
     & ((IANATS(NSIM4D/NFRANA) == 1.AND.MOD(NSIM4D,NFRANA) == 0)&
     & .OR. NSIM4D == NSIM4DL)        ) THEN  

!*       3.9.1 Variational analysis on model levels will be written first

    IF(NCONF/100 == 1.OR.LLTLEVOL) THEN
      CLCONF(1:9)='A00000000'
      RESTART=CLCONF(1:1)
      LTWANA=.TRUE.
      LLFDBOP=LFDBOP
      LFDBOP=.FALSE.
      IOUTTYPE=NOUTTYPE
      NOUTTYPE=1
      CALL STEPO(CLCONF)
      IF (LLTLEVOL) THEN
        CALL PPFLUSH
        CALL PPCLOSE
      ENDIF
      LFDBOP=LLFDBOP
      NOUTTYPE=IOUTTYPE
      LTWANA=.FALSE.
    ENDIF

!*       3.9.2 Post-processing

    IF(LLWRTRA) THEN
      CLCONF(1:1)='T'
      RESTART=clconf(1:1)
    ELSEIF(LLMLPP) THEN
      IF(LLWRRE) THEN
        CLCONF(1:1)='F'
        RESTART='R'
      ELSE
        IF(LLSMLPP) THEN
          CLCONF(1:1)='S'
        ELSE
          CLCONF(1:1)='A'
        ENDIF
        RESTART=clconf(1:1)
      ENDIF
    ELSEIF(LLWRRE) THEN
      CLCONF(1:1)='R'
      RESTART=clconf(1:1)
    ELSE
      CLCONF(1:1)='0'
      RESTART=clconf(1:1)
    ENDIF

    IF (LFPOS) THEN
!        Advanced Full Post-processing !!!

      IF (NFPCT0 >= 1) THEN
        IF (NFPINCR == 1) THEN
!         1st horizontal interpolation with bogussed state (increment=+1.)
          FPINCR=+1.0_JPRB
        ENDIF
        CALL DYNFPOS(CLCONF,.TRUE.)
        IF (NFPINCR == 1) THEN
!         2nd horizontal interpolation with boundary conditions (increment=-1.)
          NFPCT0=NFPCT0-1
          IF (NFPCT0 == 1) THEN
            IFILE=9
            IF (.NOT.ALLOCATED(SPA3)) THEN
              CALL SUALSPA
            ENDIF
            CALL SUINIF(IFILE)
            FPINCR=-1.0_JPRB
            CALL DYNFPOS(CLCONF,.TRUE.)
          ELSE
            CALL ABOR1('CNT4 : INTERNAL ERROR NFPCT0')
          ENDIF
!               Reset initial state
          NFPCT0=NFPCT0+1
          IFILE=0
          IF (.NOT.ALLOCATED(SPA3)) THEN
            CALL SUALSPA
          ENDIF
          CALL SUINIF(IFILE)
        ENDIF
      ELSE
        CALL CPREP4(CLCONF,LLOVER)
        IF (.NOT.LLOVER) THEN
          IF (LHOOK) CALL DR_HOOK('CNT4',1,ZHOOK_HANDLE)
          RETURN
        ENDIF
      ENDIF
    ENDIF

    IF(LVAREPS) THEN
!   Re-set accumulated gp fields if VAREPS (the time-step check is inside RESET_ACCFIE_VAREPS)
      CALL RESET_ACCFIE_VAREPS(JSTEP)
    ENDIF

    IF(JSTEP < NSTOP.OR.(JSTEP == NSTOP.AND.LLCOLA))THEN
      ! ky: caution: for NSTOP=0, this sequence of STEPO requires that:
      !     - the setup of SI scheme is done in SUDYN.
      !     - GPPCBUF is allocated in SUSC2B if a PC scheme is switched on.
      CLCONF(2:2)='A'
      CLCONF(3:3)='A'
      IF(LLFPOS) THEN
        CLCONF(4:4)='B'
      ELSE
        CLCONF(4:4)='A'
      ENDIF
    ELSE
      CLCONF(2:2)='0'
      CLCONF(3:3)='0'
      CLCONF(4:4)='0'
    ENDIF
    CLCONF(5:5)='0'
    CLCONF(6:6)='0'

!*       3.9.3 Comparison to observations when LLOBSC1 or LOBSREF.

    IF(LLOBSC1.OR.LOBSREF) THEN
      LLSLOT   = .FALSE.
      CALL CHKOBTIM(LLSLOT,IACTIM)
      IF(LLSLOT) THEN
        NTSLOTNO = NTSLOTNOS
        CLCONF(2:2)='A'
        CLCONF(3:3)='A'
        CLCONF(6:6)='V'
      ENDIF
    ENDIF

    IF(JSTEP < NSTOP)THEN
      CLCONF(7:7)='A'
      CLCONF(8:8)='A'
      IF (NSITER == 0) THEN
        CLCONF(9:9)='A'
      ELSEIF (NSITER > 0) THEN
        IF (LRHDI_LASTITERPC) THEN
          CLCONF(9:9)='T'
        ELSE
          CLCONF(9:9)='A'
        ENDIF
      ELSEIF(NSITER < 0) THEN
        CALL ABOR1('NEGATIVE NSITER NOT ALLOWED')
      ENDIF
    ELSE
      CLCONF(7:7)='0'
      CLCONF(8:8)='0'
      CLCONF(9:9)='0'
    ENDIF

    IF(LL2D)THEN
      CLCONF(2:2)='A'
      CLCONF(3:3)='A'
      CLCONF(4:4)='A'
      CLCONF(5:5)='0'
      CLCONF(6:6)='0'
      CLCONF(7:7)='A'
      CLCONF(8:8)='A'
      CLCONF(9:9)='A'
    ENDIF
    IF (CLCONF=='T00000000') CLCONF(2:4)='AAA'

    NCURRENT_ITER=0
    IF (CLCONF/='000000000') CALL STEPO(CLCONF)

  ELSE

!*       3.10  Ordinary time step (predictor if PC scheme).

!*       3.10.1 fic HIST

    IF (NCONF == 601.AND. LLMLPP .AND. LLWRTRA) THEN
      CLCONF(1:9)='A00000000'
      RESTART=CLCONF(1:1)
      CALL STEPO(CLCONF)
    ENDIF

!*       3.10.2 Traj will be written first

    IF(LLWRTRA) THEN
      CLCONF(1:1)='T'
      RESTART=clconf(1:1)
    ELSEIF(LLMLPP) THEN
      IF(LLWRRE) THEN
        CLCONF(1:1)='F'
        RESTART='R'
      ELSE
        IF(LLSMLPP) THEN
          CLCONF(1:1)='S'
        ELSE
          CLCONF(1:1)='A'
        ENDIF
        RESTART=clconf(1:1)
      ENDIF
    ELSEIF(LLWRRE) THEN
      CLCONF(1:1)='R'
      RESTART=clconf(1:1)
    ELSE
      CLCONF(1:1)='0'
      RESTART=clconf(1:1)
    ENDIF

    IF(JSTEP < NSTOP.OR.(JSTEP == NSTOP.AND.LLCOLA))THEN
      ! ky: caution: for NSTOP=0, this sequence of STEPO requires that:
      !     - the setup of SI scheme is done in SUDYN.
      !     - GPPCBUF is allocated in SUSC2B if a PC scheme is switched on.
      CLCONF(2:2)='A'
      CLCONF(3:3)='A'
      IF(LLFPOS.AND..NOT.LL2D) THEN
        CLCONF(4:4)='B'
      ELSE
        CLCONF(4:4)='A'
      ENDIF
    ELSE
      IF ((LLOBSC1.OR.LOBSREF.OR.LAVARC).AND.(JSTEP /= NSTOP)) THEN
        CLCONF(2:2)='A'
        CLCONF(3:3)='A'
      ELSE
        CLCONF(2:2)='0'
        CLCONF(3:3)='0'
      ENDIF
      CLCONF(4:4)='0'
    ENDIF

    CLCONF(5:5)='0'
    CLCONF(6:6)='0'

!*       3.10.3 Comparison to observations when LLOBSC1 or LOBSREF.

    IF(LLOBSC1.OR.LOBSREF) THEN
      LLSLOT   = .FALSE.
      CALL CHKOBTIM(LLSLOT,IACTIM)
      IF(LLSLOT) THEN
        NTSLOTNO = NTSLOTNOS
        CLCONF(2:2)='A'
        CLCONF(3:3)='A'
        CLCONF(6:6)='V'
      ENDIF
    ELSEIF(LAVARC) THEN
      CLCONF(2:2)='A'
      CLCONF(3:3)='A'
    ENDIF

    IF(JSTEP < NSTOP)THEN
      CLCONF(7:7)='A'
      CLCONF(8:8)='A'
      IF (NSITER == 0) THEN
        CLCONF(9:9)='A'
      ELSEIF (NSITER > 0) THEN
        IF (LRHDI_LASTITERPC) THEN
          CLCONF(9:9)='T'
        ELSE
          CLCONF(9:9)='A'
        ENDIF
      ELSEIF(NSITER < 0) THEN
        CALL ABOR1('NEGATIVE NSITER NOT ALLOWED')
      ENDIF
    ELSE
      CLCONF(7:7)='0'
      CLCONF(8:8)='0'
      CLCONF(9:9)='0'
    ENDIF

    IF((NCONF == 1.OR.NCONF == 302) .AND. JSTEP == NSTOP .AND. LWRTCFOU) THEN
      CLCONF(1:1)='K'
      RESTART=clconf(1:1)
    ENDIF
    IF (CLCONF=='T00000000') CLCONF(2:4)='AAA'

    IF(LPC_FULL)CALL SETUP_PH9_PRED

    NCURRENT_ITER=0

    IF (CLCONF/='000000000') CALL STEPO(CLCONF)
  ENDIF

!       3.11    Corrector step

  IF( (JSTEP < NSTOP .AND. NSITER > 0).AND.&
    &.NOT.(LSMSSIG .AND. LLSTOP .AND. LLSTRC) ) THEN

! ITERATION STEP

    CALL SETUP_PH9_CORR

    DO JSITER=1,NSITER-1

      NCURRENT_ITER=JSITER

      IF (LRHDI_LASTITERPC) THEN
        CLCONF(1:9)='0AAS00AAS'
        RESTART=CLCONF(1:1)
      ELSE
        CLCONF(1:9)='0AAS00AAA'
        RESTART=CLCONF(1:1)
      ENDIF

      IF(LLSPNRM) THEN
        WRITE(UNIT=NULOUT,FMT='('' NORMS AT NSTEP CNT4 (CORRECTOR) '',I9)')JSTEP
        WRITE(NULOUT,'(A,I4)') ' Corrector step number ',NCURRENT_ITER
        CALL SPNORM(0)
      ENDIF
      CALL STEPO(CLCONF)

    ENDDO

! LAST STEP

    NCURRENT_ITER=NSITER

    CLCONF(1:9)='0AAS00AAA'
    RESTART=CLCONF(1:1)

    IF(LLSPNRM) THEN
      WRITE(UNIT=NULOUT,FMT='('' NORMS AT NSTEP CNT4 (CORRECTOR) '',I9)')JSTEP
      WRITE(NULOUT,'(A,I4)') ' Last corrector step number ',NCURRENT_ITER
      CALL SPNORM(0)
    ENDIF
    CALL STEPO(CLCONF)

  ENDIF

!*       3.12  MODERR

  IF (LSTATMERR.AND.CLCONF(4:4)/='0') CALL SAVE_MERR_TEND(jstep)

  IF (LMODERR.AND.NTYPE_MODERR==2) CALL ADD_MODERR_TL(SPMODERR,GPMODERR,NSTEP)
!*       3.14   Lagged Full-post-processing on physics and fluxes

  IF (LFPOS.AND.NFPCT0 >= 1.AND.LLPLPP) THEN
    IF (LAGPHY .AND. (NSTOP > 0) .AND. LEPHYS) THEN
      CALL GSTATS(17,0)
      CALL GRIDFPOS(LLRQCFU,LLRQXFU,.TRUE.)
      CALL GSTATS(17,1)
    ENDIF
  ENDIF

!*       3.15   Signal SMS event for completion of post_processing

  IF(LLPLPP.OR.LLMLPP) THEN
    IF(NOUTTYPE == 2) THEN
      CALL GSTATS(1710,0)
      CALL FLUSH_IOSTREAM(Y_IOSTREAM_FDB)
      CALL MPL_BARRIER(CDSTRING='CNT4:')
      CALL GSTATS(1710,1)
    ENDIF
  ENDIF

  IF(LSMSSIG) THEN
    IF(LLPLPP.OR.LLMLPP) THEN
      IF(NOUTTYPE /= 2) THEN
        CALL PPFLUSH
        IF( LPPTSF )THEN
          CALL PPCLOSE
        ENDIF
      ENDIF
      CALL GSTATS(1940,0)
      IF(MYPROC == 1) THEN
        ITIME=JSTEP*TSTEP+0.5_JPRB
        IPPTR=INT(REAL(ITIME,JPRB)/3600._JPRB)
        WRITE(CLSETEV,' (''smsmeter step '',I5,''&'') ') IPPTR

        CLSMSNAME="                                             "
        CALL UTIL_CGETENV(CL_CPENV, 'NOSMS', CLSMSNAME, ICPLEN)

        IF (ICPLEN > 0.AND.CLSMSNAME(1:5) /= 'NOSMS') THEN
          CALL SYSTEM(CLSETEV)
          WRITE(UNIT=NULOUT,FMT='('' SMS meter '',I5,'' posted '')') IPPTR
        ELSE
          WRITE(UNIT=NULOUT,&
           & FMT='('' SMS meter '',I5,&
           & '' not posted  because SMSNAME is not defined. LEN='',&
           & I3,A16)') IPPTR, ICPLEN, CLSMSNAME  
        ENDIF
      ENDIF
      CALL GSTATS(1940,1)
    ENDIF
  ELSE
    IF(LLPLPP.OR.LLMLPP) THEN
      IF(NOUTTYPE /= 2) THEN
        CALL PPFLUSH
        IF( LPPTSF )THEN
          CALL PPCLOSE
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  IF (LFPOS.AND.NFPCT0 >= 1) THEN
    IF (LLPLPP .AND. MYPROC == 1)  THEN
      CALL GSTATS(1941,0)
      OPEN (UNIT=NULFPOS,FILE=CFPNCF,FORM='FORMATTED')
      REWIND(NULFPOS)
      ISTEP=NSTEP
      IF (LINC) THEN
        IINC=NINT(REAL(ISTEP,JPRB)*TSTEP/3600._JPRB)
      ELSE
        IINC=ISTEP
      ENDIF
      WRITE(NULFPOS,'(I6.6)') IINC
      CLOSE(UNIT=NULFPOS,STATUS='KEEP')
      CALL GSTATS(1941,1)
    ENDIF
  ENDIF

!*      3.16  Write accumulated fluxes for OASIS2

  IF(NFRCO /= 0) THEN
    IF((MOD(NSTEP+1,NFRCO) == 0).AND.(NSTEP < NSTOP)) THEN
      IF(LMCC04) THEN
        IF (NOACOMM /= 5) THEN
          CALL WRCOE
        ENDIF
      ENDIF
    ENDIF
  ENDIF

!*      For EC-Earth coupled runs, call the coupler in order
!       to send the ocean fields. The coupler decides whether the fields are
!       actually send (coupling time step) or not.

  IF (LECEARTH) THEN
    IF(.NOT.LECEARTH_UNCOUP) THEN
      CALL CPLNG_EXCHANGE(CPLNG_STAGE_SND_OCE)
    ENDIF
  ENDIF

  IF (LTM5) THEN
    CALL CPLNG_PREPARE_CHE
    CALL CPLNG_EXCHANGE(CPLNG_STAGE_SND_CHE)
  ENDIF

  IF (LLPJG) THEN
     CALL CPLNG_EXCHANGE(CPLNG_STAGE_SND_VEG)
  ENDIF
  
  LLWRRE = .FALSE.
  IF (LSMSSIG .AND. LLSTOP .AND. LLSTRC) THEN
    IF(MYPROC == 1) THEN
!           CALL SYSTEM('smsrestart NSTEP')
      WRITE(CLCOMMAND,'(A,I6)') 'smsrestart ',NSTEP
      CALL SYSTEM(CLCOMMAND)
    ENDIF
    EXIT
  ENDIF

!*       3.17  Set switch to write restart files and if coupled with WAM
!*             delay writing until WAM has been called.

  IF (JSTEP  <  NSTOP) THEN
    IF (LWCOU) THEN
      IF ( .NOT. LLWRRC ) LLWRRC = IRESTS((JSTEP+1)/NFRRES)  ==  1 &
       & .AND. MOD(JSTEP+1,NFRRES)  ==  0  
    ELSE
      LLWRRE  =  IRESTS((JSTEP+1)/NFRRES)  ==  1.AND.&
       & MOD(JSTEP+1,NFRRES)  ==  0.OR. LLWRRC  
      LLWRRC = .FALSE.
    ENDIF
  ENDIF

!*       3.18  Check for incoming signals.
!        for ocean-atmosphere runs, this is handled by oasis

  IF(LSMSSIG.AND.(NCONF == 1.OR.NCONF == 302).AND.(.NOT.LMCC04)) THEN
    CALL SIGCHECK(LLSTOP,LLWRRC)
    IF ((LLSTOP.OR.LLWRRC) .AND. MYPROC == 1 ) THEN
      WRITE(NULOUT,*)" CNT4 - SIGNALS: JSTEP=",JSTEP," NFRRES=",&
       & NFRRES, " LLSTOP=", LLSTOP, " LLWRRC=", LLWRRC  
    ENDIF
    IF (.NOT.LWCOU .AND. LLWRRC) THEN
      LLWRRE = .TRUE.
      LLWRRC = .FALSE.
    ENDIF
  ENDIF

!*       3.19  Call the wave coupling

  IF (LLWVTIME) THEN
    IF(NSTEP > 0.AND.LWCOU) CALL GSTATS(38,0)
    LLWRRW = LWCOU .AND.(LLSTOP .OR. LLWRRC)
    CALL WVCOUPLE(TSTEP,NSTPW,LLSTOP,LLWRRW)
    IF (LWCOU .AND. LLWRRW) THEN
      LLWRRE = .TRUE.
      LLWRRC = .FALSE.
    ENDIF
    LLWRRW =  .FALSE.
    IF(NSTEP > 0.AND.LWCOU) CALL GSTATS(38,1)
  ENDIF

!*       3.20  Write animation file (ISP)

  IF (LLPISP.AND.LMOVPH) THEN
    IF (.NOT.LELAM) THEN
      CALL WMOVPH
    ELSE
      CALL EWMOVPH
    ENDIF
  ENDIF
  CALL USER_CLOCK(PTOTAL_CP=ZT2)
  CALL DATE_AND_TIME(CLDAT(1),CLTIMEOD,CLDAT(3),IVALUES)
  ZSEC   = REAL(NSTEP,JPRB)*TSTEP +0.5_JPRB
  IHOUR  = INT( ZSEC/3600._JPRB )
  IMIN   = INT( (ZSEC-REAL(IHOUR,JPRB)*3600._JPRB)/60._JPRB )
  WRITE (UNIT=CLDAYF,&
   & FMT='(1X,A,'':'',A,'':'',A,'' STEP'',I9,'' H='',I9,'':'',&
   & I2.2,'' +CPU='',F7.3)')&
   & CLTIMEOD(1:2),CLTIMEOD(3:4),CLTIMEOD(5:6)&
   & ,NSTEP,IHOUR,IMIN,ZT2-ZT1  
  IF (MYPROC == 1) THEN
    WRITE(NULERR,*) CLDAYF
  ENDIF
  WRITE (UNIT=NULOUT, FMT='(A51)') CLDAYF
  
!*       3.16  Diagnostics on physical tendencies

  IF (GCHETN%LFREQD) THEN
    CALL WRITECHET(NSTEP)
  ENDIF

ENDDO        ! End of main loop over time steps

!*       3.21  Miscellaneous.

IF (LIFSMIN.AND.LTRAJGP.AND.LTRAJHR.AND.LTRAJSAVE) THEN
  LLASTRAJ=.TRUE.
  CALL READ_TRAJECTORY(nstar2,LLASTRAJ,LREADGPTRAJ)
ENDIF

IF ( ((LLOBSC1.AND.LOBS) .OR. &
   & ( ((NCONF == 131).AND.LOBSREF) .AND. &
   & .NOT.(LOBSREF.AND.L131TL.AND.LOBSTL) ) )     ) THEN  
  CALL USER_CLOCK(PELAPSED_TIME=ZWT,PVECTOR_CP=ZVT,PTOTAL_CP=ZCT)
  ZCT=ZCT-RSTART
  ZVT=ZVT-RVSTART
  ZWT=ZWT-RTIMEF
  RSTART=RSTART+ZCT
  RVSTART=RVSTART+ZVT
  RTIMEF=RTIMEF+ZWT
  WRITE(NULOUT,'('' NSTEP ='',I6,'' OBSV    '',A9,3F8.3)')&
   & NSTEP,CLCONF,ZVT,ZCT,ZWT  
  IF(LLOBSC1) CALL DEALMOD
  IF(LPREMPOBS) THEN
    CALL POST_OBSHOR(.FALSE.)
  ENDIF
  CALL OBSV('DI')
  CALL UPDOBS(1)
ENDIF

IF (LFINDVSEP) THEN
  WRITE(NULOUT,'('' COMPUTED VALUE OF NVSEPC IS'',I4)') NVSEPC
  WRITE(NULOUT,'('' COMPUTED VALUE OF NVSEPL IS'',I4)') NVSEPL
ENDIF
LFINDVSEP=.FALSE.

IF (ALLOCATED(GPP)    ) DEALLOCATE(GPP)

CALL GSTATS(1,1)

IF (.NOT.LLSTOP) THEN
  RESTART=clconf(1:1)
ENDIF


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

IF (LHOOK) CALL DR_HOOK('CNT4',1,ZHOOK_HANDLE)
END SUBROUTINE CNT4
