SUBROUTINE CNT4AD

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

USE YOMDIMO  , ONLY : NACTIM
USE YOMECTAB , ONLY : NTSLOTNO ,NTSLOTNOS,NTSLOTNOE,NTSLVSTST
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LFPART2  ,LNHDYN   ,NCONF    ,NSTOP    ,NFRPOS   ,NFRISP   ,&
 & NFRHIS   ,NFSRHIS  ,NFRGDI   ,NFRSDI   ,NFRDHFG  ,NFRDHFZ  ,&
 & NFRDHFD  ,NFRDHP   ,NFRMASSCON,LTWOTL   ,&
 & LFPOS    ,LOBS     ,LSIMOB   ,LSITRIC  ,NPRINTLEV ,&
 & NSTART   ,LELAM
USE YOMCT2   , ONLY : NSTAR2   ,NSTOP2
USE YOMCT3   , ONLY : NSTEP 
USE YOMDYN   , ONLY : TSTEP, TDT, LSTRHD, LSIDG, NSITER, NCURRENT_ITER
USE YOMVAR   , ONLY : NSIM4D   ,NFRREF   ,NFRANA   ,&
 & NFRGRA   ,NSIM4DL  ,LTRREF   ,&
 & LTWGRA   ,LGRASCAL, LJCDFI, LUSEJCDFI, LMODERR ,LAVARC , LFCOBSTEST 
USE YOMGLOBS , ONLY : LPREMPOBS
USE YOMHCP   , ONLY : NHECP
USE YOMCFU   , ONLY : NFRCFU
USE YOMXFU   , ONLY : NFRXFU   ,NFRRAZ
USE YOMSENS  , ONLY : NJROPT
USE YOMVRTL  , ONLY : L801TL   ,LOBSTL
USE YOMRES   , ONLY : NFRRES
USE YOMSKF   , ONLY : LTWSKFZ
USE YOMPPC   , ONLY : LOPPCNT
USE YOMMP    , ONLY : NOUTTYPE, NPSP
USE YOMIO    , ONLY : LPPTSF
USE YOMTIM   , ONLY : RSTART   ,RVSTART  ,RTIMEF
USE YOMTNEWT , ONLY : LIDMODEL
USE YOMSP    , ONLY : SPSP, SPA3, SPD2D, SP5A3, SP5A2, SPA1, SP5A1
USE TRAJECTORY_MOD, ONLY: LTRAJGP, GET_TRAJ_SPEC
USE YOMLCZ   , ONLY: L_SOS, L_EOFS, NSTEPS_PER_STATE, YSTATE_VECTOR_4D, &
 & LOCNORM, LFORCE, YSPFORCE
USE YOMMODEL_ERROR,ONLY: NTYPE_MODERR, NDIM_MODERR, MSTEPERR, NPRTMODERR, &
                    & SPMODERR, GPMODERR, SPMODERR_HYB, GPMODERR_HYB, &
                    & N_COUPLED_WINDOWS
USE YEMCT0   , ONLY : NECOAD   ,LE0COTA  ,NFRLSG   ,N1LSG
USE YOMDFI     , ONLY : NSTDFI
USE CONTROL_VECTORS
USE SPECTRAL_FIELDS_MOD
USE YEMJK    , ONLY : LEJK

!**** *CNT4AD*  - Controls adjoint model at level 4

!     Purpose.
!     --------
!     Controls adjoint integration.

!**   Interface.
!     ----------
!        *CALL* *CNT4AD

