!OPTION! -Nfusion -O nounroll -O reorderrange=bblock
!OPTION! -pvctl noloopfusion -pvctl nocollapse -pvctl noouterunroll
SUBROUTINE ECSET(KTSLOTNO,KOBTOT,KOFFTOT)

!**** *ECSET* - PREPARATION OF THE NON-CORRELATED OBSERVATION SETS.
!****           IN THIS VERSION THE OBS SETS ARE PREPARED AND THEIR
!****           IDENTIFICATION STORED IN TABLES.

!     PURPOSE.
!     -------
!           PREPARE THE OBSERVATIONS SET  BY SET . ONE SET
!     CONTAINS UP TO NMXLEN OBSERVATIONS OF THE SAME TYPE. THE
!     PREPARATION INCLUDES THE EXTRACTION OF THE POSITION NUMBER
!     IN OBA FOR EACH OBSERVATION OF THE SET  AND STORAGE IN AN
!     AD HOC TABLE TO BE PASSED TO THE AD HOC ROUTINE TREATING THE
!     APPROPRIATE OBS TYPE ON THE APPROPRIATE PROCESSOR (DONE BY OBSV).

!**   INTERFACE.
!**   ---------
!**   *CALL* * ECSET*
!**         THE COMMON YOMOBA IS AN IMPLICIT INPUT OF ECSET BECAUSE
!**         OF THE DIFFERENT POINTERS NEEDED TO FETCH THE OBS NUMBERS.
!**         THE COMMON YOMOBSET IS AN IMPLICIT OUTPUT OF ECSET AS IT
!**         CONTAINS THE DESCRIPTION OFTHE OBS SETS.

!     EXTERNALS.  NONE
!     ----------

!     AUTHOR: JEAN PAILLEUX AND PATRICK MOLL
!     DATE  : 90-11-23

!     MODIFICATIONS
!     -------------
!        D. Vasiljevic : 91-02-10
!        M. Hamrud     : 95-09-18 New CMA format
!     E.Andersson 960201 : Incorporating Scat under SURFACEO
!     R. Randriamampianina: 97-04-17 ALADIN 3DVAR
!     E.Andersson 010207 : Fully vectorized version.
!                          Sets defined according to SAT_data_groups
!        S. Saarinen   : 13-Jun-2002 KSETs cannot anymore span over timeslots
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        N.Bormann     23-Dec-2004 RARAD becomes LIMB; NLIMBGRP sets for LIMB
!        D.Tan         20-Mar-2007 Increase INGRP(7) for Aeolus
!        S. Saarinen   : 20-Sep-2007 NSETOT distribution across the MPL-tasks
!        S. Saarinen   : 28-Sep-2007 Sort GRPs within ITYPOB for better load balance

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE MPL_MODULE, ONLY: MPL_GATHERV
USE YOMLUN   , ONLY : NULERR   ,NULOUT
USE YOMDIMO  , ONLY : NMXSET   ,NMXLEN   ,L_SPAN_KSETS_ACROSS_TSLOTS
USE YOMCMA   , ONLY : NMXOTP
USE YOMCT0   , ONLY : LELAM    ,NPROC
USE YOMOBSET , ONLY : MTYPOB   ,MLNSET   ,NSETOT   ,MMXBDY   ,MTSLSET
USE YOMOBSET_THSAFE
USE YOMCOCTP , ONLY : NSYNOP   ,NAIREP   ,NSATOB   ,NDRIBU   ,&
 & NTEMP    ,NPILOT   ,NSATEM   ,NPAOB    ,&
 & NSCATT   ,NRADAR, NLIMB  
USE YOMANCS  , ONLY : RMDI
USE YOMDB
USE YOMCOSJO , ONLY : LTC
USE YOMTVRAD , ONLY : SATGRP_TABLE  ,NSATGRP  , CHSENSOR, MXSENSOR, &
                    & SATOBGRP_TABLE,NSATOBGRP, CHMETHOD, MXMETHOD
USE YOMLIMB  , ONLY : NLIMBGRP
USE YOMMP ,  ONLY   : MYPROC
USE ECSORT_MIX,  ONLY   : KEYSORT
USE OML_MOD, ONLY : OML_MAX_THREADS

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTSLOTNO
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTOT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KOFFTOT 

