
SUBROUTINE BLACKHAT(KTSLOT,KSET)

!**** SUBROUTINE BLACKHAT - CONTROLS BLACKLISTING

!          DRASKO VASILJEVIC ECMWF          21/10/1999

!*    PURPOSE
!     -------

!        CONTROLS IFS OBS. BLACKLISTING

!**   INTERFACE
!     ---------

!     ***CALL* *BLACKHAT(KTSLOT,KSET)
!     WHERE KTSLOT = TIME SLOT
!           KSET   = ECSET

!        BLACKHAT IS CALLED BY SUBROUTINE DECIS

!*    METHOD
!     ------

!        CONTROLS IFS OBSERVATION BLACKLISTING DECISION MAKING.
!     OBSERVATIONS ARE HANDLED IN SETS AS DEFINED IN ECSET.

!*    EXTERNALS
!     ---------

!        GETDB - GET DATA FROM ODB
!        BLACK - BLACKLISTING
!        PUTDB - PUT DATA AWAY

!**   MODIFICATIONS
!     -------------
!     04/06/23  C.Payan  : vue sur scat (JVIEW==3)
!     05/02/08  C.Payan  : appel BLACKCLN pour JVIEW==3
!     S. Healy  2004/10/27:  changed IBLACKVIEWS(8) for GPSRO processing
!     08/02/06  C. Facani : Add view for radars
!     07/04/10  A. Fouilloux: Add new codetype for MERIS
!     ------------------------------------------------------------------

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

USE YOMDIMO  , ONLY : NMXSET
USE YOMOBSET_THSAFE
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCOCTP
USE YOMTVRAD , ONLY : SATGRP_TABLE
USE OML_MOD, ONLY : OML_MY_THREAD

IMPLICIT NONE

INTEGER(KIND=JPIM), INTENT(IN)   :: KTSLOT
INTEGER(KIND=JPIM), INTENT(IN)   :: KSET
INTEGER(KIND=JPIM), parameter    :: IBLACK_VIEWS=9
logical :: LL_USE_BLACK_VIEWS(IBLACK_VIEWS)
INTEGER(KIND=JPIM) :: IRET, INFO(1), IOBSTYPE,ICDTYP_TOVS,JVIEW,ISATGRP
INTEGER(KIND=JPIM) :: IREPCOUNT, ITID, ISENSOR
REAL(KIND=JPRB) :: ZINFO(1)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "black.intfb.h"

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

!*       1.       START
!                 -----

IF (LHOOK) CALL DR_HOOK('BLACKHAT',0,ZHOOK_HANDLE)
ITID = OML_MY_THREAD()
WRITE(NULOUT,'('' *** BLACKHAT (BLACKLIST)     SET:'',I10)') KSET

IF (KSET < 1 .OR. KSET > NMXSET) THEN
  WRITE(NULERR,'(1X,A,I10,A,I10)') &
      & '***ERROR IN BLACKHAT:  INVALID KSET =',KSET,&
      & '. MUST BE BETWEEN 1 AND NMXSET =',NMXSET
  CALL ABORTDB('BLACKHAT','INVALID KSET. MUST BE BETWEEN 1 AND NMXSET',KSET)
  IF (LHOOK) CALL DR_HOOK('BLACKHAT',1,ZHOOK_HANDLE)
  RETURN ! Never reaches here
ENDIF

IF (OBSET(ITID)%MTSLSET(KSET) /= -1 .AND. OBSET(ITID)%MTSLSET(KSET) /= KTSLOT) THEN
  WRITE(NULOUT,*)'*** SET=',KSET,' DOES NOT HAVE ANYTHING TO DO WITH THE TIMESLOT=',KTSLOT
  IF (LHOOK) CALL DR_HOOK('BLACKHAT',1,ZHOOK_HANDLE)
  RETURN
ENDIF

IRET = 0

!           1.1   CODETYPE FOR THIS SET, ONLY SATEM DATA

IOBSTYPE = MOD(OBSET(ITID)%MTYPOB(KSET),100)
IF(IOBSTYPE == NSATEM) THEN
  ISATGRP = MOD(OBSET(ITID)%MTYPOB(KSET)/100,100)
  ICDTYP_TOVS = SATGRP_TABLE(ISATGRP)%codetype
  ISENSOR = SATGRP_TABLE(ISATGRP)%sensor
ELSE
  ICDTYP_TOVS=-1
  ISENSOR = -1
ENDIF

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

!*       2.       MAKE INDEPENDENT BLACKLISTING DECISIONS
!                 ---------------------------------------