!        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
!   Modified by D. Vasiljevic and J. Pailleux: 90-11-23
!   Modified by F. Rabier and J.N Thepaut: 91-01-15
!   P. Courtier: 91-08-07 (transforms calls)
!   J.N Thepaut: 91-08-22 (4D with real data events managment
!                          +   comparison model - op.analysis)
!   W Heckley  : 91-10-02 3-D (comparison model - obs)
!   D. Vasiljevic: 92-05-08 IO and OBS. IO schemes
!   L. Labbe: 93-04-15 Gradient for sensitivity job 8xx
!   08/03/1993 Additional horizontal diffusion on not stretched sphere
!              (K. YESSAD).
!   F. Rabier  : 93-12-10 Write gradient according to post-processing set-u
!                + possibility of writing it with respect to SCALP inner-pr
!   K. YESSAD (MARCH 1994): Modifications in the semi-implicit scheme
!                (add of call to SUHEG, call SUHEL useless).
!   K. YESSAD (APRIL 1994): Unified horizontal diffusion scheme.
!   M.Hamrud: 95-10-30 (New form of CLCONF)
!   K. YESSAD (NOV 1995): removal of HDC horizontal diffusion scheme.
!   F. Rabier  : 96-09-25 Proper call to stepo(V00..0) in nconf 801
!   M.Hamrud   : Optim, cleaning
!   M. Fisher  : 97-01-31 Write gradient at intermediate time
!   C. Temperton 97-02-24: modified first timestep when XIDT>0
!   T. Bergot    97-08   : write gradient / IHISTS
!                          + read RFfile only if NJROPT=1
!   G. Hello   : 97-08-05 Write gradient with implicit inner product
!   F. Rabier  : 98-01-06 call PPFLUSH in nconf 801
!   C. Soci    : 98-06-15 introduction of YOMCAIN/YEMECAIN
!   M. Charron: November 98 (nonhydrostatic dynamics, incomplet)
!   C. Temperton 98-11-05: adjoint of two-time-level scheme
!   C. Fischer : 98-11-20 Nullify boundaries for aladin/AD if asked
!   C. Temperton 99-08-16: removed redundant RKROMA
!   P. Gauthier :99-08-10: Jc-dfi (adjoint)
!   C. Fischer : 99-12-27 Prepare for nsiter>0
!   C. Soci    : 00-04-05 ZVANA&ZVAGR allocatable to include mean wind;
!                      write LSG at intermediate timesteps
!   C. Temperton 00-03-24: bugfixes for 2TL scheme: RSTATI=>ZSTATI
!   Y. Tremolet  00-08-11: use module TRAJECTORY
!   C. Fischer: 02-03-13: merge ecain* into cain*
!   J.Vivoda (03-2002) PC schemes for NH dynamics (LPC_XXXX keys)
!   G. Desroziers : 02-09-16 also treat Aladin mean wind trajectory
!   01-Oct-2003 M. Hamrud  CY28 Cleaning
!   25-Feb-2004 C. Fischer  Merge Aladin into Arpege/IFS cnt4ad
!      Dec-2003 K. Yessad   cleaning in horizontal diffusion.
!   10-Jun-2004 J. Masek    NH cleaning (LPC_NOTR)
!   01-Jul-2004 K. Yessad   Cleaning in PC scheme, and paragraph numbering
!      harmonisation with the direct and the TL codes (when possible!).
!   Y.Tremolet    18-Mar-2004 Model error changes
!   R. El Khatib : 05-02-21 specific frequency array to reset instant. fluxes
!        V.Guidard&C.Fischer: 01-Apr-2004 Introduction of Jk event
!   K. Yessad     08-Feb-2005 SI scheme for ARPEGE NH model
!   K. Yessad     21-Apr-2005 cleanings for SPNORM-printings.
!   D. Salmond    21-09-05 Fix for LTRAJGP=true
!   B. Chapnik    02-May-2007 fgat : temporal loop considered only if Tstep corresponds to tslot
!                                    and call to stepo only when needed
!   Y. Seity    11-01-08 add ISHISTS for surfex output files
!   Y.Tremolet    27-Nov-2008 Jc-DFI for long windows
!   F. Vana    13-Jan-2009: removed special specHD setup when LSLHD
! End Modifications

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

IMPLICIT NONE

CHARACTER (LEN = 9) ::  CLCONF
CHARACTER (LEN = 9) ::  CLCON9
CHARACTER (LEN = 120) ::  CLYFILE
CHARACTER (LEN = 10) ::  CLTIMEOD, CLDAT(3)

!   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

!   ZVANA : working array containing the model state.
!   ZVAGR : working array containing the gradient.
TYPE(control_vector) :: YL_ZVANA, YL_ZVAGR

! - 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)
! - 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/NFRGDI)
! - ISDITS : SPECTRAL DIAGNOSTICS TIME STEPS
INTEGER(KIND=JPIM) :: ISDITS(0:NSTOP/NFRSDI)
! - IREFTS : ARRAY CONTAINING SIMULATED OBS. EVENTS STEPS
INTEGER(KIND=JPIM) :: IREFTS(0:NSTOP/NFRREF)
! - 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 : ANALYSIS WRITE-OUT EVENTS
INTEGER(KIND=JPIM) :: IANATS(0:NSIM4DL/NFRANA)
! - IGRATS : GRADIENT WRITE-OUT EVENTS
INTEGER(KIND=JPIM) :: IGRATS(0:NSIM4DL/NFRGRA)
! - IMASSCONS: ARRAY CONTAINING mass conservation fixup time steps
INTEGER(KIND=JPIM) :: IMASSCONS(0:NSTOP/NFRMASSCON)
! - ILSGTS : LBC GRADIENT WRITE-OUT EVENTS
INTEGER(KIND=JPIM) :: ILSGTS(0:NSTOP/NFRLSG)
! - IHECPS : AVARC WRITE-OUT EVENTS
INTEGER(KIND=JPIM) :: IHECPS(0:NSTOP)

REAL(KIND=JPRB), ALLOCATABLE :: ZSPA3(:,:,:), ZSPSP(:)

INTEGER(KIND=JPIM) :: IACTIM, IDIGLST, IOUTTYPE, ITIME, JSTEP, I, jj
INTEGER(KIND=JPIM) :: IHOUR, IMIN
INTEGER(KIND=JPIM) :: IVALUES(9)
INTEGER(KIND=JPIM) :: JTSLOT, JSITER, IWEAK
INTEGER(KIND=JPIM) :: IAVARE, ipersub, istep, isub