INTEGER(KIND=JPIM) :: ITYPLIST(NMXOTP),IOTP_GRP(KOBTOT),INGRP(NMXOTP)
CHARACTER(LEN=8)   :: CLTYPNAME(NMXOTP)
LOGICAL   :: LLDONE(KOBTOT), LLNEWGRP
INTEGER(KIND=JPIM) :: ITID
INTEGER(KIND=JPIM) :: ILISTLEN,ISET,IOTP
INTEGER(KIND=JPIM) :: IBINTAG,ICOUNT,IREST,INSET,ISTASET,IENDSET
INTEGER(KIND=JPIM) :: IGRP,INSETOT,IC
INTEGER(KIND=JPIM) :: IGRPTOT,IGRPSCALE
INTEGER(KIND=JPIM) :: ISENSOR,IMETHOD,IMETHODGRP,ICODETYPE,ITYPOB,ISATID
INTEGER(KIND=JPIM) :: JOTP,JGRP,JOBS,JSET
INTEGER(KIND=JPIM) :: INFO(0), IRET, IKEY, IMULTIKEY(2)
REAL(KIND=JPRB) :: ZINFO(0)
INTEGER(KIND=JPIM) :: INSETOT_RECV(NPROC), INSETOT_SEND(1)
INTEGER(KIND=JPIM) :: IRECVCOUNTS(NPROC), INSETOT_SUM, JROC
REAL(KIND=JPRB) :: ZSUMMA, ZSUMSQR, ZAVG, ZSTDEV, ZTMP
INTEGER(KIND=JPIM) :: INUMTSL, JT, ITSLOFF, I1, I2, INUMT
INTEGER(KIND=JPIM), ALLOCATABLE :: JSTA(:), JEND(:), ISETIDX(:), IREVIDX(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSUMBDY(:), ZSETWT(:,:)
INTEGER(KIND=JPRB), ALLOCATABLE :: ISORTSETS(:,:)
INTEGER(KIND=JPIM) :: INUMSETS, IMAX, ISTA_SATEM, IEND_SATEM
INTEGER(KIND=JPIM) :: IWT, IOBS, ISTAJOBS, IENDJOBS, ILOC(1)
REAL(KIND=JPRB) :: ZLNSETS, ZAVGFILL, ZFILL, ZWT
CHARACTER(LEN=25) :: CLOBSGRP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     -------------------------------------------------------------
!*       1. INITIALIZE
!*          ----------

!*          1.1   Initialize ODB

INTERFACE
#include "getdb.h"
#include "putdb.h"
#include "abortdb.h"
END INTERFACE

#include "abor1.intfb.h"
#include "settc.intfb.h"

#include "openmp_obs.h"

IF (LHOOK) CALL DR_HOOK('ECSET',0,ZHOOK_HANDLE)
CALL GSTATS(1761,0)
CALL GETDB('ECSET', 0, IRET, INFO, 0,ZINFO,0, &
 & -1, KTSLOTNO, -1, -1, -1, -1)  

IF (IRET /= KOBTOT) THEN
  WRITE(NULERR,'('' ** INCONSISTENT NO. OF OBSERVATIONS FROM GETDB'')')
  WRITE(NULERR,*) 'For timeslot=',KTSLOTNO,' expecting =',KOBTOT, &
   & ', but got =',IRET  
  CALL ABORTDB('ECSET','INCONSISTENCIES FROM GETDB',IRET)
ENDIF

!*          1.1.1 Define parameters for TSLOT-loop to enforce only one TSLOT per KSET
!                 Needed for multipool approach of ODB
!                 Note: We assume that the 'ecset.sql' has been sorted w.r.t. TSLOT-parameter

IF (KTSLOTNO > 0) THEN
  INUMTSL = 1
  ALLOCATE(JSTA(INUMTSL))
  ALLOCATE(JEND(INUMTSL))
  JSTA(1) = 1
  JEND(1) = KOBTOT
  ITSLOFF = KTSLOTNO - 1 ! Used to offset the JT
ELSE
  IF(KOBTOT > 0) THEN
    INUMTSL = MAXVAL(ROBSU(1:KOBTOT,MDB_TSLOT_AT_INDEX))
  ELSE
    INUMTSL = 0
  ENDIF
  ALLOCATE(JSTA(INUMTSL))
  ALLOCATE(JEND(INUMTSL))
  ITSLOFF = 0 ! Used to offset the JT
  JOBS=0
  DO JT=1,INUMTSL
!=== Note: We assume that the 'ecset.sql' has been sorted w.r.t. TSLOT-parameter
    IF (JT == 1) THEN
      IF (KOBTOT>0) THEN
        IC = COUNT(ROBSU(1:KOBTOT,MDB_TSLOT_AT_INDEX) == JT+ITSLOFF)
      ELSE
        IC = 0
      ENDIF
    ELSE ! JT > 1
      IF (KOBTOT>0) THEN
        IC = COUNT(ROBSU(JEND(JT-1)+1:KOBTOT,MDB_TSLOT_AT_INDEX) == JT+ITSLOFF)
      ELSE
        IC = 0
      ENDIF
    ENDIF
    JSTA(JT) = JOBS + 1
    JEND(JT) = JOBS + IC
    JOBS = JOBS + IC
  ENDDO
  IF (JOBS /= KOBTOT) THEN
    WRITE(NULERR,*) '*** ERROR IN ECSET: JOBS /= KOBTOT'
    WRITE(NULERR,*) '    JOBS, KOBTOT=',JOBS, KOBTOT
    WRITE(NULERR,*) '    In ecset.sql, dada possibly not sorted w.r.t. TSLOT-parameter'
    CALL ABORTDB('ECSET','FATAL PROGRAMMING ERROR',JOBS)
  ENDIF
ENDIF

WRITE(NULOUT,'(1x,a,2i6,i12)')'ECSET: KTSLOTNO, INUMTSL, KOBTOT=',KTSLOTNO, INUMTSL, KOBTOT
DO JT=1,INUMTSL
  WRITE(NULOUT,'(1x,a,2i6,2i12)')'>> JT, TIMESLOT#,  JSTA(JT), JEND(JT)=',&
   & JT, JT+ITSLOFF, JSTA(JT), JEND(JT)  
ENDDO
!CALL FLUSH(NULOUT)

!*          1.2   Define the order of processing

!     This list defines the reverse order in which the sets are 
!     processed in TASKOB.
!     We want the cheapest (scat) done last and the dearest (radiances) first.
!     For some observation types the obs_operators require that certain
!     subgroups are treated separately.
!     RTTOV for example, can only do one SatID at a time.

ITYPLIST( 1)=NSCATT   ; INGRP( 1)=1
ITYPLIST( 2)=NAIREP   ; INGRP( 2)=1
ITYPLIST( 3)=NDRIBU   ; INGRP( 3)=1
ITYPLIST( 4)=NPAOB    ; INGRP( 4)=1
ITYPLIST( 5)=NSYNOP   ; INGRP( 5)=1
ITYPLIST( 6)=NSATOB   ; INGRP( 6)=NSATOBGRP
ITYPLIST( 7)=NPILOT   ; INGRP( 7)=1+1 ! Increase for Aeolus
ITYPLIST( 8)=NTEMP    ; INGRP( 8)=1
ITYPLIST( 9)=NLIMB    ; INGRP( 9)=NLIMBGRP
ITYPLIST(10)=NRADAR   ; INGRP(10)=1
ITYPLIST(11)=NSATEM   ; INGRP(11)=NSATGRP
ILISTLEN=11

CLTYPNAME(NSCATT)='   SCATT'
CLTYPNAME(NAIREP)='   AIREP'
CLTYPNAME(NDRIBU)='   DRIBU'
CLTYPNAME(NPAOB )='    PAOB'
CLTYPNAME(NSYNOP)='   SYNOP'
CLTYPNAME(NSATOB)='   SATOB'
CLTYPNAME(NPILOT)='   PILOT'
CLTYPNAME(NTEMP) ='    TEMP'
CLTYPNAME(NLIMB) ='    LIMB'
CLTYPNAME(NRADAR)='   RADAR'
CLTYPNAME(NSATEM)='   SATEM'

!*          1.3   The bins are charaterized by their ObsType/Group combination
!                 These will be called BinTags in the following

DO JOBS=1,KOBTOT
  IGRP    = ROBSU(JOBS,MDB_AREATYPE_AT_HDR)
  IOTP_GRP(JOBS) = IGRP*100 + ROBSU(JOBS,MDBOTP)
  LLDONE(JOBS)=.FALSE.
ENDDO

!*          1.4   LELAM does not want some data to belong to sets.

IF(LELAM) THEN
  WHERE(ROBSU(1:KOBTOT,MDBTLA) == RMDI)
    IOTP_GRP(1:KOBTOT) = RMDI
    LLDONE(1:KOBTOT)=.TRUE.
  ENDWHERE
ENDIF

!     -------------------------------------------------------------
!*       2. Divide into bins. Divide bins into sets. Vectorized.
!*          ----------------------------------------------------

MLNSET(:)=NMXLEN
MTSLSET(:) = -1
INSETOT=0

!*          2.1   Loop ObsTypes and Groups
!                 Count bins and numbe of data in each bin.
!                 If bin contains more than NMXLEN data it is subdivided

IF (L_SPAN_KSETS_ACROSS_TSLOTS) INUMTSL = 1

DO JOTP=1,ILISTLEN
  IOTP=ITYPLIST(JOTP)
  DO JT=1,INUMTSL
    IF (L_SPAN_KSETS_ACROSS_TSLOTS) THEN
      I1 = 1
      I2 = KOBTOT
    ELSE
      I1 = JSTA(JT)
      I2 = JEND(JT)
    ENDIF
    IF (I2 - I1 + 1 <= 0) CYCLE ! DO JT=1,INUMTSL -loop
    DO JGRP=1,INGRP(JOTP)
      IBINTAG = JGRP*100 + IOTP

      ICOUNT=COUNT(IOTP_GRP(I1:I2) == IBINTAG)
      IF(ICOUNT == 0) CYCLE ! DO JGRP=1,INGRP(JOTP) -loop

      IF(ICOUNT <= NMXLEN) THEN
        INSET=1
        IREST=ICOUNT
      ELSE
        INSET=ICOUNT/NMXLEN
        IREST=MOD(ICOUNT,NMXLEN)
        IF(IREST /= 0) INSET=INSET+1
      ENDIF

!*          2.2   Start set number and
!                 and end set number

      ISTASET=INSETOT+1
      IENDSET=INSETOT+INSET
      INSETOT=IENDSET
      IF(INSETOT > NMXSET) THEN
        WRITE(NULERR,'(A,I10)')&
         & ' TOO MANY OBSERVATION SETS, INCREASE NMXSET IN YOMOBSET',NMXSET  
        CALL ABOR1('ECSET: NMXSET TOO SMALL')
      ENDIF

!*          2.3   Length of set, Type of observation in set, and a timeslot the set belongs to

      IF(IREST /= 0) MLNSET(IENDSET) = IREST
      MTYPOB(ISTASET:IENDSET) = IBINTAG
      IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) THEN
        MTSLSET(ISTASET:IENDSET) = JT+ITSLOFF
      ENDIF

