SUBROUTINE SUOBAREA(KTSLOTNO,KOBTOT)

!**** *SUOBAREA* - Set up group id (areatype) and satellite names for ODB

!     Purpose.
!     -------
!           Assign each observation to an 'AREA' and store the value
!     in CMA. The sub-division into areas is done in different ways
!     for different observation types. For most types, AREA can be one of
!     three latitude bands. For satellite observations AREA may depend
!     on land/sea mask and sea-ice boundary. Sea-ice is determined from
!     Ts (surface temperature) of the background-field.

!**   Interface.
!**   ---------
!**   *CALL* * SUOBAREA *
!**         The common YOMOBA is an implicit INPUT and OUTPUT of SUOBAREA.

!     Author: Erik Andersson
!     Date  : 92-03-04

!     Modifications
!     -------------
!     EA920622 - Introduce SATEM and SSM/I
!     Heikki Jarvinen  15/Sep/95  New CMA- file format
!     E.Andersson 960201 : Incorporating Scat in SURFACEO
!     E.Andersson 960304 : Merging TOVS DZ and PWC with RAD-reports
!     E.Andersson 960806 : TOVS AREA has to be reset on each processor
!     E.Andersson 961017 : TOVS data usage managed through blacklist
!     E.Andersson 970108 : Prepare for RTOVS
!     E.Andersson 970214 : Additional SATOB sat id numbers
!     Rose Munro  971126 : Modify to accomodate multiple satellite
!                          series, id's and later subtypes
!     JN.Thepaut  971113 : Setup for CANARI
!     R.Randriamampianina: 970417 : 3DVAR ALADIN
!     E.Andersson 001013 : Area concept redundant, except for SATEM data
!     E.Holm      000508 : Add retrieved ozone layers NSTRO3
!     M.Hamrud    01-Oct-2003 CY28 Cleaning
!     N.Bormann   041223 : Area based on LIMBGRP for LIMB obs (prev. RARAD)
!        S.Saarinen    09-Feb-2005 CY30 Cleaning & obtain "satellite" names

!     A.Dethof    03-Feb-2006 Check retrieval type for ozone information
!                             (contains averaging kernel info) to sort data
!                             into sets with and without AK information
!        D.Tan         24-Jun-2005 Recognize Aeolus within PILOT
!        A.Fouilloux  30-Mar-2010 changed MDB_IDENT_AT_HDR by MDB_SATID_AT_SAT

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

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

USE YOMTVRAD , ONLY : NSATGRP  ,SATGRP_TABLE   ,NSATOBGRP  ,SATOBGRP_TABLE
USE YOMLIMB  , ONLY : NLIMBGRP ,Y_LIMBGRP_TABLE
USE YOMDB
USE YOMDIMO  , ONLY : NOBTOT
USE YOMLUN   , ONLY : NULERR   ,NULOUT
USE YOMCOCTP , ONLY : NSATEM   ,NSATOB  ,CCMOCTP, NPILOT   ,NDWLPCD ,NSTRO3
USE YOMCOSJO , ONLY : JOT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTSLOTNO
INTEGER(KIND=JPIM),INTENT(IN)    :: KOBTOT 
INTEGER(KIND=JPIM) :: ICDTYP,ISATID,ISENSOR,ICOUNT,JJ,IRETR
INTEGER(KIND=JPIM) :: IOBTYP
INTEGER(KIND=JPIM) :: IRET,IRET_SAT,IRET_SATOB,INFO(0),IOBTOT,JGRP,JOBS,IMETHOD
INTEGER(KIND=JPIM) :: IRET_LIMB
INTEGER(KIND=JPIM), ALLOCATABLE :: IAREA(:)

CHARACTER(LEN=8) :: CLtmp
REAL(KIND=JPRB) :: ZINFO(0)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcobs.h"

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

#include "abor1.intfb.h"

#include "openmp_obs.h"
!     -------------------------------------------------------------
!*       1. INITIALIZE
!*          ----------

IF (LHOOK) CALL DR_HOOK('SUOBAREA',0,ZHOOK_HANDLE)
IF (KTSLOTNO >= 1) THEN
  IOBTOT = KOBTOT
ELSE
  IOBTOT = NOBTOT
ENDIF

!     -------------------------------------------------------------
!*       2. GET NON-SATELLITE DATA
!*          ----------------------
IRET = 0
CALL GSTATS(1799,0)
CALL GETDB('SUOBAREA', 0, IRET, INFO, 0,ZINFO,0, &
 & -1, KTSLOTNO, -1, -1, -1, -1)  
CALL GSTATS(1799,1)
WRITE(NULOUT,*) ' SUOBAREA: KTSLOTNO, IRET=', KTSLOTNO, IRET

