SUBROUTINE CNT3

!**** *CNT3*  - Controls integration job at level 3

!     Purpose.
!     --------

!**   Interface.
!     ----------
!        *CALL* *CNT3

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

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

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

!     Externals.
!     ----------
!      Calls SU3YOM, SUALSPA, RERESF, CSTA, UPSPEC, SUORCTV, ARCHFP,
!            CNMI, CMAC, FLTMODE, FLTRG, DFI, CNT4, SPNORM.
!      Called by CNT2, TESTLI, ...

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

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

!     Modifications.
!     --------------
!        Original : 87-10-15
!        Modified : 90-01-22 Bill Heckley - option to filter initial state
!        Modified : 91-09-25 p.c and JN.T - remove useless logic
!        Modified : 92-10-19 Bill Heckley - reduce gravity mode amplitude
!                                           to aid 3/4DVAR conditioning
!        Modified : 92-12-24 G. Radnoti   - option for digital filter init.
!        Modified : 92-12-25 J-N Thepaut  - update spectral array (conf 131)
!        Modified : 93-04-13 L. Labbe     - Init. grid point orography as
!                                           control variable
!        Modified : 94-03-03 R. El Khatib - Full-POS inplementation
!        Modified : 94-03_09  "   "       - Use of NMI after the run (821)
!        Modified : 94-07-05 J-N Thepaut  - dummy call to cnt4 (conf 131)
!        Modified : 94-07-26 D. Giard     - call to MATCLOSE after filtering
!        Modified : 95-09-04 R. El Khatib - FullPOS internal part 2 out of CNT4
!        Modified : 95-10-30 M.Hamrud     - Changed CLCONF
!        Modified : 95-09-25 J.-N Thepaut - write spec traj with FullPos
!        Modified : 97-10-02 D. Dent      - replace SECOND with USER_CLOCK
!        Modified : 98-10-05 A. Untch     - setup ozone chemistry if restart
!        Modified : 99-09-17 M. Fisher    - Don't modify SITR and SIPR
!        Modified : 00-11-06 J. Barkmeijer- Use perturbed tendencies
!        R. El Khatib : 01-08-07 Pruning options
!        Modified : 02-09-30 V.Guidard&C.Fischer - 3dfgat coupling switched on
!        J. Masek : 12-10-2002: Call of SUPONG moved from SUDYN.
!    R. El Khatib : 02-21-20 Fullpos B-level distribution + remove IO scheme
!    R. El Khatib : 02-11-12  Pruning LREFFP
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        C. Fischer 04-02-26 Merge Aladin into Arpege/IFS cnt3
!        C. Fischer 04-10-20 call sueqlimsat
!        Y.Tremolet    21-Jul-2004 Model error
!        M. Jidane : 13-04-2006 : SWAP37 NO MORE IN USE
!        M. Drusch:    17-Jan-2007 introduce nconf 302
!        B. Chapnik:  22-sep-2008 allows upspec for aladin
!        G. Desroziers 22-Dec-2008: Enable transf. of ARPEGE file in GRIB format (to be used in femars)
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG, NFLEVL, NSPEC2 ,NSMAX
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LFPART2, NCONF, NSTOP, LNF, LOBSC1, LELAM, NPROC
USE YEMCT0   , ONLY : LEQLIMSAT
USE YOMNMIA  , ONLY : NVMOD    ,NVMODPP  ,LNMIRQ   ,LSTDNMI  ,&
 & LNPROJ  
USE YOMINI   , ONLY : NEINI
USE YOMTIM   , ONLY : RSTART   ,RVSTART  ,RTIMEF
USE YOMVAR   , ONLY : LTEST    ,LINITCV, LFEMARSF, LFEMARSD
USE YOMMP    , ONLY : NUMVMO
USE YOEPHY   , ONLY : LEO3CH, LEPCLD, LEPHYS
USE YOERAD   , ONLY : LECO2VAR, LHGHG
USE YOMPHY   , ONLY : LREASUR
USE YOMSP    , ONLY : SPA3     ,SPA2     ,SPVOR    ,SPDIV    ,&
            &SPT     ,SPQ      ,SPSP     ,SPOR