!*          2.4   Record in ODB which set each obs belongs to.
!                 Create the so_called 'absolute obs number'.

      IC=0
      DO JOBS=I1,I2
        IF(IOTP_GRP(JOBS) == IBINTAG) THEN
          ISET=ISTASET+IC/NMXLEN
          ROBSU(JOBS,MDB_KSET_AT_INDEX) = ISET
          LLDONE(JOBS)=.TRUE.
          IC=IC+1
        ENDIF
      ENDDO ! DO JOBS=I1,I2
    ENDDO ! DO JGRP=1,INGRP(JOTP)
  ENDDO ! DO JT=1,INUMTSL
ENDDO ! DO JOTP=1,ILISTLEN

DEALLOCATE(JSTA,JEND)

!     -------------------------------------------------------------
!*       3. NOT YET FINISHED
!*          ----------------

!*          3.1   Total number of sets created.

NSETOT = INSETOT
MLNSET(NSETOT+1:NMXSET)=0

!*          3.2   Check that no obs have slipped through the net.
!                 If this happens, go and check the group-definitions in
!                 suobarea.F90, and the INGRP-list above.

ICOUNT = COUNT(LLDONE)
IF(ICOUNT /= KOBTOT) THEN
  WRITE(NULERR,*)'***Error in ECSET: NOT ALL DATA ASSIGNED TO A SET : KTSLOTNO,KOBTOT,KOFFTOT,ICOUNT=',&
   & KTSLOTNO,KOBTOT,KOFFTOT,ICOUNT  
  CALL ABOR1('ECSET: NOT ALL DATA ASSIGNED TO A SET')