!*          2.1   Fix group id to 1 (to be used by ecset.F90 for instance)
!                 except for Aeolus (DWL) within PILOT - set group id to 2

DO JOBS = 1,IRET
  ROBSU(JOBS,MDB_AREATYPE_AT_HDR) = 1

  IOBTYP = ROBSU(JOBS,MDBOTP)
  ICDTYP = ROBSU(JOBS,MDB_CODETYPE_AT_HDR)
  IF( IOBTYP == NPILOT .AND. ICDTYP == NDWLPCD ) THEN
     ROBSU(JOBS,MDB_AREATYPE_AT_HDR) = 2
  ENDIF
ENDDO

!*          2.2   Obtain "SATellite NAMEs" (satname[1:4]@hdr) ; see also sualcos.F90

DO JOBS = 1,IRET
  ICDTYP = ROBSU(JOBS,MDB_CODETYPE_AT_HDR)
  DO JJ=1,SIZE(MDB_REPORT_DESCRIPTION_AT_HDR)
    CLtmp = CCMOCTP(ICDTYP)((JJ-1)*8+1:JJ*8)
    ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)) = transfer(CLtmp, ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)))
  ENDDO
ENDDO

!*          2.3   Store in ODB

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

!     -------------------------------------------------------------
!*       3. GET SATELLITE DATA - All are NSATEM
!*          -----------------------------------

IRET_SAT = 0
CALL GETDB('SUOBAREA_SAT', 0, IRET_SAT, INFO, 0, ZINFO,0,&
 & -1, KTSLOTNO, -1, -1, -1, -1)  
WRITE(NULOUT,*) ' SUOBAREA_SAT: KTSLOTNO, IRET=', KTSLOTNO, IRET_SAT

!*       4. Loop CMA observation array
!           --------------------------

!*          4.1   For SATEM data we pick up the 'Sat data group number'.

ICOUNT = 0
DO JGRP=1,NSATGRP
  DO JOBS = 1,IRET_SAT

!-- Satellite data groups are defined by their (bufrid,codetype,sensor)-triplet.
!*AF    ISATID = ROBSU(JOBS,MDB_IDENT_AT_HDR)
    ISATID = ROBSU(JOBS,MDB_SATID_AT_SAT)
    IF (ISATID  /= SATGRP_TABLE(JGRP)%bufrid)   CYCLE
    ICDTYP = ROBSU(JOBS,MDB_CODETYPE_AT_HDR)
    IF (ICDTYP  /= SATGRP_TABLE(JGRP)%codetype) CYCLE
    ISENSOR= ROBSU(JOBS,MDBSSIA)
    IF (ISENSOR /= SATGRP_TABLE(JGRP)%sensor)   CYCLE
  
    IF (ICDTYP == NSTRO3 ) THEN
      IRETR= ROBSU(JOBS,MDB_RETRTYPE_AT_HDR)
      IF (IRETR /= SATGRP_TABLE(JGRP)%retrtype)  CYCLE
    ENDIF

!-- Assign group id (to be used by ecset.F90 for instance)
    ROBSU(JOBS,MDB_AREATYPE_AT_HDR) = JGRP

!-- Assign also "SATellite NAMEs" (report_description[1:4]@hdr) ; see also surad.F90
    DO JJ=1,SIZE(MDB_REPORT_DESCRIPTION_AT_HDR)
      CLtmp = JOT(NSATEM)%jost(JGRP)%sname((JJ-1)*8+1:JJ*8)
      ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)) = transfer(CLtmp, ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)))
    ENDDO

!-- This many found so far
    ICOUNT = ICOUNT + 1
  ENDDO
ENDDO
IF(ICOUNT /= IRET_SAT) CALL ABOR1('SUOBAREA_SAT, SOME NOT SET to GRP-No')

!*          4.2   Put back in ODB

CALL PUTDB('SUOBAREA_SAT', 0, IRET_SAT, INFO, 0, ZINFO, 0)

!     -------------------------------------------------------------
!*       5. GET SATELLITE DATA - All are NSATOB
!*          -----------------------------------

IRET_SATOB = 0
CALL GETDB('SUOBAREA_SATOB', 0, IRET_SATOB, INFO, 0, ZINFO, 0,&
 & -1, KTSLOTNO, -1, -1, -1, -1)  
WRITE(NULOUT,*) ' SUOBAREA_SATOB: KTSLOTNO, IRET=', KTSLOTNO, IRET_SATOB

!*       6. Loop CMA observation array
!           --------------------------

!*          4.1   For SATOB data we pick up the 'Sat data group number'.

ICOUNT = 0
DO JGRP=1,NSATOBGRP
  DO JOBS = 1,IRET_SATOB

