!OPTION! -pvctl noouterunroll -pvctl noouterstrip
SUBROUTINE TASKOBAD
!****-------------------------------------------------------------------
!**** *TASKOBAD* - Task treating the first set of non correlated obs
!**** which is available and repeating the action until no set left.
!****
!***  Purpose : Control the execution of one task treating one set of
!***  -------   observations which are not correlated in the horizontal.
!***
!**   Interface : *CALL* * TASKOBAD*
!**   ---------   OR *CALL TSKSTART(.,TASKOB)
!**   ---------   DEPENDING ON MULTITASKING IMPLEMENTATION
!**         The common YOMOBSET is an implicit input of TASKOB

!     EXTERNALS. 
!     ----------  SURFACAD - JO FOR SURFACE OBS - ADJOINT
!                 UPPERAAD - JO FOR UPPER AIR OBS - ADJOINT
!                 SATEMAD  - JO FOR SATEM - ADJOINT
!                 TOVCLRAD - JO FOR TOVS RADIANCES - ADJOINT

!     Author: Mats Hamrud 
!     Date  : 97-02-21   (from TASKOB adjoint option)

!     MODIFICATIONS
!     -------------
!     E. Gerard     :  99-05-05 If NSSMI call tovclrad instead if satemad
!     M.Hamrud      :  01-Oct-2003 CY28 Cleaning
!     Paul Burton   :  10-Sep-2004 Reproducible sat. bias parameters  
!     Sean Healy    :  14-Mar-2005 Changes for 2d operators
!     S. Saarinen   :  26-Sep-2007 Obs. group based Dr.Hook'ing in KSET-loop
!     D. Dee        :  10-Oct-2008 generalise VarBC
!     S. Saarinen   :  16-Nov-2007 Added ZTIMER to dynamically load balance the KSET-loop
!     E. Sevault    :  18-May-2009 SX9 compiler workaround : optimisations
!            "outerunroll" and "outerstrip" manually switched off to prevent
!            unexpected numerical variations. Note that this workaround may
!            be irrelevent when the source code of this subroutine is deeply 
!            re-written.
!    G. Mozdzynski  :  03-Jun-2009 VarBC reproducibility rework
!    T. Wilhelmsson :  26-Feb-2010 More VarBC reproducibility rework

!****-------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIMO   ,ONLY : L_TASKOBAD_USE_SORTED_TIMES,NOBTOT
USE YOMOBSET , ONLY : MTYPOB   ,MLNSET   ,MMXBDY   ,NSETOT
USE OML_MOD, ONLY : OML_INIT, OML_INIT_LOCK, OML_MAX_THREADS
USE VARBC_SETUP, ONLY : YVARBC, NOBGROUP, JPMXNPARAM, &
                    & APARAMS_COMP, NPARAMS_COMP
USE YOMVAR   , ONLY : LVARBC, LREPRO4DVAR
USE YOMECTAB , ONLY : NOBSPROFS
USE YOMTVRAD , ONLY : SATGRP_TABLE  , CHSENSOR, MXSENSOR, &
                    & SATOBGRP_TABLE, CHMETHOD, MXMETHOD
USE ECSORT_MIX   , ONLY : KEYSORT
USE YOMMP    , ONLY : MYPROC
USE YOMLUN   , ONLY : NULOUT
IMPLICIT NONE

INTEGER(KIND=JPIM) :: ICSET,ITYPOB,ILEN,IDLEN,IMXBDY,JSET,JBGRP,IHORIZ
INTEGER(KIND=JPIM) :: IGRP,ISENSOR,IMETHOD,ICODETYPE,ISATID
INTEGER(KIND=JPIM) :: J,ITHRMAX,IRET
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB) :: ZHOOK_KSET_LOOP
REAL(KIND=JPRB) :: ZHOOK_JSET
REAL(KIND=JPRB) :: TIMEF, ZT
REAL(KIND=JPRB), ALLOCATABLE, SAVE :: ZTIMER(:,:) ! Note : never released, but a small array
CHARACTER(LEN=40) :: CLOBSGRP

#include "hopad.intfb.h"

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

!        0.        Initialize job configuration
!                  ----------------------------
! Allocate space to the component parts of the satellite bias
! parameters (YVARBC%PARCOM) which will be summed in a 
! reproducible manner after the JSET loop