ENDIF

!*          3.3   Keep info about max number of data_items per obs, in set.
!                 Used for dimensioning in hop-routines.
!                 Calculate also total number of bodies in each set.
!                 Used as weight within each MTYPOB (GRP) to create better load balance within a GRP.

ALLOCATE(ZSUMBDY(NSETOT))

!*          3.4   Perform sorting w.r.t. ZSUMBDY within each MTYPOB GRP for better OpenMP load balance.
!                 All this hassle up to the PUTDB will be skipped, if # of OpenMP threads is not > 1.

INUMT = OML_MAX_THREADS()
IF (INUMT <= 1) GOTO 3000

DO JSET=1,NSETOT
  ZSUMBDY(JSET)= SUM(ROBSU(1:KOBTOT,MLNK_HDR2BODY(2)),   &
   & MASK=ROBSU(1:KOBTOT,MDB_KSET_AT_INDEX) == JSET)
ENDDO

ALLOCATE(ZSETWT(NSETOT,4))

DO JSET = 1,NSETOT
  ZSETWT(JSET,1) = JSET
  ZSETWT(JSET,2) = ZSUMBDY(JSET)
  ZSETWT(JSET,3) = MTYPOB(JSET)
ENDDO

ISTA_SATEM = 0
IEND_SATEM = 0

LLNEWGRP = .TRUE.
INUMSETS = 0
I1 = 1
I2 = 0
IGRP = 0