USE YOMGEM   , ONLY : VAH, VBH
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE STOPH_MIX , ONLY : LFORCENL 
USE GFL_SUBS_MOD , ONLY : DEACT_CLOUD_GFL, REACT_CLOUD_GFL

IMPLICIT NONE

LOGICAL :: LLOVER

REAL(KIND=JPRB) :: ZCT, ZVT, ZWT
REAL(KIND=JPRB), ALLOCATABLE :: ZSPA3(:,:,:), ZSPA2(:,:)

CHARACTER (LEN = 9) ::  CLCONF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "user_clock.h"
END INTERFACE

#include "cmac.intfb.h"
#include "cnmi.intfb.h"
#include "cnt4.intfb.h"
#include "pertsekf_v2.intfb.h"
#include "cprep4.intfb.h"
#include "csta.intfb.h"
#include "dealnmi.intfb.h"
#include "dfi.intfb.h"
#include "elsac.intfb.h"
#include "fltmode.intfb.h"
#include "opdis.intfb.h"
#include "reresf.intfb.h"
#include "spnorm.intfb.h"
#include "su3yom.intfb.h"
#include "su4fpos.intfb.h"
#include "sueqlimsat.intfb.h"
#include "suforce.intfb.h"
#include "supong.intfb.h"
#include "swap73.intfb.h"
#include "updo3ch.intfb.h"
#include "updrgas.intfb.h"
#include "upspec.intfb.h"
#include "grbspa.intfb.h"
#include "suinif.intfb.h"

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

!*       1.    Initialize LEVEL 3 COMMONS.
!              ---------------------------

IF (LHOOK) CALL DR_HOOK('CNT3',0,ZHOOK_HANDLE)
WRITE(UNIT=NULOUT,FMT='('' START CNT3'')')
CALL SU3YOM
IF (LEPHYS) THEN
  IF (LEPCLD) THEN
    CALL REACT_CLOUD_GFL
  ELSE
    CALL DEACT_CLOUD_GFL
  ENDIF
ENDIF
!      -----------------------------------------------------------

!*       2.    RESTART.
!              --------

IF(NCONF == 1.OR.NCONF == 302) THEN
!  ** OPDIS IS CALLED HERE ONLY TO AVOID MEMORY FRAGMENTAION **
  CLCONF='000000000'
  CALL USER_CLOCK(PELAPSED_TIME=ZWT,PVECTOR_CP=ZVT,PTOTAL_CP=ZCT)
  ZCT=ZCT-RSTART
  ZVT=ZVT-RVSTART
  ZWT=ZWT-RTIMEF
  CALL OPDIS(CLCONF,'CNT3    ',ZCT,ZVT,ZWT,RSTART,RVSTART,RTIMEF)
ENDIF

IF (.NOT.LELAM) THEN

!*       3.0   ARPEGE/IFS INITIALIZATION
!              -------------------------

  IF ((NCONF == 1.OR.NCONF == 302).AND..NOT.LFPART2) THEN
    CALL RERESF
!   SETUP OZONE CHEMISTRY IN CASE OF RESTART
    IF(.NOT.LNF.AND.LEO3CH) THEN
      CALL UPDO3CH
    ENDIF
    IF(.NOT.LNF.AND.(LECO2VAR.OR.LHGHG)) THEN
      CALL UPDRGAS
    ENDIF
  ELSE
    LNF=.TRUE.
  ENDIF
!      -----------------------------------------------------------

!*       3.    START.
!              ------

  IF (LNF) THEN
    IF (LFORCENL) CALL SUFORCE
    CALL CSTA
  ENDIF

!*       3.0  PERTURB INITIAL CONDITIONS FOR THE SEKF RUN
!             -------------------------------------------

  IF (NCONF == 302) THEN
    CALL PERTSEKF_V2
  ENDIF

!*       3.1   OASIS3 check
!              ------------
  CALL SETOASIS3