!   LLSLOT: logical switched on if a slot is available.
LOGICAL :: LL3DVAR,  LLMLPP, LLNOPPFIL, LLSLOT, LLFIRST
LOGICAL :: LLSPNRM, LLGPNRM
LOGICAL :: LLWRELSG,llevs
LOGICAL :: LLSLOT_FGAT, LLFGATLAM

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

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

INTERFACE
#include "user_clock.h"
END INTERFACE

#include "abor1.intfb.h"
#include "avarcad.intfb.h"
#include "cain.intfb.h"
#include "cainad.intfb.h"
#include "cainin.intfb.h"
#include "caininad.intfb.h"
#include "copygom5t0.intfb.h"
#include "costra.intfb.h"
#include "digfilad.intfb.h"
#include "elsin0ta.intfb.h"
#include "evarjkad.intfb.h"
#include "ewrlsgrad.intfb.h"
#include "gpnorm_gfl.intfb.h"
#include "lcnorad.intfb.h"
#include "moevar.intfb.h"
#include "monio.intfb.h"
#include "monvar.intfb.h"
#include "obsprep.intfb.h"
#include "obsvad.intfb.h"
#include "ppclose.intfb.h"
#include "ppflush.intfb.h"
#include "ppreq.intfb.h"
#include "pre_obshorad.intfb.h"
#include "spnorm.intfb.h"
#include "stepo.intfb.h"
#include "stepoad.intfb.h"
#include "suhdu.intfb.h"
#include "suheg.intfb.h"
#include "sunhsi.intfb.h"
#include "sutric.intfb.h"
#include "tslvstst.intfb.h"
#include "updtim.intfb.h"
#include "gridpoint_norm.intfb.h"
#include "add_moderr_ad.intfb.h"
#include "weak_constraint_ad.intfb.h"

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

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

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

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

CALL GSTATS(23,0)
WRITE(NULOUT,*)'START CNT4AD, NSIM4D=',NSIM4D

LL3DVAR = (NCONF == 131.AND.NSTOP == 0)
LLWRELSG=NCONF/100 == 8 .AND. LELAM .AND. N1LSG==1
LLFGATLAM=LELAM .AND. LIDMODEL !BC fgat for aladin
!      -----------------------------------------------------------------

!*       2.    Prepare occurences of I/O and 3D/4D var events.
!              ----------------------------------------------

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

IAVARE = NHECP(0)
IF (LELAM) THEN
  CALL MOEVAR(ILSGTS)
ENDIF

!* events not implemented
IDHFGTS(0:NSTOP/NFRDHFG) = 0
IDHFZTS(0:NSTOP/NFRDHFZ) = 0
IDHFDTS(0:NSTOP/NFRDHFD) = 0
IDHPTS (0:NSTOP/NFRDHP)  = 0

! print config

IF (NPRINTLEV >= 1) THEN
  WRITE(UNIT=NULOUT,FMT='('' GRADIENT WRITE-UP, IGRATS '')')
  WRITE(UNIT=NULOUT,FMT='(40I2)')IGRATS
  WRITE(UNIT=NULOUT,FMT='('' HISTORY WRITE-UP, IHISTS '')')
  WRITE(UNIT=NULOUT,FMT='(40I2)')IHISTS
ENDIF
!      -----------------------------------------------------------

!*       3.    ADJOINT integration.
!              --------------------

!*       3.0  Preliminary calculations.

NSTEP = NSTOP

LLSLOT = .FALSE.
ZSTATI=REAL(NINT(NSTEP*TSTEP),JPRB)

LLMLPP = LTWSKFZ .AND. IHISTS(NSTEP/NFRHIS) == 1.AND. MOD(NSTEP,NFRHIS) == 0

IACTIM = NACTIM

LLSPNRM=ISDITS(NSTEP/MAX(1,NFRSDI)) == 1.AND.MOD(NSTEP,MAX(1,NFRSDI)) == 0
IF(LLSPNRM) THEN
  WRITE(UNIT=NULOUT,FMT='('' NORMS AT START CNT4AD '')')
  CALL SPNORM(0)
  CALL GPNORM_GFL
ENDIF

CLCONF(1:9) = '000000000'

!*       3.21  Miscellaneous.

! Computations in observation space

IF (.NOT.LSIMOB) THEN
  IF(NCONF/100 == 1) THEN
    IF (LOBSTL.AND.LOBS) THEN

!       PREPARE TRAJECTORY IN OBSERVATION SPACE

      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
      CALL COPYGOM5T0
      WRITE(NULOUT,'('' NSTEP ='',I6,'' OBSVAD  '',A9)')&
       & NSTEP,CLCONF
      CALL OBSVAD
      IF(LPREMPOBS) THEN
        CALL PRE_OBSHORAD
      ENDIF
    ENDIF
    LLFIRST  = .TRUE.
    LLSLOT = .FALSE.
    DO JTSLOT=NACTIM,1,-1