IKEY = 2
DO JSET = 1,NSETOT
  ITYPOB = MOD(MTYPOB(JSET),100)
  IF (ITYPOB == NSATEM) THEN
    IF (ISTA_SATEM == 0) ISTA_SATEM = JSET
    IEND_SATEM = JSET
  ENDIF
  IF (LLNEWGRP) THEN
    LLNEWGRP = .FALSE.
    I1 = JSET
    IGRP = IGRP + 1
  ENDIF
  ZSETWT(JSET,4) = IGRP
  INUMSETS = INUMSETS + 1
  IF (JSET < NSETOT) THEN
    IF (MTYPOB(JSET) /= MTYPOB(JSET+1)) THEN
      I2 = I1 + INUMSETS - 1
      IF (INUMSETS > 1) CALL KEYSORT(IRET,ZSETWT(I1:I2,:),INUMSETS,KEY=IKEY)
      LLNEWGRP = .TRUE.
      INUMSETS = 0
    ENDIF
  ENDIF
ENDDO

IF (INUMSETS > 0) THEN
  I2 = I1 + INUMSETS - 1
  IF (INUMSETS > 1) CALL KEYSORT(IRET,ZSETWT(I1:I2,:),INUMSETS,KEY=IKEY)
ENDIF

!*          3.7   Continue to re-arrange SATEMs so that most expensive SATEM-groups come last.
!                 This is done because cost of SATEMs dominate in TASKOB/TASKOBTL/TASKOBAD -routines.
!                 For simplicity we assume that cost of each body-entry (i.e. unit weight) is the same
!                 -- regardless of sensor/codetype within SATEMs; in reality this is of course not true.

IF (ISTA_SATEM < IEND_SATEM) THEN

  IGRPTOT = IGRP
  IGRPSCALE = LOG10(DBLE(MAX(1,IGRPTOT))) + 1
  IGRPSCALE = 10**IGRPSCALE ! the next highest power of ten for scaling

  LLNEWGRP = .TRUE.
  INUMSETS = 0
  I1 = 1
  I2 = 0

  DO JSET = ISTA_SATEM, IEND_SATEM
    IF (LLNEWGRP) THEN
      LLNEWGRP = .FALSE.
      I1 = JSET
    ENDIF
    INUMSETS = INUMSETS + 1
    IF (JSET < IEND_SATEM) THEN
      IF (ZSETWT(JSET,4) /= ZSETWT(JSET+1,4)) THEN
        I2 = I1 + INUMSETS - 1
        ZWT = INT(SUM(ZSUMBDY(I1:I2)))
        ZSETWT(I1:I2,4) = ZWT + ZSETWT(I1:I2,4)/IGRPSCALE
        LLNEWGRP = .TRUE.
        INUMSETS = 0
      ENDIF
    ENDIF
  ENDDO

  IF (INUMSETS > 0) THEN
    I2 = I1 + INUMSETS - 1
    ZWT = INT(SUM(ZSUMBDY(I1:I2)))
    ZSETWT(I1:I2,4) = ZWT + ZSETWT(I1:I2,4)/IGRPSCALE
  ENDIF

  I1 = ISTA_SATEM
  I2 = IEND_SATEM
  INUMSETS = I2 - I1 + 1
  IMULTIKEY(1) = 4 ! A decimal number : group_weight.grp_number
  IMULTIKEY(2) = 2 ! Actual weight of a given set
  CALL KEYSORT(IRET,ZSETWT(I1:I2,:),INUMSETS,MULTIKEY=IMULTIKEY(1:2))

ENDIF ! IF (ISTA_SATEM < IEND_SATEM) THEN

!*          3.6   Update KSET-lists, ROBSU's @ MDB_KSET_AT_INDEX and close ODB.
!                 After this we should have reasonably better load balance
!                 in TASKOB/TASKOBTL/TASKOBAD OpenMP-loop than before.

ALLOCATE(ISETIDX(NSETOT))
ISETIDX(1:NSETOT) = ZSETWT(1:NSETOT,1)

MTYPOB(1:NSETOT) = MTYPOB(ISETIDX(1:NSETOT))
MLNSET(1:NSETOT) = MLNSET(ISETIDX(1:NSETOT))
ZSUMBDY(1:NSETOT) = ZSUMBDY(ISETIDX(1:NSETOT))
IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) THEN
  MTSLSET(1:NSETOT) = MTSLSET(ISETIDX(1:NSETOT))
ENDIF

ALLOCATE(IREVIDX(NSETOT)) ; IREVIDX(:) = 0

