SUBROUTINE SU0YOMA

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

USE YOMLUN   , ONLY : NULOUT   ,NULNAM
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE YOMCT0   , ONLY : LFPART2  ,NPRINTLEV, LMINIM   ,LELAM    ,NPROC&
                    &,NCONF
USE ENKF_MIX , ONLY : SETUP_ENKF
USE MPL_MODULE,ONLY : MPL_BARRIER

!**** *SU0YOMA*  - INITIALIZE LEVEL 0 COMMONS AND SOME HIGHER (PART 1)

!     PURPOSE.
!     --------
!           INITIALIZE LEVEL 0 COMMONS (CONSTANT ALONG ALL THE JOB)
!        AND SOME HIGHER LEVEL COMMONS. CALLS ROUTINES THAT PERFORM
!        ALL THE PREPARATIONS NEEDED TO EXECUTE MODEL. THE TASK OF
!        INITIALIZING THE COMMONS IS DIVIDED BETWEEN TWO ROUTINES
!        (SU0YOMA AND SU0YOMB) TO AVOID PROBLEMS WITH USING POINTER
!        ARRAYS WHOSE DIMENSIONS ARE NOT DEFINED UNTIL AFTER CALLING
!        SUDIM.
!**   INTERFACE.
!     ----------
!        *CALL* *SU0YOMA*

!        EXPLICIT ARGUMENTS
!        --------------------
!        NONE

!        IMPLICIT ARGUMENTS
!        --------------------
!        NONE

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------
!      SUMPINI- DETERMINE IF SHARED MEMORY OR DISTRIBUTED MEMORY IS USED
!      SULUN  - INITIALIZE LOGICAL UNITS
!      SUARG  - Get command line argument
!      SUMP0  - INITIALIZE MESSAGE PASSING INTERFACE
!      SURIP  - INITIALIZE MODEL TIME
!      SUCT0  - INITIALIZE CONTROL COMMON BLOCK OF LEVEL 0
!      SUDYNA - INITIALIZE DYNAMICS: PART A.
!      SUVAR  - INITIALIZE CONTROL OF VARIATIONAL ASS.
!      SUMTTH - Enable multitasking trace history.
!      SUFA   - INITIALIZE GRIB packing options
!      SUAFN  - INITIALIZE ARPEGE FIELD NAMES AND DESCRIPTORS
!      SUNMI  - INITIALIZE COMMON YOMNMI FOR NORMAL MODE INITIALIZATION
!      SUINI - INITIALIZE COMMON YEMINI FOR FOR DIG. FIL. INI. AND ALADIN-NMI
!      SUCST  - INITIALIZE CONSTANTS
!      SUTRAJP- INITIALIZE CONTROL OF THE ADJOINT PHYSICS
!      SUNDDH - LECTURE NAMELIST DIAGNOSTICS DDH
!      SUTIM  - INITIALIZE COMPUTER TIME
!      SUVWRK - INITIALIZE SSD handling
!      SUFPC  - INITIALIZE FULL POST PROCESSING (scientif. and techn. options)
!      SUDIM  - INITIALIZE DIMENSIONS
!      SUGFL  - INITIALIZE definition of unified_treatment grid-point fields
!      SUFPD  - INITIALIZE FULL POST PROCESSING (horizontal domains)
!      SUIOMI - INITIALIZE IO for minimization
!      SUECHK - INITIALIZE GRIDPOINT EVOLUTION DIAGNOSTICS
!      SUJB   - INITIALIZE Jb parameters
!      SU0PHY - INITIALIZE Physics switches
!      SUHLOPTION - INITIALIZE Physics switches
!      SUGPPRP- INITIALIZE Relative pointers
!      SUALLO - ALLOCATE SPACE FOR ARRAYS
!      SUECT0   INITIALIZE CONTROL COMMON BLOCK OF LEVEL 0 FOR ALADIN
!      SUELLO - ALLOCATE SPACE FOR ARRAYS FOR ALADIN

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