!       DIRECT
      IF(LL3DVAR.OR.NTSLVSTST(JTSLOT) == NSTEP ) THEN
        LLSLOT = .TRUE.
        NTSLOTNO = IACTIM
        IF(LLFIRST) THEN
          LLFIRST  = .FALSE.
          NTSLOTNOS = IACTIM
        ENDIF
        NTSLOTNOE = IACTIM
        IACTIM = IACTIM-1
        WRITE(UNIT=NULOUT,FMT='('' CNT4AD (ADJOINT INTEGRATION);'' &
         & ,'' TIME SLOT NO : '',I3 &
         & ,'' TO BE USED WITH TIME STEP (NSTEP) : '',I3 &
         & ,'' ; MODEL TIME (SINCE START) : '',F6.0)')&
         & NTSLOTNO,NSTEP,ZSTATI
        CALL FLUSH(NULOUT)
        IF (LOBS)      THEN
          CALL OBSPREP('V')
        ENDIF
      ENDIF
    ENDDO
    IF(LLSLOT)   THEN
      NTSLOTNO = NTSLOTNOE
      IF (LOBSTL)  THEN
!       GOM-ARRAYS ALREADY PREPARED
      ELSE
        IF (LTRREF) THEN
          CLCONF(1:9) = 'B00000000'
        ELSE
          CALL GSTATS(15,0)
          CALL GET_TRAJ_SPEC(SP5A3,SP5A2,SP5A1,KSTEP=NSTEP)
          CALL GSTATS(15,1)
        ENDIF
        IF(LL3DVAR) THEN
          CLCONF(2:2) = 'K'
          CLCONF(3:3) = 'D'
        ELSE
          CLCONF(2:2) = 'E'
          CLCONF(3:3) = 'C'
        ENDIF
        CLCONF(6:6) = 'V'
        CALL STEPO(CLCONF)
      ENDIF
    ENDIF
!       ADJOINT
    CLCON9(1:9) = '000000000'
    IF (LLSLOT) THEN
      IF (LL3DVAR) THEN
        CLCON9(2:2) = 'G'
        CLCON9(3:3) = 'B'
      ELSEIF (.NOT.LIDMODEL) THEN
        CLCON9(2:2) = 'A'
        CLCON9(3:3) = 'A'
      ENDIF
      IF (LOBS) CLCON9(6:6) = 'V'
    ENDIF
    IF (CLCON9(1:9)/='000000000') CALL STEPOAD(CLCON9)
  ENDIF
ELSE
  IF(.NOT.LTRAJGP) THEN
    IF (LTRREF) THEN
      CLCONF(1:9) = 'B00000000'
    ELSE
      CALL GSTATS(15,0)
      CALL GET_TRAJ_SPEC(SP5A3,SP5A2,SP5A1,KSTEP=NSTEP)
      CALL GSTATS(15,1)
    ENDIF
  ENDIF
ENDIF

IF (.NOT.LSIMOB) THEN
ELSE
  IF(NCONF == 801) THEN

!   ----- observation events management ----------------------

    IF(IREFTS(NSTEP/NFRREF) == 1.AND.MOD(NSTEP,NFRREF) == 0.0_JPRB ) THEN

!   ----- read observations ----------------------------------

      LTRREF=.TRUE.

      IF (NJROPT /= 1) THEN

! do nothing!!

      ELSE

! read RF file

        IF(L801TL)THEN
          CLCONF(1:1)='V'
        ELSE
          CLCONF(1:1)='B'
        ENDIF
        CLCONF(2:9)='00000000'
        CALL STEPO(CLCONF)
      ENDIF
      CALL COSTRA
      LTRREF=.FALSE.

    ENDIF
  ENDIF
ENDIF

!*       3.9.4 a  Comparison to reference state (AVARC)
IF (LAVARC.AND.IHECPS(NSTEP) == 1) THEN
  WRITE(NULOUT,*) 'adjoint starts: AVARC event at NSTOP event = ',IAVARE
  CALL AVARCAD(IAVARE)
  IAVARE = IAVARE - 1
ENDIF
!      ----- add the gradient of the Jk cost function
  IF (LELAM) THEN
  IF (LEJK) CALL EVARJKAD
  ENDIF

!        3.1.1 a  Time filtering constraint based on digital filter
!                 is being computed
!                 Its contribution is added to SPA3, SPA2 and SPA1.
!                 ----- adjoint of Jc-dfi for NSTOP ----------------

IF (LJCDFI.AND.LUSEJCDFI) THEN
! Step should be local to subwindow
  IF (N_COUPLED_WINDOWS>1) THEN
    isub=1
    istep=0
    IF (NSTEP>0) THEN
      ipersub=NSTOP/N_COUPLED_WINDOWS
      istep=MOD(NSTEP-1,ipersub)+1
      isub=(NSTEP-1)/ipersub+1
    ENDIF
  ELSE
    isub=1
    istep=NSTEP
  ENDIF
  IDIGLST = 2*NSTDFI
  IF (NSIM4D==0.AND.N_COUPLED_WINDOWS>0) THEN
    write(nulout,*)'CNT4AD: Calling DIGFILAD nstep,isub,istep=',nstep,isub,istep
  ENDIF
  CALL DIGFILAD(istep, IDIGLST, isub, SPA3, SPD2D, SPA1, .TRUE.)
ENDIF