!OCL NOVREC
DO JSET = 1,NSETOT
  ISET = ISETIDX(JSET)
  IREVIDX(ISET) = JSET
ENDDO

DO JOBS=1,KOBTOT
  ISET = ROBSU(JOBS,MDB_KSET_AT_INDEX)
  IF (ISET >= 1 .AND. ISET <= NSETOT) THEN
    ROBSU(JOBS,MDB_KSET_AT_INDEX) = IREVIDX(ISET)
  ENDIF
ENDDO

DEALLOCATE(ZSETWT,ISETIDX,IREVIDX)

IMAX = 5
IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) IMAX = IMAX + 1
ALLOCATE(ISORTSETS(KOBTOT,IMAX))

DO JOBS=1,KOBTOT
  ISET = ROBSU(JOBS,MDB_KSET_AT_INDEX)
  IWT = ROBSU(JOBS,MLNK_HDR2BODY(2))
  ISORTSETS(JOBS,1) = JOBS ! Pointer to ROBSU
  ISORTSETS(JOBS,2) = ISET ! Current set number
  ISORTSETS(JOBS,3) = ISET ! New set number (the hassle below)
  ISORTSETS(JOBS,4) = IWT  ! weight i.e. body.length of this (lat,lon)
  ISORTSETS(JOBS,5) = MTYPOB(ISET) ! Save obsgrp
  IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) THEN
    ISORTSETS(JOBS,6) = MTSLSET(ISET) ! Save timeslot
  ENDIF
ENDDO

IMULTIKEY(1) =  2 ! W.r.t. current set number
IMULTIKEY(2) =  1 ! JOBS
CALL KEYSORT(IRET,ISORTSETS(1:KOBTOT,:),KOBTOT,MULTIKEY=IMULTIKEY(1:2))

LLNEWGRP = .TRUE.
INUMSETS = 0
I1 = 1
I2 = 0

ISTAJOBS = 1
IENDJOBS = 0

IMULTIKEY(1) = -4 ! Largest weight first ; within a GRP of course
IMULTIKEY(2) =  1 ! JOBS

DO JSET = 1,NSETOT
  IF (LLNEWGRP) THEN
    LLNEWGRP = .FALSE.
    I1 = JSET
  ENDIF
  INUMSETS = INUMSETS + 1
  IF (JSET < NSETOT) THEN
    IF (MTYPOB(JSET) /= MTYPOB(JSET+1)) THEN
      I2 = I1 + INUMSETS - 1
      IENDJOBS = ISTAJOBS + SUM(MLNSET(I1:I2)) - 1
      IF (INUMSETS > 1) THEN
        ICOUNT = IENDJOBS - ISTAJOBS + 1
        CALL KEYSORT(IRET,ISORTSETS(ISTAJOBS:IENDJOBS,:),ICOUNT,MULTIKEY=IMULTIKEY(1:2))
      ENDIF
      !-- Shuffle sets in a round robin fashion (note: the largest weight is now first)
      DO JOBS=ISTAJOBS,IENDJOBS
        ISET = I1 + MOD(JOBS - ISTAJOBS, INUMSETS) ! New set number
        ISORTSETS(JOBS,3) = ISET
      ENDDO
      ISTAJOBS = IENDJOBS + 1
      LLNEWGRP = .TRUE.
      INUMSETS = 0
    ENDIF
  ENDIF
ENDDO

IF (INUMSETS > 0) THEN
  I2 = I1 + INUMSETS - 1
  IENDJOBS = ISTAJOBS + SUM(MLNSET(I1:I2)) - 1
  IF (INUMSETS > 1) THEN
    ICOUNT = IENDJOBS - ISTAJOBS + 1
    CALL KEYSORT(IRET,ISORTSETS(ISTAJOBS:IENDJOBS,:),ICOUNT,MULTIKEY=IMULTIKEY(1:2))
  ENDIF
  !-- Shuffle sets in a round robin fashion (note: the largest weight is now first)
  DO JOBS=ISTAJOBS,IENDJOBS
    ISET = I1 + MOD(JOBS - ISTAJOBS, INUMSETS) ! New set number
    ISORTSETS(JOBS,3) = ISET
  ENDDO
ENDIF

!-- Update ROBSU's KSET again

!OCL NOVREC
DO JOBS=1,KOBTOT
  IOBS = ISORTSETS(JOBS,1)
  ISET = ISORTSETS(JOBS,3) ! New set number
  ROBSU(IOBS,MDB_KSET_AT_INDEX) = ISET
ENDDO