!     AUTHOR.
!     -------
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL      :87-10-15
!        BILL HECKLEY  :88-12-07  INTRODUCTION OF OPTION OF COMPUTING
!                                NORMAL MODES LCONMO
!        ALAIN JOLY    :90-08-10 INTRODUCTION INITIALISATION DDH
!        D. VASILJEVIC :90-11-20 CHANGE TO YOMCOS SET-UP
!        BILL HECKLEY  :91-06-06 First guess control - SUJG0
!        J.J. MORCRETTE:91-11-12 Switches for Physics SU0PHY
!        M. DEQUE      :92-09-20 Switches for climate version SUMCC
!        R. El Khatib  :93-04-02 Initialize model time after leel 0
!                                control common
!        G. RADNOTI:92-12-24 Digital filter and gridpoint diagnostics setup
!        R. El Khatib  :93-05-06 Set-up through command line
!        R. El Khatib  :94-03-02 Full-POS set-up
!        J.M. Piriou   :94-04-12 DDH set-up after dimensions set-up
!        M.Hamrud      :95-01-10 Remove calls to Cray RNL.. routines
!        MPPGroup ECMWF:95-10-01 Support for distributed memory
!        F. Bouttier   :96-02-06 Replace sujg0 by sujb, improve listing look
!        M. Deque      :96-07-01 Call to nudging set-up
!        R. El Khatib  :98-10-12 Move suafpos into subfpos
!        D.Dent        :99-05-06 More flexible FULL-POS post-processing options
!        C.Jakob       :00-05-15 Add setup of character arrays for DDH-SUCDDH
!        D.Dent        : 00-09-01  MPE to MPL conversion
!        R. El Khatib  : 01-01-26 SUCDDH moved inside SUNDDH
!        R. El Khatib  : 01-02-01 SUCFU/XFU moved to su0yomb after call susta
!        Modified 08-2002 C. Smith : use "w" as prognostic variable in the
!         semi-lag advection of vertical divergence in the NH model.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        C. Fischer    : 04-02-25 Merge Aladin into Arpege/IFS su0yoma
!        T.Kovacic     :04-03-01 Diagnostics on physical tendencies setup
!        R. El Khatib  : 04-08-05 suedim moved inside sudim2
!        15-Mar-2005 R. El Khatib SUJFH
!        C. Temperton  : 06-09-05 avoid calling SUJB if NCONF=201
!        A. Fouilloux  : do not set up arrays for observations
!     ------------------------------------------------------------------

IMPLICIT NONE

CHARACTER (LEN = 35) ::  CLINE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "su0phy.intfb.h"
#include "suhloption.intfb.h"
#include "suafn.intfb.h"
#include "suallo.intfb.h"
#include "suarg.intfb.h"
#include "suchet.intfb.h"
#include "sucst.intfb.h"
#include "suct0.intfb.h"
#include "sudim1.intfb.h"
#include "sudim2.intfb.h"
#include "sudyna.intfb.h"
#include "suechk.intfb.h"
#include "suect0.intfb.h"
#include "suini.intfb.h"
#include "suello.intfb.h"
#include "sufa.intfb.h"
#include "sufpc.intfb.h"
#include "sufpd.intfb.h"
#include "sugfl.intfb.h"
#include "suiomi.intfb.h"
#include "sujb.intfb.h"
#include "sulun.intfb.h"
#include "sump0.intfb.h"
#include "sumpini.intfb.h"
#include "sumsc.intfb.h"
#include "sunddh.intfb.h"
#include "sunmi.intfb.h"
#include "sunud.intfb.h"
!#include "surlx.intfb.h"
#include "surip.intfb.h"
#include "sutim.intfb.h"
#include "sutrajp.intfb.h"
#include "suvar.intfb.h"
#include "suvwrk.intfb.h"
#include "sujfh.intfb.h"
#include "su_surf_flds.intfb.h"

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

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

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

CLINE='----------------------------------'

!*    Determine if message passing or shared memory version is used
IF( .NOT.LFPART2 ) THEN
  CALL SUMPINI(NULNAM)
ELSE
  IF( NPROC > 1 )THEN
    CALL MPL_BARRIER(CDSTRING='SU0YOMA:')
  ENDIF
ENDIF

!*    Initialize YOMLUN
CALL SULUN(NULOUT)
WRITE(NULOUT,*) '--- End of logical units setup ------',CLINE

!*    Initialize machine-specific constants
WRITE(NULOUT,*) '--- Set up machine-specific constants',CLINE
CALL SUMSC(NULOUT)

!*    Get command line arguments
WRITE(NULOUT,*) '--- Set up command line arguments ---',CLINE
CALL SUARG

CALL GSTATS(1934,0)

!*    Initialize level 0 control common
WRITE(NULOUT,*) '--- Set up control common 0 ---------',CLINE
CALL SUCT0(NULOUT)
IF (LELAM)  CALL SUECT0(NULOUT)

!*    Initialize Ensemble Kalman Filter options

WRITE(NULOUT,*) '--- Set up ENKF options ---------',CLINE
CALL SETUP_ENKF


!     Initialize MASS VF Option
WRITE(NULOUT,*) '--- Set up MASS VF Option ---------',CLINE
CALL SUJFH

!*    Initialize dynamics: part A
WRITE(NULOUT,*) '--- Set up dynamics part A ---------',CLINE
CALL SUDYNA(NULOUT)