!        3.???  Write-up of the gradient (part not present in cnt4tl)

IF ((NCONF/100 == 1.OR.NCONF/100 == 8) .AND. LGRASCAL) THEN
  CALL ALLOCATE_CTLVEC(YL_ZVANA)
  CALL ALLOCATE_CTLVEC(YL_ZVAGR)
ENDIF

!        3.???  ??? (part not present in cnt4tl)

IF (NCONF == 601.AND. LLMLPP) THEN
  CLCONF='A00000000'
  IOUTTYPE=NOUTTYPE
  NOUTTYPE=1
  CALL STEPO(CLCONF)
  NOUTTYPE=IOUTTYPE
ELSEIF (NCONF/100 == 1.OR.NCONF/100 == 8) THEN
  IF (   (IGRATS(NSIM4D/NFRGRA) == 1.AND.&
     & MOD(NSIM4D,NFRGRA) == 0.OR.NSIM4D == NSIM4DL)&
     & .AND.(IHISTS(NSTEP/NFRHIS) == 1.AND.&
     & MOD(NSTEP,NFRHIS) == 0)         )THEN

    IF (LGRASCAL) THEN
!              WRITE GRADIENT WITH RESPECT TO SCALP INNER-PRODUCT
!              SAVE GRADIENT WITH RESPECT TO STANDARD INNER-PRODUCT
      WRITE(NULOUT,'(''LGRASCAL=true, sens-grad scaled by the inverse of scalp'')')
      CALL CAININ (YL_ZVANA)
!              GET GRADIENT WITH RESPECT TO SCALP INNER-PRODUCT
      YL_ZVAGR = 0.0_JPRB
      IF (LFORCE) THEN
        CALL CAIN   (YSPFORCE)
      ENDIF
      CALL CAINAD (YL_ZVAGR)
      CALL CAIN   (YL_ZVAGR)
      LTWGRA = .TRUE.
      CLCONF(1:9)='A00000000'
      CALL STEPO(CLCONF)
      CALL PPFLUSH
      CALL PPCLOSE
      LTWGRA = .FALSE.
!              FETCH GRADIENT WITH RESPECT TO STANDARD INNER-PRODUCT
      CALL CAIN (YL_ZVANA)
    ELSE
!              WRITE GRADIENT WITH RESPECT TO IMPLICIT(STANDARD) INNER-PRODUCT
      WRITE(NULOUT,'(''LGRASCAL=false, sens-grad not scaled'')')
      IF (LFORCE) THEN
        CALL CAIN(YSPFORCE)
      ENDIF
      LTWGRA = .TRUE.
      CLCONF(1:9)='A00000000'
      CALL STEPO(CLCONF)
      CALL PPFLUSH
      CALL PPCLOSE
      LTWGRA = .FALSE.
    ENDIF
  ENDIF
ENDIF

!* TEMPORAL LOOP

IF(NSTART /= NSTAR2 .OR.&
   & NSTOP  /= NSTOP2      ) THEN
  WRITE(NULOUT,'('' NSTART, NSTOP ARE DIFFERENT FROM NSTAR2, NSTOP2'')')
  WRITE(NULOUT,'('' NSTART, NSTOP, NSTAR2, NSTOP2: '',4(I5,1X))') &
   & NSTART, NSTOP, NSTAR2, NSTOP2
  WRITE(NULOUT,'('' THEREFORE, TIMESLOT VS TIMESTEP IS RECALCULATED'')')
  CALL TSLVSTST(NSTAR2,NSTOP2,TSTEP,NACTIM,NTSLVSTST)
ENDIF

!*       3.1  Main temporal loop

TEMPORAL_LOOP: DO JSTEP=NSTOP2-1,NSTAR2,-1

IF (LLFGATLAM .AND. (ALL(NTSLVSTST /= JSTEP)) ) CYCLE

  CALL USER_CLOCK(PTOTAL_CP=ZT1)