!-- Update MNLSET & MTYPOB and -- if necessary -- MTSLSET 
DO JSET=1,NSETOT
  ICOUNT = COUNT(ISORTSETS(1:KOBTOT,3) == JSET)
  MLNSET(JSET) = ICOUNT
  IF (ICOUNT > 0) THEN
    ILOC = MINLOC(ISORTSETS(1:KOBTOT,3),ISORTSETS(1:KOBTOT,3) == JSET)
    IOBS = ILOC(1)
    MTYPOB(JSET) = ISORTSETS(IOBS,5)
    IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) THEN
      MTSLSET(JSET) = ISORTSETS(IOBS,6)
    ENDIF
  ELSE ! Should be impossible to enter here ...
    MTYPOB(JSET) = 0
    IF (.NOT.L_SPAN_KSETS_ACROSS_TSLOTS) THEN
      MTSLSET(JSET) = 0
    ENDIF
  ENDIF
ENDDO

DEALLOCATE(ISORTSETS)

3000 CONTINUE

DO JSET=1,NSETOT
  MMXBDY(JSET) = MAXVAL(ROBSU(1:KOBTOT,MLNK_HDR2BODY(2)), &
   & MASK=ROBSU(1:KOBTOT,MDB_KSET_AT_INDEX) == JSET)
  ZSUMBDY(JSET)= SUM(ROBSU(1:KOBTOT,MLNK_HDR2BODY(2)),   &
   & MASK=ROBSU(1:KOBTOT,MDB_KSET_AT_INDEX) == JSET)
ENDDO

CALL PUTDB('ECSET', 0, IRET, INFO, 0,ZINFO,0)

!*          3.7   Print (more comprehensive output)

WRITE(NULOUT,*) '  '
WRITE(NULOUT,*) ' RESULTAT DE LA FABRICATION DES PAQUETS D OBS : NSETOT, NMXLEN=',NSETOT,NMXLEN
WRITE(NULOUT,*) '  '

CLOBSGRP = ' '
INUMSETS = 0
ZLNSETS = 0
ZAVGFILL = 0
IMAX = 0
ZWT = 0

WRITE(NULOUT,1000) ' KSET#','TYPE#', 'TYPENAME', 'OBSGRP','MTYPOB','MLNSET','FILL-%','MMXBDY','WEIGHT'

1000 FORMAT(        2X,A6,   1X,A5,   1X,A8,      1X,A25,  1X,A6,   1X,A6,   1X,A6,   1X,A6,   1X,A12)
1001 FORMAT(        A2,I6,   1X,I5,   1X,A8,      1X,A25,  1X,I6,   1X,I6,   1X,F6.1, 1X,I6,   1X,I12)
1002 FORMAT(A,":",I5.5,".",I3.3,".",I3.3,".",I2.2)

DO JSET = 1,NSETOT
  ITYPOB = MOD(MTYPOB(JSET),100)

  IF (CLOBSGRP == ' ') THEN
    IF (ITYPOB == 7) THEN ! ATOVS
      IGRP = MTYPOB(JSET)/100
      ISENSOR = SATGRP_TABLE(IGRP)%SENSOR
      ICODETYPE = SATGRP_TABLE(IGRP)%CODETYPE
      ISATID = SATGRP_TABLE(IGRP)%BUFRID
      IF (ISENSOR >= 0 .AND. ISENSOR <= MXSENSOR) THEN
        WRITE(CLOBSGRP,1002) &
             & TRIM(CHSENSOR(ISENSOR)),ISATID,ISENSOR,ICODETYPE,ITYPOB
      ELSE
        WRITE(CLOBSGRP,1002) &
             & '<UNDEF>',ISATID,ISENSOR,ICODETYPE,ITYPOB
      ENDIF
    ELSEIF (ITYPOB == 3) THEN ! SATOB
      IGRP = MTYPOB(JSET)/100
      IMETHOD = SATOBGRP_TABLE(IGRP)%METHOD
      IMETHODGRP = MOD(IMETHOD,100)
      ICODETYPE = SATOBGRP_TABLE(IGRP)%CODETYPE
      ISATID = SATOBGRP_TABLE(IGRP)%BUFRID
      IF (IMETHOD >= 0 .AND. IMETHODGRP <= MXMETHOD) THEN
        WRITE(CLOBSGRP,1002) &
             & TRIM(CHMETHOD(IMETHODGRP)),ISATID,IMETHOD,ICODETYPE,ITYPOB
      ELSE
        WRITE(CLOBSGRP,1002) &
             & '<UNDEF>',ISATID,IMETHOD,ICODETYPE,ITYPOB
      ENDIF
    ELSE ! ANY OTHER OBS.TYPE
      WRITE(CLOBSGRP,'(I2.2)') ITYPOB
    ENDIF
  ENDIF

  ZFILL = (MLNSET(JSET) * 100.0_JPRB)/NMXLEN
  WRITE(NULOUT,1001) '  ',JSET, ITYPOB, CLTYPNAME(ITYPOB), TRIM(CLOBSGRP), &
       & MTYPOB(JSET), MLNSET(JSET), ZFILL, MMXBDY(JSET), INT(ZSUMBDY(JSET))

  INUMSETS = INUMSETS + 1
  ZLNSETS = ZLNSETS + MLNSET(JSET)
  ZAVGFILL = ZAVGFILL + ZFILL
  IMAX = MAX(IMAX, MMXBDY(JSET))
  ZWT = ZWT + ZSUMBDY(JSET)

  IF (JSET < NSETOT) THEN
    IF (MTYPOB(JSET) /= MTYPOB(JSET+1)) THEN
      ZAVGFILL = ZAVGFILL / INUMSETS
      WRITE(NULOUT,1001) '=>',INUMSETS, ITYPOB, CLTYPNAME(ITYPOB), TRIM(CLOBSGRP), &
           & MTYPOB(JSET), INT(ZLNSETS), ZAVGFILL, IMAX, INT(ZWT)
      CLOBSGRP = ' '
      INUMSETS = 0
      ZLNSETS = 0
      ZAVGFILL = 0
      IMAX = 0
      ZWT = 0
    ENDIF
  ENDIF
