SUBROUTINE SUOBSORT

!**** *SUOBSORT*  -  Setup observation sorting

!     Purpose.
!     --------
!           Setup observation sorting

!**   Interface.
!     ----------
!        *CALL* *SUOBSORT

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

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

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

!     Externals.
!     ----------

!        SETUP_OBSORT - SETUP OBSERVATION SORTING

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

!     Author.
!     -------
!        Heikki Jarvinen *ECMWF*

!     Modifications.
!     --------------
!        Original : 96-05-15
!        Modified : 
!     Erik Andersson - 971007 - To be called from 4D-Var with time corr.
!     Sami Saarinen  - 980803 - Fix the French CANARI problem with OBSORT
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCT0   , ONLY : NPROC    ,N_REGIONS_NS  ,N_REGIONS_EW ,&
 & LSCREEN  ,LCANARI  
USE YOMOBS   , ONLY : LINCREM
USE YOMMP    , ONLY : MYPROC
USE YOMCT0B

IMPLICIT NONE

CHARACTER (LEN = 80) ::  CLOUT

INTEGER(KIND=JPIM) :: IBYTES, ICOMMUNICATOR, ILAG, IMYPROC, IOUT,&
 & IPROC, IPROCA, IPROCB, IRET, IRET1, IRET2, &
 & IRET3, IRET4  

LOGICAL :: LL_OPEN_LOGFILE, LL_PARALLEL_PROC, LL_USE_LIB_OPTION
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE SETPARAM_OBSORT
#include "int_setparam_obsort.h"
#include "bool_setparam_obsort.h"
END INTERFACE

#include "abor1.intfb.h"

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

!*       1.    INITIALIZE OBSERVATION SORTING
!              ------------------------------

!           1.1   INITIALIZE

IF (LHOOK) CALL DR_HOOK('SUOBSORT',0,ZHOOK_HANDLE)
IPROCA = N_REGIONS_NS
IPROCB = N_REGIONS_EW
IMYPROC = MYPROC
IPROC = NPROC
ICOMMUNICATOR = 0
LL_OPEN_LOGFILE = .FALSE.
LL_USE_LIB_OPTION = .TRUE.
LL_PARALLEL_PROC = .FALSE.
IOUT = NULOUT

!     Pass consistent defaults to OBSORT and bail out
!     from subsequent problems in SUCMA under SETUP_OBSORT

CALL setparam_obsort(NULOUT,'INCREMENTAL_RUN', LINCREM, IRET)
CALL setparam_obsort(NULOUT,'CANARI_RUN', LCANARI, IRET)

CALL setparam_obsort(NULOUT,'VNPROCA', IPROC, IRET)
CALL setparam_obsort(NULOUT,'VNPROCB',     1, IRET)

!           1.2   SETUP OBSORT

IRET = 0
CALL SETUP_OBSORT(&
 & LL_OPEN_LOGFILE, LL_USE_LIB_OPTION, LL_PARALLEL_PROC,&
 & IOUT, CLOUT,&
 & IPROCA, IPROCB,&
 & IMYPROC, IPROC, ICOMMUNICATOR,&
 & IRET)  

!           1.2.1 TEST RETURN CODE

IF(IRET  /=  0) THEN
  WRITE(NULERR,'('' CANNOT SETUP OBS_SORT '')')
  CALL ABOR1('SUOBSORT: CANNOT SETUP OBS_SORT')
ENDIF

IF(LSCREEN.OR.LCANARI) THEN
  CALL WTFUNC_OBSORT(NULOUT,'NAMOBSORT_2',IRET)

!           1.3.1 TEST RETURN CODE

  IF(IRET  /=  0) THEN
    WRITE(NULOUT,'('' CANNOT SETUP OBS_SORT WEIGHT FUNCTION'')')
  ENDIF
ENDIF

!           1.4   SET OBS.SORT PARAMETERS

IBYTES = 4 * 1024 * 1024
ILAG = 0
CALL SETPARAM_OBSORT(NULOUT,'SORT_DATA',.TRUE.,IRET1)
CALL SETPARAM_OBSORT(NULOUT,'LBARRIER',.TRUE.,IRET2)
CALL SETPARAM_OBSORT(NULOUT,'MAX_MSGLEN',IBYTES,IRET3)
CALL SETPARAM_OBSORT(NULOUT,'MAX_MSGLAG',ILAG,IRET4)

!           1.5   TEST RETURN CODE

IF(IRET1 /= 0.OR. IRET2 /= 0.OR.IRET3 /= 0.OR. IRET4 /= 0) THEN
  WRITE(NULERR,'(A,4I4)')'Returns:',IRET1,IRET2,IRET3,IRET4
  CALL ABOR1('SUOBSORT: CANNOT SETUP OBS_SORT PARAMETERS')
ENDIF

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

!*       2.    RETURN
!              ------

2 CONTINUE
IF (LHOOK) CALL DR_HOOK('SUOBSORT',1,ZHOOK_HANDLE)
END SUBROUTINE SUOBSORT