IF (LVARBC) THEN
  IF (.NOT.LREPRO4DVAR) THEN
    IF (NSETOT > 0) THEN
      ALLOCATE(APARAMS_COMP(NSETOT,JPMXNPARAM,NOBGROUP))
      CALL GSTATS(1067,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
      DO J=1,NOBGROUP
        APARAMS_COMP(:,:,J)=0.0_JPRB
      ENDDO
!$OMP END PARALLEL DO
      CALL GSTATS(1067,1)
    ENDIF
  ELSE
    ALLOCATE(APARAMS_COMP(NOBTOT,JPMXNPARAM,NOBGROUP))
    ALLOCATE(NPARAMS_COMP(JPMXNPARAM,NOBGROUP))

    NPARAMS_COMP(:,:)=0
  ENDIF
ENDIF

!*       1.       CALL THE AD HOC OBS ROUTINE, DEPENDING ON OBS TYPE
!                 --------------------------------------------------

!   GET NEXT OBSERVATION SET NUMBER (LOOP START)
!   COUNTING BACKWARDS IN ORDER TO DO TOVS FIRST

ITHRMAX = OML_MAX_THREADS()
IF (allocated(ZTIMER)) THEN
  IF (ITHRMAX > 1 .AND. L_TASKOBAD_USE_SORTED_TIMES) THEN
    CALL KEYSORT(IRET, ZTIMER, NSETOT, KEY=2) ! "2" := smallest time at the top
    IF(MYPROC==1)THEN
      DO JSET=1,NSETOT
        ICSET=ZTIMER(JSET,1)
        WRITE(NULOUT,'("TASKOBAD: SET=",I6," TIME=",F10.3)')ICSET,ZTIMER(JSET,2)
      ENDDO
    ENDIF
  ENDIF
ELSE
!$ CALL OML_INIT_LOCK()
  ZT = TIMEF() ! Make sure the timer has been initialized outside the OpenMP-region
  ALLOCATE(ZTIMER(NSETOT,2))
  DO JSET=1,NSETOT
    ZTIMER(JSET,1) = JSET
    ZTIMER(JSET,2) = 0.0_JPRB
  ENDDO
ENDIF

CALL GSTATS(1062,0)

1000 FORMAT(A,A,":",I5.5,".",I2.2,".",I3.3,".",I2.2)

!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) &
!$OMP&PRIVATE(JSET,ICSET,ITYPOB,ILEN,IDLEN,IMXBDY,IHORIZ,ZT, &
!$OMP&        ZHOOK_KSET_LOOP,ZHOOK_JSET,CLOBSGRP,IGRP,ISENSOR,IMETHOD,ICODETYPE,ISATID)
DO JSET=NSETOT,1,-1
  ZT = TIMEF()
  IF (LHOOK) CALL DR_HOOK('TASKOBAD>KSET_LOOP',0,ZHOOK_KSET_LOOP)
  ICSET = ZTIMER(JSET,1)

!*       1.1  OBSERVATION TYPE

  ITYPOB = MOD(MTYPOB(ICSET),100)
  IF (ITYPOB == 7) THEN ! ATOVS
    IGRP = MTYPOB(ICSET)/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,1000) &
           & 'TASKOBAD>OBSGRP=',TRIM(CHSENSOR(ISENSOR)),ISATID,ISENSOR,ICODETYPE,ITYPOB
    ELSE
      WRITE(CLOBSGRP,1000) &
           & 'TASKOBAD>OBSGRP=','<UNDEF>',ISATID,ISENSOR,ICODETYPE,ITYPOB
    ENDIF
  ELSEIF (ITYPOB == 3) THEN ! SATOB
    IGRP = MTYPOB(ICSET)/100
    IMETHOD = SATOBGRP_TABLE(IGRP)%METHOD
    ICODETYPE = SATOBGRP_TABLE(IGRP)%CODETYPE
    ISATID = SATOBGRP_TABLE(IGRP)%BUFRID
    IF (IMETHOD >= 0 .AND. IMETHOD <= MXMETHOD) THEN
      WRITE(CLOBSGRP,1000) &
           & 'TASKOBAD>OBSGRP=',TRIM(CHMETHOD(IMETHOD)),ISATID,IMETHOD,ICODETYPE,ITYPOB
    ELSE
      WRITE(CLOBSGRP,1000) &
           & 'TASKOBAD>OBSGRP=','<UNDEF>',ISATID,IMETHOD,ICODETYPE,ITYPOB
    ENDIF
  ELSE ! ANY OTHER OBS.TYPE
    WRITE(CLOBSGRP,'(A,I2.2)') 'TASKOBAD>OBSGRP=',ITYPOB
  ENDIF
  IF (LHOOK) CALL DR_HOOK(CLOBSGRP,0,ZHOOK_JSET)

  ILEN   = MLNSET(ICSET)
  IF(MOD(ILEN,2) == 0) THEN
    IDLEN  =ILEN+1
  ELSE
    IDLEN  =ILEN
  ENDIF
!            SECOND DIMENSION, COULD BE ZERO.
  IMXBDY = MAX(MMXBDY(ICSET),1)

! How many vertical profiles are required per observation

  IHORIZ = NOBSPROFS(ITYPOB) 

!*       1.3      CALL THE APPROPRIATE OBS OPERATOR

  CALL HOPAD(IDLEN,IMXBDY,ICSET,IHORIZ)

!*       1.5      NEXT AVAILABLE SET

  IF (LHOOK) CALL DR_HOOK(CLOBSGRP,1,ZHOOK_JSET)
  IF (LHOOK) CALL DR_HOOK('TASKOBAD>KSET_LOOP',1,ZHOOK_KSET_LOOP)
  IF (ITHRMAX > 1 .AND. L_TASKOBAD_USE_SORTED_TIMES) THEN
    ZTIMER(JSET,2) = TIMEF() - ZT
  ENDIF
ENDDO
!$OMP END PARALLEL DO

CALL GSTATS(1062,1)
CALL GSTATS_BARRIER(756)

IF (LVARBC .AND. .NOT.LREPRO4DVAR) THEN
  
  ! Sum the components of the bias parameters
  DO JBGRP=1,NOBGROUP
    IF (YVARBC(JBGRP)%NPARAM > 0) THEN
      DO JSET=1,NSETOT
        YVARBC(JBGRP)%APARAMS(1:YVARBC(JBGRP)%NPARAM)= &
         & YVARBC(JBGRP)%APARAMS(1:YVARBC(JBGRP)%NPARAM) &
         & +APARAMS_COMP(JSET,1:YVARBC(JBGRP)%NPARAM,JBGRP)
      ENDDO
    ENDIF
  ENDDO

  IF (NSETOT > 0) DEALLOCATE(APARAMS_COMP)
ENDIF

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TASKOBAD',1,ZHOOK_HANDLE)
END SUBROUTINE TASKOBAD