ENDDO

IF (INUMSETS > 0) THEN
  JSET = NSETOT
  ZAVGFILL = ZAVGFILL / INUMSETS
  WRITE(NULOUT,1001) '=>',INUMSETS, ITYPOB, CLTYPNAME(ITYPOB), TRIM(CLOBSGRP), &
       & MTYPOB(JSET), INT(ZLNSETS), ZAVGFILL, IMAX, INT(ZWT)
ENDIF

DEALLOCATE(ZSUMBDY)

!*          3.8   Print out NSETOT distribution across the MPL-tasks
CALL GSTATS(1761,1)
IF (NPROC > 1) THEN
  INSETOT_SEND(1) = NSETOT
  IRECVCOUNTS(:) = SIZE(INSETOT_SEND) 
  INSETOT_RECV(:) = 0

  CALL GSTATS(638,0)
  CALL MPL_GATHERV(INSETOT_SEND(:),KROOT=1, &
       & KRECVBUF=INSETOT_RECV(:),KRECVCOUNTS=IRECVCOUNTS(:), &
       & CDSTRING='ECSET')
  CALL GSTATS(638,1)

  IF (MYPROC == 1) THEN
    INSETOT_SUM = SUM(INSETOT_RECV(:))
    ZSUMMA = 0
    ZSUMSQR = 0
    DO JROC=1,NPROC
      ZTMP = INSETOT_RECV(JROC)
      ZSUMMA = ZSUMMA + ZTMP
      ZSUMSQR = ZSUMSQR + ZTMP * ZTMP
    ENDDO
    ZAVG = ZSUMMA/NPROC
    ZSTDEV = ZSUMSQR - (ZSUMMA * (ZSUMMA/NPROC))
    ZSTDEV = SQRT(ZSTDEV/(NPROC-1))
    WRITE(NULOUT,*) '*** NSETOT distribution across the MPL-tasks : NPROC=',NPROC
    DO JROC=1,NPROC
      WRITE(NULOUT,'(1X,A,I5,A,I12)') 'PE#',JROC,' : NSETOT =',INSETOT_RECV(JROC)
    ENDDO
    WRITE(NULOUT,'(1X,A,I12)') '>sum(NSETOT)   =',INSETOT_SUM
    WRITE(NULOUT,'(1X,A,I12)') '>avg(NSETOT)   =',NINT(ZAVG)
    WRITE(NULOUT,'(1X,A,I12)') '>stdev(NSETOT) =',NINT(ZSTDEV)
  ENDIF ! IF (MYPROC == 1) THEN
ENDIF ! IF (NPROC > 1) THEN

!*          3.9   Fill in thread specific info

DO ITID=1,SIZE(OBSET)
  OBSET(ITID)%MTYPOB (:) = MTYPOB (:)
  OBSET(ITID)%MMXBDY (:) = MMXBDY (:)
  OBSET(ITID)%MLNSET (:) = MLNSET (:)
  OBSET(ITID)%MTSLSET(:) = MTSLSET(:)
  OBSET(ITID)%NSETOT     = NSETOT
ENDDO  

!     -------------------------------------------------------------
!*       4. PREPARE FOR TIME CORRELATION
!*          ----------------------------

!-- This is always safe to call, since ABNOBs are now set 
!   once per execution in SUOBSADDR for all timeslots
IF (LTC) CALL SETTC

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