!*       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...)

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

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

  IF (.NOT.LELAM) THEN

    ! * SI scheme:
    IF (LNHDYN) THEN
      CALL SUNHSI(NULOUT,.FALSE.)
    ELSE
      IF (LSIDG) THEN
        CALL SUHEG
      ENDIF
      IF (LSITRIC.AND.(JSTEP == NSTOP-2.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

    ! * HD scheme:

  ENDIF

!*       3.6  Reset YOMCT3 etc.

  NSTEP=JSTEP
  LLSLOT=.FALSE.
  ZSTATI=REAL(NINT(NSTEP*TSTEP),JPRB)

  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
  IF(LLSPNRM) THEN
    WRITE(UNIT=NULOUT,FMT='('' NORMS AT NSTEP CNT4AD '',I4)')NSTEP
    CALL SPNORM(0)
  ENDIF
  IF (LLGPNRM) THEN
    CALL GPNORM_GFL
  ENDIF
  IF (LFCOBSTEST.AND.(NSIM4D<=4.OR.NSIM4D==NSIM4DL)) THEN
    WRITE(NULOUT,*)'LFSOBS NORMS AT CNT4AD'
    CALL SPNORM(0)
    CALL GPNORM_GFL
  ENDIF

!*       3.6.1  Nullify GT3

  IF (LELAM.AND.(NECOAD < 0.OR.LE0COTA).AND.(NSTOP /= 0)) THEN
    CALL ELSIN0TA
  ENDIF

!*       3.8  Reset time dependent variables

  LLMLPP = LTWSKFZ .AND. IHISTS(JSTEP/NFRHIS) == 1 &
   & .AND. MOD(JSTEP,NFRHIS) == 0

!*       3.8.6  Add the forcing that was saved during the TL integration

  IF (L_SOS) THEN
    IF (MOD((JSTEP+1),NSTEPS_PER_STATE)==0 .AND. JSTEP+1 < NSTOP) THEN
      I = (JSTEP+1)/NSTEPS_PER_STATE
      ALLOCATE (ZSPA3(SIZE(SPA3,1),SIZE(SPA3,2),SIZE(SPA3,3)))
      ZSPA3(:,:,:) = SPA3(:,:,:)
      IF (NPSP==1) THEN
        ALLOCATE (ZSPSP(SIZE(SPSP)))
        ZSPSP(:)   = SPSP(:)
      ENDIF
      CALL CAININAD (YSTATE_VECTOR_4D(I))
      IF(LOCNORM) CALL LCNORAD
      SPA3(:,:,:) = SPA3(:,:,:) + ZSPA3(:,:,:)
      DEALLOCATE (ZSPA3)
      IF (NPSP==1) THEN
        SPSP(:)   = SPSP(:)   + ZSPSP(:)
        DEALLOCATE (ZSPSP)
      ENDIF
    ENDIF
  ENDIF

!*       3.???  Prepare for post-processing (part not present in cnt4tl).

  IF(LOPPCNT.AND.LLMLPP .AND. NCONF == 601.AND..NOT.LFPOS) THEN
    ITIME=JSTEP*TSTEP+0.5_JPRB
    CALL PPREQ(INT(ITIME,JPIB),LLNOPPFIL,CLYFILE)
    IF(LLNOPPFIL) THEN
      LLMLPP=.FALSE.
    ENDIF
  ENDIF

!*       3.8.7  Manage trajectory
!               Initialize CLCONF for call to STEPO (trajectory)

  IF (LTRREF) THEN
    CLCONF(1:9) = 'BE0000000'
  ELSE
    IF(.NOT.LTRAJGP) THEN
      CALL GSTATS(15,0)
      CALL GET_TRAJ_SPEC(SP5A3,SP5A2,SP5A1,KSTEP=NSTEP)
      CALL GSTATS(15,1)
    ENDIF
    CLCONF(1:9)='0E0000000'
  ENDIF

! first call for (first-guess) trajectory
! don't understand anymore why this is only for Aladin (CF) ...
! In cnt4tl this is also called for lelam=false (K.Y.)
  IF(.NOT.LTRAJGP.AND.LELAM .AND. .NOT. LIDMODEL) THEN
    CALL STEPO(CLCONF)
  ENDIF

!*       3.12  MODERR

  IF (LMODERR.AND.NTYPE_MODERR==2) CALL ADD_MODERR_AD(SPMODERR,GPMODERR,NSTEP)

!*       3.11  Corrector step.

  IF(NSITER > 0) THEN

    ! Last step:

    NCURRENT_ITER=NSITER
    CLCON9(1:9)='0AAS00AAA'
    CALL STEPOAD(CLCON9)

    ! Iteration step:

    DO JSITER = NSITER-1, 1, -1
      NCURRENT_ITER=JSITER
      CLCON9(1:9)='0AAS00AAS'
      CALL STEPOAD(CLCON9)
    ENDDO

  ENDIF

!*       3.10  Ordinary time step (predictor if PC scheme).
!              Initialize CLCON9 for call to STEPOAD

  CLCON9(1:9)='0AAA00AAA'
  NCURRENT_ITER=0

  IF (NSITER == 0) THEN
    CLCON9(9:9)='A'
  ELSEIF (NSITER > 0) THEN
    CLCON9(9:9)='T'
  ELSEIF(NSITER < 0) THEN
    CALL ABOR1('NEGATIVE NSITER NOT ALLOWED')
  ENDIF

  IF (LIDMODEL) THEN
    IF (JSTEP/=0) THEN
      CLCON9(2:2)='0'
      CLCON9(3:3)='0'
    ENDIF
    CLCON9(4:4)='0'
    CLCON9(5:5)='0'
    CLCON9(7:7)='0'
    CLCON9(8:8)='0'
    CLCON9(9:9)='0'
  ENDIF

!*       3.???  Observations (part not present in cnt4tl)

  IF (.NOT.LSIMOB)          THEN
    ! Real observations

    LLSLOT  = .FALSE.
    LLFIRST = .TRUE.
    LLSLOT_FGAT = .FALSE.
    CALL GSTATS(1832,0)
    DO JTSLOT=NACTIM,1,-1
      IF(LOBS.AND.NTSLVSTST(JTSLOT) == NSTEP ) THEN
        LLSLOT = .TRUE.
        LLSLOT_FGAT=( LLSLOT .AND. LIDMODEL )
        NTSLOTNO = IACTIM
        IF(LLFIRST) THEN
          LLFIRST  = .FALSE.
          NTSLOTNOS = IACTIM
        ENDIF
        NTSLOTNOE = IACTIM
        IACTIM = IACTIM-1
        IF (LOBSTL) THEN
          !  GOM-ARRAYS ALREADY PREPARED
        ELSE
          CLCONF(3:3) = 'C'
          CLCONF(6:6) = 'V'
        ENDIF
        WRITE(UNIT=NULOUT,FMT='('' CNT4AD (TEMPORAL LOOP);'' &
         & ,'' TIME SLOT NO : '',I3 &
         & ,'' TO BE USED WITH TIME STEP (NSTEP) : '',I3 &
         & ,'' ; MODEL TIME (SINCE START) : '',F6.0)')&
         & NTSLOTNO,NSTEP,ZSTATI
        CALL FLUSH(NULOUT)
        IF (LOBS)      THEN
          CALL OBSPREP('V')
        ENDIF
      ENDIF
    ENDDO
    CALL GSTATS(1832,1)
    IF ((.NOT.LTRAJGP .AND. .NOT. LIDMODEL) .OR. LLSLOT_FGAT ) THEN
      CALL STEPO(CLCONF)
    ENDIF

    IF(LLSLOT) THEN
      NTSLOTNO = NTSLOTNOE
      CLCON9(6:6)='V'
    ENDIF

    IF (CLCON9(1:9)/='000000000') CALL STEPOAD(CLCON9)
  ELSE

    ! Simulated observations

    ! Trajectory.
    IF(.NOT.LTRAJGP) THEN
      CALL STEPO(CLCONF)
    ENDIF
    ! Adjoint integration.
    CALL STEPOAD(CLCON9)

    IF(IREFTS(JSTEP/NFRREF) == 1.AND.MOD(JSTEP,NFRREF) == 0 &
       & .AND.NCONF == 801) THEN

      !* read observations and not trajectory
      LTRREF=.TRUE.
      IF(L801TL)THEN
        CLCONF(1:1)='V'
      ELSE
        CLCONF(1:1)='B'
      ENDIF
      CLCONF(2:9)='00000000'
      CALL STEPO(CLCONF)
      CALL COSTRA
      LTRREF=.FALSE.
    ENDIF
  ENDIF

!*       3.9.4 b  Comparison to reference state (AVARC)
  IF (LAVARC.AND.IHECPS(JSTEP) == 1) THEN
    WRITE(NULOUT,*) 'adjoint run AVARC event at JSTEP = ',JSTEP,' event= '&
     & , IAVARE
    IF (IAVARE < 1) THEN
      CALL ABOR1('AVARC error: IAVARE < 1 ')
    ENDIF
    CALL AVARCAD(IAVARE)
    IAVARE = IAVARE - 1
  ENDIF

!*       3.X  Weak Constraints 4D-Var

  IF (LMODERR) THEN
    iweak=MSTEPERR(NSTEP)
    IF (NTYPE_MODERR==1.AND.iweak>0) CALL WEAK_CONSTRAINT_AD
    IF (NTYPE_MODERR==4.AND.iweak>0) THEN
      IF (LJCDFI.AND.N_COUPLED_WINDOWS>1) THEN
        ipersub=NSTOP/N_COUPLED_WINDOWS
        isub=NSTEP/ipersub+1
        istep=0
        IDIGLST=2*NSTDFI
        IF (NSIM4D==0) THEN
          write(nulout,*)'CNT4AD: Calling DIGFILAD estep,isub,istep=',nstep,isub,istep
        ENDIF
        CALL DIGFILAD(istep, IDIGLST, isub, SPA3, SPD2D, SPA1, .TRUE.)
      ENDIF
      CALL ADD_MODERR_AD(SPMODERR,GPMODERR,NSTEP)
    ELSEIF (NTYPE_MODERR==5 .AND. iweak>0) THEN
      IF (NSIM4D == NSIM4DL) THEN
        CALL ADD_MODERR_AD(SPMODERR,GPMODERR,NSTEP,SPMODERR_HYB,GPMODERR_HYB)
      ELSE
        CALL ADD_MODERR_AD(SPMODERR,GPMODERR,NSTEP)
      ENDIF
    ENDIF
  ENDIF

!        3.1.1 b  Time filtering constraint based on digital filter
!                 is being computed
!                 Its contribution is added to SPA3, SPA2 and SPA1.

  IF (LJCDFI.AND.LUSEJCDFI) THEN
!   Step should be local to subwindow
    IF (N_COUPLED_WINDOWS>1) THEN
      isub=1
      istep=0
      IF (NSTEP>0) THEN
        ipersub=NSTOP/N_COUPLED_WINDOWS
        istep=MOD(NSTEP-1,ipersub)+1
        isub=(NSTEP-1)/ipersub+1
      ENDIF
    ELSE
      isub=1
      istep=NSTEP
    ENDIF
    IDIGLST = 2*NSTDFI
    IF (NSIM4D==0.AND.N_COUPLED_WINDOWS>0) THEN
      write(nulout,*)'CNT4AD: Calling DIGFILAD nstep,isub,istep=',nstep,isub,istep
    ENDIF
    CALL DIGFILAD(istep, IDIGLST, isub, SPA3, SPD2D, SPA1, .TRUE.)
  ENDIF

!*       3.???  Write-up of the gradient (part not present in cnt4tl).

  IF (NCONF == 601.AND. LLMLPP) THEN
    CLCONF='A00000000'
    IOUTTYPE=NOUTTYPE
    NOUTTYPE=1
    CALL STEPO(CLCONF)
    NOUTTYPE=IOUTTYPE
  ELSEIF (NCONF/100 == 1.OR.NCONF/100 == 8) THEN
    IF (   (IGRATS(NSIM4D/NFRGRA) == 1.AND.&
       & MOD(NSIM4D,NFRGRA) == 0.OR.NSIM4D == NSIM4DL)&
       & .AND.(IHISTS(NSTEP/NFRHIS) == 1.AND.&
       & MOD(NSTEP,NFRHIS) == 0)         )THEN

      IF (LGRASCAL) THEN
!              WRITE GRADIENT WITH RESPECT TO SCALP INNER-PRODUCT
!              SAVE GRADIENT WITH RESPECT TO STANDARD INNER-PRODUCT
        CALL CAININ (YL_ZVANA)
!              GET GRADIENT WITH RESPECT TO SCALP INNER-PRODUCT
        YL_ZVAGR = 0.0_JPRB
        IF (LFORCE) THEN
          CALL CAIN   (YSPFORCE)
        ENDIF
        CALL CAINAD (YL_ZVAGR)
        CALL CAIN   (YL_ZVAGR)
        LTWGRA = .TRUE.
        CLCONF(1:9)='A00000000'
        CALL STEPO(CLCONF)
        CALL PPFLUSH
        CALL PPCLOSE
        LTWGRA = .FALSE.
!  FETCH GRADIENT WITH RESPECT TO STANDARD INNER-PRODUCT
        CALL CAIN (YL_ZVANA)
      ELSE
!  WRITE GRADIENT WITH RESPECT TO IMPLICIT(STANDARD) INNER-PRODUCT
        IF (LFORCE) THEN
          CALL CAIN(YSPFORCE)
        ENDIF
        LTWGRA = .TRUE.
        CLCONF(1:9)='A00000000'
        CALL STEPO(CLCONF)
        CALL PPFLUSH
        CALL PPCLOSE
        LTWGRA = .FALSE.
      ENDIF
    ENDIF
    IF (LLWRELSG) THEN
      IF (((ILSGTS(NSTEP/NFRLSG) == 1.AND.MOD(NSTEP,NFRLSG) == 0) &
         & .OR.(NSTEP == 1)).AND.NSTEP /= 0) THEN
        CALL EWRLSGRAD
      ENDIF
    ENDIF
  ENDIF

!*       3.13  Copy state for use as forcing during the TL integration

  IF (L_EOFS) THEN
    IF (MOD((JSTEP+1),NSTEPS_PER_STATE)==0 .AND. JSTEP+1 < NSTOP) THEN
      I = (JSTEP+1)/NSTEPS_PER_STATE
      YSTATE_VECTOR_4D(I)%data = 0.0_JPRB
      CALL CAINAD (YSTATE_VECTOR_4D(I))
    ENDIF
  ENDIF

!*       3.15  Signal SMS event for completion of post_processing

  IF(LLMLPP) THEN
    IF(NOUTTYPE /= 2) THEN
      CALL PPFLUSH
      IF( LPPTSF )THEN
        CALL PPCLOSE
      ENDIF
    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 )

ENDDO TEMPORAL_LOOP

!*       3.20  Miscellaneous (deallocations and final call to SPNORM).

IF ((NCONF/100 == 1.OR.NCONF/100 == 8) .AND. LGRASCAL) THEN
  CALL DEALLOCATE_CTLVEC(YL_ZVANA)
  CALL DEALLOCATE_CTLVEC(YL_ZVAGR)
ENDIF

LLSPNRM=ISDITS(NSTEP/MAX(1,NFRSDI)) == 1.AND.MOD(NSTEP,MAX(1,NFRSDI)) == 0
IF (LLSPNRM.OR.NSIM4D<=1.OR.NSIM4D==NSIM4DL) THEN
  WRITE(UNIT=NULOUT,FMT='('' NORMS AT END CNT4AD '')')
  CALL SPNORM(0)
  CALL GPNORM_GFL
  IF (LMODERR) THEN
    llevs=(NPRTMODERR>=2)
    DO jj=1,NDIM_MODERR
      CALL SPECTRAL_NORM (SPMODERR(jj),'CNT4AD MODERR')
      CALL GRIDPOINT_NORM(GPMODERR(jj),'CNT4AD MODERR',llevs)
    ENDDO
  ENDIF
ENDIF

CALL GSTATS(23,1)
!      -----------------------------------------------------------------

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