!*    Initialize message passing interface
WRITE(NULOUT,*) '--- Set up message passing interface ',CLINE
CALL SUMP0(NULOUT,NULNAM)

!*    Initialize control of variational assimilation
WRITE(NULOUT,*) '---- Set up variational assimilation ',CLINE
CALL SUVAR(NULOUT)

!*    Initialize GRIB packing options
WRITE(NULOUT,*) '--- Set up GRIB packing options ---',CLINE
CALL SUFA

!*    Initialize model time
WRITE(NULOUT,*) '------ Set up model time ------------',CLINE
CALL SURIP(NULOUT)

!*    Initialize control of NMI and DFI
WRITE(NULOUT,*) '------ Set up NMI/DFI initialization ',CLINE
CALL SUINI
CALL SUNMI

!*    Initialize constants
WRITE(NULOUT,*) '------ Set up constants -------------',CLINE
CALL SUCST(NULOUT,NINDAT,NSSSSS,NPRINTLEV)

!*    Initialize control of physical parameterizations
WRITE(NULOUT,*) '-- Set up physical parameterizations ',CLINE
CALL SU0PHY(NULOUT)

!*    Initialize control of Hirlam physical parameterizations
WRITE(NULOUT,*) '-- Set up Hirlam physical parameterizations ',CLINE
CALL SUHLOPTION(NULOUT)

!*    Initialize control of the adjoint physics
WRITE(NULOUT,*) '------ Set up adjoint physics -------',CLINE
CALL SUTRAJP

!*    Initialize computer time
WRITE(NULOUT,*) '------ Set up computer time ---------',CLINE
CALL SUTIM(NULOUT)

!*    Initialize rwrk path names
WRITE(NULOUT,*) '------ Set up rwrk path names -------',CLINE
CALL SUVWRK(NULOUT)
CALL GSTATS(1934,1)

!*    Initialize Nudging
WRITE(NULOUT,*) '------ Set up Nudging ',CLINE
CALL SUNUD(NULOUT)

!*    Initialize dimensions (part 1)
WRITE(NULOUT,*) '------ Set up array dimensions(part 1)  ------',CLINE
CALL SUDIM1

! ky: this call to GSTATS is suspicious, to be checked by ECMWF people!!!
CALL GSTATS(1934,0)

!*    Set up unified_treatment grid-point fields
WRITE(NULOUT,*) '---- Set up unified_treatment grid-point fields -',CLINE
CALL SUGFL

!*    Set up for surface grid-point fields
WRITE(NULOUT,*) '---- Set up for surface grid-point fields ----',CLINE
IF (NCONF /= 911 .AND. NCONF /= 912) THEN
  CALL SU_SURF_FLDS
ENDIF

!*    Initialize Arpege field names and descriptors
WRITE(NULOUT,*) '--- Set up Arpege file descriptors ',CLINE
CALL SUAFN

!*    Initialize full post processing (scientif. and techn. options)
WRITE(NULOUT,*) '------ Set up F-post processing options ',CLINE
CALL SUFPC(' ')

!*    Initialize Jb parameters
CALL GSTATS(1934,1)
WRITE(NULOUT,*) '------ Set up Jb parameters ------------',CLINE
! Dirty fix! 
IF (NCONF /= 201) THEN
  CALL SUJB
ENDIF
CALL GSTATS(1934,0)

!*    Initialize dimensions (part 2)
WRITE(NULOUT,*) '------ Set up array dimensions(part 2)  ------',CLINE
CALL SUDIM2

!*    Initialize DDH (Horizontal domains diagnostics)
WRITE(NULOUT,*) '------ Set up DDH diagnostics --------',CLINE
CALL SUNDDH

!*    Initialize full post processing (horizontal domains)
WRITE(NULOUT,*) '------ Set up F-post processing domains ',CLINE
CALL SUFPD

!*    Initialize minimisation I/O scheme if necessary
IF (LMINIM) THEN
  WRITE(NULOUT,*) '------ Set up minimization I/O -------',CLINE
  CALL SUIOMI(NULOUT)
ENDIF

!*    Initialize gridpoint evolution diagnostics
WRITE(NULOUT,*) '------ Set up gridpoint diagnostics ----',CLINE
CALL SUECHK


!*    Initialize diagnostics on physical tendencies
WRITE(NULOUT,*) '------ Set up diagnostics on phys. tendencies -',CLINE
CALL SUCHET

!*    Allocate grid point and spectral arrays
WRITE(NULOUT,*) '------ Set up : array allocations ------',CLINE
CALL SUALLO
IF(LELAM) CALL SUELLO

CALL GSTATS(1934,1)

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

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