!*       3.2   Update spectral array.
!              ----------------------

  IF (.NOT.LFPART2) THEN
    IF (LOBSC1.AND.LINITCV) CALL UPSPEC
  ENDIF

!*      3.3   Read in ARPEGE format and write in GRIB format
!             ----------------------------------------------

  IF (LFEMARSF.OR.LFEMARSD) THEN
    IF (NPROC /= 1) THEN
      WRITE (NULOUT,*)'CNT3: must run conf CNT3 with LFEMARSF or LFEMARSD with one proc only !'
      CALL ABOR1('CNT3: ABOR1 CALLED')
    ENDIF
!   Read first file
    LREASUR=.FALSE.
    CALL SUINIF(6)
    IF (LFEMARSD) THEN
      ALLOCATE (ZSPA3(SIZE(SPA3,1),SIZE(SPA3,2),SIZE(SPA3,3)))
      ALLOCATE (ZSPA2(SIZE(SPA2,1),SIZE(SPA2,2)))
      ZSPA3(:,:,:)=SPA3(:,:,:)
      ZSPA2(:,:)=SPA2(:,:)
!     Read second file and make the difference
      CALL SUINIF(7)
      SPA3(:,:,:)=SPA3(:,:,:)-ZSPA3(:,:,:)
      SPA2(:,:)=SPA2(:,:)-ZSPA2(:,:)
      DEALLOCATE (ZSPA3)
      DEALLOCATE (ZSPA2)
    ENDIF
    WRITE(NULOUT,*) 'norms of increments at date ',NINDAT
    CALL SPNORM(0)
!   Write in GRIB format
    CALL GRBSPA(NFLEVL,NSMAX,NSPEC2,VAH,VBH,SPVOR,SPDIV,SPT,SPQ,SPSP,&
   &SPOR,NINDAT,NSSSSS)
    IF (LHOOK) CALL DR_HOOK('CNT3',1,ZHOOK_HANDLE)
    RETURN
  ENDIF

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

!*       4.    FILTERING
!              ---------

  IF (.NOT.LFPART2) THEN

!*       4.1   Jc COMPUTATION.
!              ---------------
!        ALL COMPUTATION IN CNT3AD

!*       4.2   NORMAL MODE INITIALIZATION.
!              ---------------------------

    IF(LNF) THEN
      CALL SPNORM(0)
      IF (LNMIRQ) THEN
        IF (LSTDNMI) THEN
          CALL CNMI
        ELSE
          CALL CMAC
        ENDIF
      ELSEIF (LNPROJ) THEN
        CALL FLTMODE(NVMOD,NVMODPP,NUMVMO)
      ENDIF
    ENDIF

!*       4.4   Jg COMPUTATION.
!              ---------------
!        ALL COMPUTATION IN CNT3AD

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

!*       4.5   DIGITAL FILTER INITIALIZATION
!              -----------------------------

    IF (LNF.AND.(NEINI == 2.OR.NEINI == 4)) CALL DFI

  ENDIF

ELSE

!*       4.7   LAM INITIALIZATION
!              ------------------

  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  
    IF(LTEST.AND.NCONF == 801) CALL SWAP73
    CALL ELSAC
    IF(LTEST.AND.NCONF == 801) CALL SWAP73
  ENDIF

  IF (.NOT. LFPART2 .AND. LEQLIMSAT) CALL SUEQLIMSAT

  ! sponge setup
  IF ( NFLEVG > 1 ) THEN
    CALL SUPONG
  ENDIF

ENDIF

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

!*       5.    INTEGRATION.
!              ------------

IF (.NOT.LFPART2) THEN

! Deallocate arrays only used in normal mode initialization

  IF (NCONF/100 == 0 .OR. NCONF == 302) THEN
    CALL DEALNMI
  ENDIF

  CALL CNT4

ELSE
  CALL SU4FPOS(INT(0,JPIB))
  CLCONF(1:1)='0'
  CALL CPREP4(CLCONF,LLOVER)
ENDIF

WRITE(UNIT=NULOUT,FMT='('' END CNT3'')')

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

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