!-- SATOB data groups are defined by their (bufrid,codetype,method)-triplet.
!*AF    ISATID = ROBSU(JOBS,MDB_IDENT_AT_HDR)
    ISATID = ROBSU(JOBS,MDB_SATID_AT_SAT)
    IF (ISATID  /= SATOBGRP_TABLE(JGRP)%bufrid)   CYCLE
    ICDTYP = ROBSU(JOBS,MDB_CODETYPE_AT_HDR)
    IF (ICDTYP  /= SATOBGRP_TABLE(JGRP)%codetype) CYCLE
    IMETHOD= ROBSU(JOBS,MDBSBCMM)
    IF (IMETHOD /= SATOBGRP_TABLE(JGRP)%method)   CYCLE

!-- Assign group id (to be used by ecset.F90 for instance)
    ROBSU(JOBS,MDB_AREATYPE_AT_HDR) = JGRP

!-- Assign also "SATellite NAMEs" (report_description[1:4]@hdr) ; see also suamv.F90
    DO JJ=1,SIZE(MDB_REPORT_DESCRIPTION_AT_HDR)
      CLtmp = JOT(NSATOB)%jost(JGRP)%sname((JJ-1)*8+1:JJ*8)
      ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)) = transfer(CLtmp, ROBSU(JOBS,MDB_REPORT_DESCRIPTION_AT_HDR(JJ)))
    ENDDO

!-- This many found so far
    ICOUNT = ICOUNT + 1
  ENDDO
ENDDO
IF(ICOUNT /= IRET_SATOB) CALL ABOR1('SUOBAREA_SATOB, SOME NOT SET to GRP-No')

!*          4.2   Put back in ODB

CALL GSTATS(1799,0)
CALL PUTDB('SUOBAREA_SATOB', 0, IRET_SATOB, INFO, 0, ZINFO, 0)
CALL GSTATS(1799,1)

!     -------------------------------------------------------------
!*       7. GET SATELLITE DATA - All are NLIMB (limb observations)
!*          -------------------------------------------------------

IRET_LIMB = 0
CALL GSTATS(1799,0)
CALL GETDB('SUOBAREA_LIMB', 0, IRET_LIMB, INFO, 0, ZINFO, 0,&
 & -1, KTSLOTNO, -1, -1, -1, -1)  
CALL GSTATS(1799,1)
WRITE(NULOUT,*) ' SUOBAREA_LIMB: ',IRET_LIMB

IF (IRET+IRET_SAT+IRET_SATOB+IRET_LIMB /= IOBTOT) THEN
  WRITE(NULERR,'('' ** INCONSISTENT NO. OF OBSERVATIONS FROM GETDB'')')
  WRITE(NULERR,*)'Expecting IOBTOT=',IOBTOT,&
   & ' but got =',IRET,IRET_SAT,IRET_SATOB,IRET_LIMB 
  CALL ABORTDB('SUOBAREA','INCONSISTENCIES FROM GETDB',&
   &   IRET+IRET_SAT+IRET_SATOB+IRET_LIMB)
ENDIF

!*       8. Loop CMA observation array
!           --------------------------

!*          8.1   Allocate and set default value
IF( IRET_LIMB > 0 )THEN
  ALLOCATE(IAREA(IRET_LIMB))
  IAREA(:)=0

!*          8.2   For LIMB data we pick up the 'Sat data group number'.
  DO JGRP=1,NLIMBGRP
    DO JOBS = 1,IRET_LIMB
      ICDTYP = ROBSU(JOBS,MDB_CODETYPE_AT_HDR)
      ISATID = ROBSU(JOBS,MDB_SATID_AT_SAT)
      ISENSOR= ROBSU(JOBS,MDBSSIA)

! LIMB data groups are defined by their (bufrid,codetype,sensor)-triplet.

      IF(  ISATID   == Y_LIMBGRP_TABLE(JGRP)%bufrsatid  .AND. &
         & ICDTYP   == Y_LIMBGRP_TABLE(JGRP)%codetype .AND. &
         & ISENSOR  == Y_LIMBGRP_TABLE(JGRP)%sensor           ) THEN  
        IAREA(JOBS)=JGRP
      ENDIF

    ENDDO
  ENDDO
  IF(COUNT(IAREA(:)==0) /= 0) CALL ABOR1('SUOBAREA_LIMB, SOME NOT SET to GRP-No')

  !*          8.3   Put AREA in CMA
  DO JOBS = 1,IRET_LIMB
    ROBSU(JOBS,MDB_AREATYPE_AT_HDR) = IAREA(JOBS)
  ENDDO
  DEALLOCATE(IAREA)
ENDIF

!*          8.4   Put back in ODB

CALL GSTATS(1799,0)
CALL PUTDB('SUOBAREA_LIMB', 0, IRET_LIMB, INFO, 0, ZINFO, 0)
CALL GSTATS(1799,1)

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