!           2.1   There are N ODB-views defined for BLACK, LOOP
!                 But only *one* of the views per KSET is *really* needed
!                 So lets start using LL_USE_BLACK_VIEWS(:) more effectively!
!                 For reference, see ODB-sqls in files "odb/ddl.ECMA/black_*.sql"
!                 and -- of course -- the monster routine "odb/cma2odb/ctxinitdb.F90"
!                 (SS/15-Dec-2004)

LL_USE_BLACK_VIEWS(1) = (IOBSTYPE == NSYNOP .OR. &
                       & IOBSTYPE == NAIREP .OR. &
                       & IOBSTYPE == NDRIBU .OR. &
                       & IOBSTYPE == NTEMP  .OR. &
                       & IOBSTYPE == NPILOT .OR. &
                       & (IOBSTYPE == NSATEM .AND. &
                       & (ICDTYP_TOVS == NSTMCD .OR. ICDTYP_TOVS == NSTOVS)) .OR. &
                       & IOBSTYPE == NPAOB)
LL_USE_BLACK_VIEWS(2) = (IOBSTYPE == NSATOB)
LL_USE_BLACK_VIEWS(3) = (IOBSTYPE == NSCATT)
LL_USE_BLACK_VIEWS(4) = (IOBSTYPE == NSATEM .AND. ICDTYP_TOVS == NGTHRB)
LL_USE_BLACK_VIEWS(5) = .FALSE. ! rtovs has been shut down for good
LL_USE_BLACK_VIEWS(6) = (IOBSTYPE == NSATEM .AND. (ICDTYP_TOVS == NSSMI .OR. ICDTYP_TOVS == NTCWC))
LL_USE_BLACK_VIEWS(7) = (IOBSTYPE == NSATEM .AND. ICDTYP_TOVS == NSTRO3)
LL_USE_BLACK_VIEWS(8) = (IOBSTYPE == NLIMB) 
LL_USE_BLACK_VIEWS(9) = (IOBSTYPE == NRADAR)
IREPCOUNT=0

DO JVIEW=1,IBLACK_VIEWS
  IF (.not.LL_USE_BLACK_VIEWS(JVIEW)) CYCLE

!           2.1.1 INITIALIZE DB (LOCAL; CONVENTIONAL REPs)

  CALL GETDB('BLACK',JVIEW,IRET,INFO,0,ZINFO,0,&
   & KSET,KTSLOT,-1,IOBSTYPE,ICDTYP_TOVS,ISENSOR)  
  IREPCOUNT = IREPCOUNT+IRET
  IF(IRET /= 0) THEN
    CALL BLACKHAT_CHECK_ERROR(JVIEW)

!           2.1.2 BLACKLISTING
    CALL BLACK(KSET,IRET)

  ENDIF

!           2.1.3 PUT THE ODB VIEW AWAY
  CALL PUTDB('BLACK',JVIEW,IRET,INFO,0,ZINFO,0)

!           2.1.4 END LOOP OVER ODB VIEWS
ENDDO
WRITE(NULOUT,'(1X,A,I3,A,I3,A,I4,A,I3,A,I10)') &
 & 'BLACKHAT: TSLOT#',KTSLOT,': OBS.TYPE=',IOBSTYPE,' (CODETYPE=',ICDTYP_TOVS, &
 & ', SENSOR=',ISENSOR,') : NUMBER OF REPORTS SUBJECTED TO BLACKLISTING=',IREPCOUNT

IF (LHOOK) CALL DR_HOOK('BLACKHAT',1,ZHOOK_HANDLE)

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

CONTAINS

SUBROUTINE BLACKHAT_CHECK_ERROR(KCASE)
IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN) :: KCASE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTERFACE
#include "abortdb.h"
END INTERFACE
IF (LHOOK) CALL DR_HOOK('BLACKHAT:BLACKHAT_CHECK_ERROR',0,ZHOOK_HANDLE)
IF(IRET /= OBSET(ITID)%MLNSET(KSET) ) THEN
  WRITE(NULERR,'(a,i1,a)') '*** ERROR IN BLACK(',KCASE,')'
  WRITE(NULERR,'(''     SLOT: '',I10)') KTSLOT
  WRITE(NULERR,'(''     SET : '',I10)') KSET
  WRITE(NULERR,'(''     IRET: '',I10)') IRET
  WRITE(NULERR,'(''     MLNSET'',I10)') OBSET(ITID)%MLNSET(KSET)
  CALL FLUSH(NULOUT)
  CALL ABORTDB('BLACK','IRET AND MLNSET ARE NOT EQUAL',KCASE)
ENDIF
IF (LHOOK) CALL DR_HOOK('BLACKHAT:BLACKHAT_CHECK_ERROR',1,ZHOOK_HANDLE)
END SUBROUTINE BLACKHAT_CHECK_ERROR

END SUBROUTINE BLACKHAT
