SUBROUTINE BLACK(KSET,KLEN)

!**** SUBROUTINE BLACK - INTERFACE TO PERFORM BLACKLISTING

!          HEIKKI JARVINEN   ECMWF          15/MAR/1995
!          DRASKO VASILJEVIC ECMWF          21/10/1999

!*    PURPOSE
!     -------

!        INTERFACE TO PERFORM BLACKLISTING

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

!     ***CALL BLACK(KSET)
!     WHERE KOBS = NUMBER OF THE OBSERVATION SET

!        BLACK IS CALLED BY SUBROUTINE DECIS

!*    METHOD
!     ------

!        IFS PROVIDES AN INTERFACE TO THE BLACKLIST. THE EXPRESSIONS
!     OF THE BLACKLIST FILE ARE EVALUATED OUTSIDE IFS.  DECISIONS BASED
!     ON BLACKLIST ARE FEEDBACK TO THE CMA.

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

!        BLACKBOX - IFS INTERFACE TO BLACKLIST
!        FEBLRE   - FEEDBACK BLACKLIST INFORMATION OF THE REPORT
!        FEBLDA   - FEEDBACK BLACKLIST INFORMATION OF THE DATUM

!**   MODIFICATIONS
!     -------------
!     96/10/15  H. Jarvinen: Introduce tovs into data selection
!     97/02/15  H. Jarvinen: Introduce satob data proecessing technique
!     97/06/16  S. Saarinen: Runtime M.D.I. testing under a flag
!     97/12/19  M. Rohn    : Introduce 3 QI's for SATOB AMV 
!     00/04/12  S. Saarinen: Pass ANALYSIS DATE & TIME TO BLACKLIST (ERA40 REQUEST)
!     00/06/23  Xu Li      : Add window channel definition for VTPR (Sami's idea)
!     01/04/19  E. Holm    : Add solar elevation and retrieval quality for REO3
!     01/05/08  g kelly    : Add line number to black for atovs
!     01/08/07  A. Dethof  : Add FOV, CLC, CP, PT for REO3
!     02/04/17  C. Koepken : Add window channel definition for METEOSAT, GOES
!     03/04/29  L.v.Bremen : Add satellite zenith angle definition for SATOB AMV
!     04/01/14  E. Andersson:Add sonde type. Compute solar elevation.
!     04/12/03  S. Saarinen: Dimension IFEEDBACK increased (0:NFEEDBACK-1 => 0:NFEEDBACK)
!     05/03/23  M. Szyndel: Add MTSAT and FY-2
!     06/04/06  S.Healy: Changes for GPSRO blacklisting
!     06/08/21  S.Healy: use of retrtype for screening rising occs and "non-nominal" data 
!     06/11/10  A.Collard: Add IASI
!     07/03/07  P.Poli: blacklisting for GPSRO at MF uses RETRTYPE
!     07/06/01  H.Hersbach: Add sea-ice fraction
!     07/08/16  V. Guidard: Add IASI (after A. Collard)
!     07/11/14  N.Bormann: Add alternative window channel departure (for AMSU-A)
!     07/11/30  S. SAARINEN: Added IFS-cycle by request of the WAVE-group
!     07/12/11  S. SAARINEN: New abort() function in blacklist --> BLINFO == 8 triggers a controlled abort
!     08/01/08  P. Bauer: Add NSSMI
!     08/02/06  C.Facani: Add radars
!     09/02/25  H.Hersbach: allow blacklisting on ASCAT EARS
!     09/03/09  Q. Lu   : Add FY3A IRAS, MWTS, MWHS and MWRI
!     09/05/21  A.Geer: Allow passive monitoring of all-sky (NSSMI) radiances
!     10/03/31  A.Fouilloux: Add a new codetype for MERIS
!     ------------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT, NULERR
USE YOMCST   , ONLY : RG
USE YOMSTA   , ONLY : STPRE
USE YOMCOCTP , ONLY : NSYNOP   ,NSATOB   ,NSTB87   ,NTEMP    ,&
 & NPILOT   ,NSATEM   ,NGTHRB   ,NSTRO3  ,NLIMB    ,NGPSRO, NSSMI, &
 & NRADAR   ,NSCATT   ,NSCAT3, NTCWC
USE YOMANCS  , ONLY : NMDI     ,RMDI     ,RDEGREES
USE YOMALIM  , ONLY : NFLLIM
USE YOMBLINIT, ONLY : NBHEAD   ,NBBODY   ,NBDATA   ,NFEEDBACK
USE YOMCT0B  , ONLY : LECMWF
USE YOMVNMB  , ONLY : NVNUMB
USE YOMVAR   , ONLY : LVARBC
USE YOMANA   , ONLY : NANDAT, NANTIM
USE YOMTVRAD , ONLY : MXSENSOR ,MSENSOR_HIRS,MSENSOR_MSU,&
 & MSENSOR_IRAS,MSENSOR_MWTS,MSENSOR_MWHS,MSENSOR_MWRI, &
 & MSENSOR_AMSUA,MSENSOR_AMSUB ,MSENSOR_SSMIS,MSENSOR_MHS,&
 & MSENSOR_VTPR1,MSENSOR_VTPR2,MSENSOR_AIRS,MSENSOR_IASI, &
 & MSENSOR_METEOSAT,MSENSOR_GOESIMG, &
 & MSENSOR_MSG,MSENSOR_MTSATIMG,MSENSOR_VISSR
USE YOMDB
USE GOMS_MIX , ONLY : YGOMS,YGOMEC
USE YOMOBS, ONLY : LSLRW10, LSOE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSET, KLEN
REAL(KIND=JPRB) :: ZDATA(NBDATA)
INTEGER(KIND=JPIM) :: IFEEDBACK(0:NFEEDBACK)

INTEGER(KIND=JPIM) ::  ICDTYP, IBLINFO,&
 & IVCO, IVNM, IFL, IFLAG, IVNM1,&
 & IFOVOB, ILSMSK, ICHAN,&
 & INSTYP, IOBTYP, IODATE, IOTIME, IPRINT_BODY, &
 & IPRINT_HEAD, IQI1, IQI2, IQI3, IRETRT, IRETRT_TMP, &
 & ILIN, ISQN, ISENSOR, ISYPCD, I_NMDI_BODY, &
 & I_NMDI_HEAD, JBODY, JBODY1, JOBS, JBL, IQR, &
 & IMAPOMM , IMM, IDD, IHH, &
 & IFILL_FBVECTOR_HEAD, IFILL_FBVECTOR_BODY, &
 & IRETRSOURCE, ISURFTYPE
INTEGER(KIND=JPIM) :: IWINDOW_CH(0:MXSENSOR)
INTEGER(KIND=JPIM) :: IWINDOW_CH2(0:MXSENSOR) ! Alternative

REAL(KIND=JPRB) :: ZMAJOR, ZMINOR
INTEGER(KIND=JPIM) :: IFS_CYCLE, ICHECK_IFS_CYCLE_ENV_FIRST
CHARACTER(LEN=80) :: CLerrmsg

REAL(KIND=JPRB) :: ZCCC, ZFGE, ZFOE, ZOMF, ZPPP, ZPPP1,&
 & ZPRL, ZVAR, ZWCD, ZWCD2, ZLATIT, ZLONGI, ZMODOR,&
 & ZMODPS, ZMODTS, ZSTALT, ZTEMPT, ZSATZA, ZSOE, ZCLC, ZCP, ZPT, ZSONDE_TYPE, &
 & ZTAUSFC, ZSOLZA
REAL(KIND=JPRB) :: ZAZIM, Z_D0, Z_D1, Z_D2, ZCLWP1, ZCLWP2
REAL(KIND=JPRB) :: Z_PRED_SST, ZVR_CH791, ZVR_CH914, ZVR_CH1285, ZVR_CH1301
!     MAP BLACKLIST INFO FAILCODES (1,2,3,4) INTO BITS (0001,0010,0100,1000)
INTEGER(KIND=JPIM), PARAMETER :: IMAX_BLINFO = 4
INTEGER(KIND=JPIM),      SAVE :: IMAP_BLINFO(0:IMAX_BLINFO) = (/0,1,2,4,8/)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL :: LLDEBUG

#include "diurnal.intfb.h"
#include "nflgdse.intfb.h"
#include "abor1.intfb.h"

INTERFACE
#include "blackbox.h"
END INTERFACE

#include "fcobs.h"

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

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

!*          1.0   INFORM

IF (LHOOK) CALL DR_HOOK('BLACK',0,ZHOOK_HANDLE)
IF(KSET == 1)WRITE(NULOUT,'('' *** BLACKLISTING '')')

!*          1.2   ENABLE/DISABLE DEBUG PRINTING

IPRINT_HEAD = 0
IPRINT_BODY = 0

!*          1.3   ENABLE/DISABLE RUNTIME DYNAMIC MISSING DATA IND. TESTS

I_NMDI_HEAD = 0
I_NMDI_BODY = 0

!*          1.4   FILL IFEEDBACK-VECTOR (=1) OR NOT (=0 ; DOESN'T WORK YET)

IFILL_FBVECTOR_HEAD = 1
IFILL_FBVECTOR_BODY = 1

!*          1.5   Identify  window channel, for each sensor

IWINDOW_CH(:)=0
IWINDOW_CH(MSENSOR_HIRS)  = 8
IWINDOW_CH(MSENSOR_SSMIS) = 2
IWINDOW_CH(MSENSOR_MSU)   = 1
IWINDOW_CH(MSENSOR_IRAS)  = 9
IWINDOW_CH(MSENSOR_MWTS)  = 1
IWINDOW_CH(MSENSOR_MWHS)  = 1  ! equivalent to AMSU-B/MHS channel 2 
IWINDOW_CH(MSENSOR_MWRI)  = 1
IWINDOW_CH(MSENSOR_AMSUA) = 4
IWINDOW_CH(MSENSOR_AMSUB) = 2
IWINDOW_CH(MSENSOR_MHS)   = 2
IWINDOW_CH(MSENSOR_VTPR1) = 8
IWINDOW_CH(MSENSOR_VTPR2) = 8
IWINDOW_CH(MSENSOR_AIRS)  = 787
IWINDOW_CH(MSENSOR_IASI)  = 2239
IWINDOW_CH(MSENSOR_METEOSAT) = 2
IWINDOW_CH(MSENSOR_MSG) = 6
IWINDOW_CH(MSENSOR_MTSATIMG) = 1
IWINDOW_CH(MSENSOR_VISSR) = 1
IWINDOW_CH(MSENSOR_GOESIMG) = 3  ! (IFS/RTTOV-number. channel 4, 10.9um on instrument)

IWINDOW_CH2(:)=0
IWINDOW_CH2(MSENSOR_AMSUA) = 3

!*          1.6   Get IFS-cycle (the IFS_CYCLE -word in blacklist language [CY33R1 onwards])

ICHECK_IFS_CYCLE_ENV_FIRST = 1
CALL CODB_VERSIONS(ZMAJOR, ZMINOR, IFS_CYCLE, ICHECK_IFS_CYCLE_ENV_FIRST)

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

!        2.       LOOP OVER ALL THE REPORTS IN THE SET
!                 ------------------------------------

REPORT_LOOP: DO JOBS = 1,KLEN

!*          2.1   INITIALIZE INPUT DATA

  ZDATA(:) = RMDI

!*          2.2   FIND OUT OBSERVATION POINTERS AND ETC.

  IMAPOMM = ROBHDR(JOBS,MDB_MAPOMM_AT_INDEX)

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

!        3.       FILL THE INPUT VECTOR WITH HEADER & MODEL INFORMATION
!                 -----------------------------------------------------

!           3.25  CURRENT ANALYSIS DATE

  ZDATA(25) = NANDAT

!           3.26  CURRENT ANALYSIS TIME

  ZDATA(26) = NANTIM

!           3.38  IFS_CYCLE (e.g. CY33R1.001 would make IFS_CYCLE to be 331001)

  ZDATA(38) = IFS_CYCLE

!           3.1   OBSERVATION TYPE

  IOBTYP = ROBHDR(JOBS,MDBOTP)
  ZDATA( 1) = IOBTYP

!           3.2   STATION ID

  ZDATA( 2) = ROBHDR(JOBS,MDBSID)

!           3.3   CODE TYPE

  ICDTYP = ROBHDR(JOBS,MDB_CODETYPE_AT_HDR)
  ZDATA( 3) = ICDTYP

!           3.4   INSTRUMENT TYPE

  INSTYP = ROBHDR(JOBS,MDB_INSTTYPE_AT_HDR)
  ZDATA( 4) = INSTYP

!           3.5   OBSERVATION DATE

  IODATE = ROBHDR(JOBS,MDBDAT)
  ZDATA( 5) = IODATE

!           3.6   OBSERVATION TIME

  IOTIME = ROBHDR(JOBS,MDBETM)
  ZDATA( 6) = IOTIME

!           3.7   LATITUDE (IN DEGREES)

  ZLATIT = ROBHDR(JOBS,MDBLAT)*RDEGREES
  ZDATA( 7) = ZLATIT

!           3.8   LONGITUDE (IN DEGREES)

  ZLONGI = ROBHDR(JOBS,MDBLON)*RDEGREES
  ZDATA( 8) = ZLONGI

!           3.9   STATION ALTITUDE

  ZSTALT = ROBHDR(JOBS,MDBALT)
  ZDATA( 9) = ZSTALT
!*
!             3.9.1   CHECK FOR SYNOP/TEMP/PILOT REPORTS

  IF (LECMWF) THEN
    IF(ZSTALT == RMDI) THEN
      IF(IOBTYP == NSYNOP .OR. IOBTYP == NTEMP .OR. IOBTYP == NPILOT) THEN
        CYCLE REPORT_LOOP
      ENDIF
    ENDIF
  ENDIF

!           3.11  RETRIEVAL TYPE (FOR SATOB/TOVS/GPSRO REPORTS)

  IF(IOBTYP == NSATOB) THEN
    IRETRT = SATHDR(JOBS,MDBSBCMM)
  ELSEIF (IOBTYP == NLIMB .AND. ICDTYP == NGPSRO) THEN  
    IF (LECMWF) THEN
    ! gpsro retrieval type
       IRETRT_TMP = ROBHDR(JOBS,MDB_RETRTYPE_AT_HDR)
    ! default    
       IRETRT = 0
    ! if rising occ set IRETRT=1
       IF (BTEST(IRETRT_TMP,13)) IRETRT=1
    ! "non-nominal" bending angle or phase data        
       IF (BTEST(IRETRT_TMP,11) .OR. BTEST(IRETRT_TMP,12)) IRETRT=2        
    ELSE
       IRETRT = ROBHDR(JOBS,MDB_RETRTYPE_AT_HDR)
    ENDIF
  ELSE 
    IRETRT = NMDI
  ENDIF
  ZDATA(11) = IRETRT

!           3.12  SATOB AMV QUALITY INDICATOR 1,2,3

  IF(IOBTYP == NSATOB .AND. ICDTYP == NSTB87) THEN
    IQI1 = SATHDR(JOBS,MDBSBQI1)
    IQI2 = SATHDR(JOBS,MDBSBQI2)
    IQI3 = SATHDR(JOBS,MDBSBQI3)
  ELSE
    IQI1 = NMDI
    IQI2 = NMDI
    IQI3 = NMDI
  ENDIF

  ZDATA(12) = IQI1
  ZDATA(13) = IQI2
  ZDATA(14) = IQI3

!           3.22  SATELLITE SENSOR INDICATOR 
  IF(IOBTYP == NSATEM .AND. (ICDTYP == NGTHRB .OR. ICDTYP == NSSMI .OR. ICDTYP == NTCWC)) THEN
    ISENSOR = ROBHDR(JOBS,MDBSSIA)
  ELSE
    ISENSOR = NMDI
  ENDIF
  ZDATA(22) = ISENSOR

!           3.23  FIELD OF VIEW NUMBER         
  IF(IOBTYP == NSATEM .AND. ICDTYP == NGTHRB) THEN
    IFOVOB = SATHDR(JOBS,MDB_SCANPOS_AT_RADIANCE)
  ELSEIF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    IFOVOB = ROBHDR(JOBS,MDBRO3FOV)
  ELSE
    IFOVOB = NMDI
  ENDIF
  ZDATA(23) = IFOVOB

!           3.231  RLINE NUMBER         
  IF(IOBTYP == NSATEM .AND. ICDTYP == NGTHRB) THEN
    ILIN = SATHDR(JOBS,MDB_SCANLINE_AT_RADIANCE)
  ELSE
    ILIN   = NMDI
  ENDIF
  ZDATA(10) = ILIN  

!           3.24   SATELLITE ZENITH ANGLE (IN DEGREES)

  IF(IOBTYP == NSATEM .AND. ICDTYP == NGTHRB) THEN
    ZSATZA = SATHDR(JOBS,MDB_ZENITH_AT_SAT)
  ELSEIF(IOBTYP == NSATOB .AND. ICDTYP == NSTB87) THEN
    ZSATZA = SATHDR(JOBS,MDB_ZENITH_AT_SAT)
  ELSE
    ZSATZA = RMDI
  ENDIF
  ZDATA(24) = ZSATZA

!           3.27   SOLAR ELEVATION (IN DEGREES)

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    ZSOE = ROBHDR(JOBS,MDBRO3SOE)
  ELSE
    IMM=MOD(IODATE/100,100)
    IDD=MOD(IODATE,100)
    IHH=IOTIME/10000
    CALL DIURNAL(IMM,IDD,IHH,ZLATIT,ZLONGI,ZSOE)
  ENDIF
   IF ((.NOT. LECMWF).AND. (.NOT. LSOE)) THEN
     ZSOE=90._JPRB
   ENDIF
  ZDATA(27) = ZSOE

!           3.28   QUALITY OF OZONE RETRIEVAL, REO3

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    IQR = ROBHDR(JOBS,MDBRO3QR)
  ELSE
    IQR = NMDI
  ENDIF
  ZDATA(28) = IQR

!           3.29   Cloud Cover 

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    ZCLC = ROBHDR(JOBS,MDBRO3CLC)
  ELSE
    ZCLC = RMDI
  ENDIF
  ZDATA(29) = ZCLC

!           3.30   Cloud Top Pressure

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    ZCP = ROBHDR(JOBS,MDBRO3CP)
  ELSE
    ZCP = RMDI
  ENDIF
  ZDATA(30) = ZCP

!           3.31   PRODUCT TYPE      

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    ZPT = ROBHDR(JOBS,MDBRO3PT)
  ELSE
    ZPT = RMDI
  ENDIF
  ZDATA(31) = ZPT

!           3.32   SONDE TYPE

  IF(IOBTYP == NTEMP) THEN
    ZSONDE_TYPE = ROBHDR(JOBS,MDB_SONDE_TYPE_AT_HDR)
  ELSE
    ZSONDE_TYPE = RMDI
  ENDIF
  ZDATA(32) = ZSONDE_TYPE

!           3.33   SPECIFIC

  IF (.NOT.LECMWF) THEN
    IF((IOBTYP == NSATEM).AND.(ISENSOR == MSENSOR_AMSUA)) THEN
      ZDATA(33) = RMDI
      IF ((YGOMEC(IMAPOMM)%ECLSMA < 0.1).AND.(ROBHDR(JOBS,MDB1BCP3A) >= 271.45)) THEN
        ZAZIM=SATHDR(JOBS,MDB_AZIMUTH_AT_SAT)
        Z_D1=0.754 ; Z_D2=-2.265
        DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
          IF (ROBODY(JBODY,MDBPPP) == 1) ZCLWP1=ROBODY(JBODY,MDBVAR)
          IF (ROBODY(JBODY,MDBPPP) == 2) ZCLWP2=ROBODY(JBODY,MDBVAR)
        ENDDO
        IF ((ZCLWP1 < 285).AND.(ZCLWP2 < 285)) THEN
          Z_D0= 8.240 - (2.622 - 1.846*COS(ZAZIM))*COS(ZAZIM)
          ZDATA(33) = COS(ZAZIM)*(Z_D0 + Z_D1*LOG(285.0-ZCLWP1) + Z_D2*LOG(285.0-ZCLWP2))
        ENDIF
      ENDIF
    ELSEIF ((IOBTYP == NSATEM).AND.(ISENSOR == MSENSOR_AIRS)) THEN
      ZDATA(33) = 0.
      DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        IF (ROBODY(JBODY,MDBPPP) == 791) ZVR_CH791 = ROBODY(JBODY,MDBVAR)
        IF (ROBODY(JBODY,MDBPPP) == 914) ZVR_CH914 = ROBODY(JBODY,MDBVAR)
        IF (ROBODY(JBODY,MDBPPP) == 1285) ZVR_CH1285 = ROBODY(JBODY,MDBVAR)
        IF (ROBODY(JBODY,MDBPPP) == 1301) ZVR_CH1301 = ROBODY(JBODY,MDBVAR)
      ENDDO
      Z_PRED_SST=8.28206-0.97957*ZVR_CH791+0.60529*ZVR_CH914 &
       & +1.7444*ZVR_CH1285-0.40379*ZVR_CH1301
      ZDATA(33) = ROBHDR(JOBS,MDB1BCP3A) - Z_PRED_SST
    ENDIF
  ENDIF
!           10m winds rejections
  IF ((.NOT.LECMWF).AND.(IOBTYP == NSYNOP)) THEN
      IF (LSLRW10) THEN
        ZDATA(33) = 1.0_JPRB
      ELSE
        ZDATA(33) = 0.0_JPRB
      ENDIF
  ENDIF


!           3.39  RETRIEVAL SOURCE

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    IRETRSOURCE = ROBHDR(JOBS,MDB_RETRSOURCE_AT_REO3)
  ELSE
    IRETRSOURCE = NMDI
  ENDIF
  ZDATA(39) = IRETRSOURCE

!           3.40  SURFACE TYPE INDICATOR

  IF(IOBTYP == NSATEM .AND. ICDTYP == NSTRO3) THEN
    ISURFTYPE = ROBHDR(JOBS,MDBAERSTF)
  ELSE
    ISURFTYPE = NMDI
  ENDIF
  ZDATA(40) = ISURFTYPE

!           3.15  MODEL OROGRAPHY

  ZMODOR = ROBHDR(JOBS,MDB_OROGRAPHY)
  ZDATA(15) = ZMODOR

!           3.16  LAND/SEA MASK (INTEGER)

  ILSMSK = NINT(YGOMEC(IMAPOMM)%ECLSMA)
  ZDATA(16) = ILSMSK

!           3.17  LAND/SEA MASK (REAL)

  ZDATA(17) = YGOMEC(IMAPOMM)%ECLSMA

!           3.18  MODEL SURFACE PRESSURE (IN HECTOPASCALS)

  ZMODPS = EXP(YGOMS(IMAPOMM)%SP)
  ZDATA(18) = ZMODPS*0.01_JPRB

!           3.19  MODEL SURFACE TEMPERATURE

  ZMODTS = YGOMS(IMAPOMM)%TS
  ZDATA(19) = ZMODTS

!           3.20  MODEL 2 METRE TEMPERATURE

  ZDATA(20) = RMDI

!           3.21  MODEL TOP LEVEL PRESSURE (IN HECTOPASCALS)

  ZDATA(21) = 0.01_JPRB*STPRE(1)

!           3.22  MODEL SEA ICE FRACTION (FROM 0 TO 1)

  ZDATA(34) = YGOMEC(IMAPOMM)%ECCI

!           3.23  GENERATING CENTRE

  IF(( IOBTYP == NSATEM .AND. ICDTYP == NGTHRB ) .OR. &
   & ( IOBTYP == NSATOB                        ) .OR. &
   & ( IOBTYP == NSCATT .AND. ICDTYP == NSCAT3)) THEN      ! ASCAT
    ZDATA(35) = SATHDR(JOBS,MDB_GEN_CENTRE_AT_SAT)
    ZDATA(36) = SATHDR(JOBS,MDB_GEN_SUBCENTRE_AT_SAT)
    ZDATA(37) = SATHDR(JOBS,MDB_DATASTREAM_AT_SAT)
  ENDIF

!           3.23   SOLAR ZENITH ANGLE (IN DEGREES)

  ZSOLZA = RMDI
  IF(IOBTYP == NSATEM .AND. ISENSOR == MSENSOR_AIRS) THEN
    ZSOLZA = ROBHDR(JOBS,MDB_SOLAR_ZENITH_AT_SAT)
  ENDIF
  ZDATA(41) = ZSOLZA

!*          3.24  PERFORM BLACKLISTING FOR OBSERVATION HEADER

  CALL BLACKBOX(NULOUT,1,IPRINT_HEAD,&
   & I_NMDI_HEAD, IFILL_FBVECTOR_HEAD,&
   & IBLINFO,ZCCC,IFEEDBACK,NFEEDBACK,&
   & ZDATA,NBHEAD)  

!           3.25  CHANGE REPORT STATUS, TO BLACKLISTED
!                 IBLINFO == 8 triggers abort

!           3.26.0 PASSIVE MODE FOR VARIATIONAL BIAS CORRECTION, MODIFY 
!                OBSERVATION ERROR
!                IBLINFO == 3 is used to set the STATUS to PASSIVE.

1000 FORMAT('***ERROR: BLACKLIST-TRIGGERED ABORT. CHECK BLACKLIST CONDITIONS NEAR LINE#',I6)

  IF (IBLINFO == 8) THEN

    WRITE(CLerrmsg,1000) IFEEDBACK(0) 
    WRITE(NULOUT,'(1X,A)') trim(CLerrmsg)
    WRITE(NULERR,'(1X,A)') trim(CLerrmsg)
    CALL ABOR1(trim(CLerrmsg))
    
  ELSEIF( LVARBC .AND. IBLINFO == 3 .AND. &
   & IOBTYP == NSATEM .AND. (ICDTYP == NGTHRB .OR. ICDTYP == NSSMI .OR. ICDTYP == NTCWC)) THEN

    ROBHDR(JOBS,MDBRST) = ZCHSTAT_PASSIVE(ROBHDR(JOBS,MDBRST))

  ELSEIF( IBLINFO /= 0 )THEN

!           3.26.1 SET BLACKLIST FLAG IN STATUS WORD
!                  not anymore because it does not go well
!                  with feedback; new solution needed


    ROBHDR(JOBS,MDBRST) = ZCHSTAT_BLACKLST(ROBHDR(JOBS,MDBRST))

    ! Blacklist for atmospheric analysis, but not emissivity atlas
    ! by setting status to passive (but not active)
    IF( IBLINFO == 4 .AND. &
   & IOBTYP == NSATEM .AND. ICDTYP == NGTHRB .AND. IVNM == NVNUMB(50)) THEN
      ROBODY(JOBS,MDBRST) = ZCHSTAT_PASSIVE(ROBHDR(JOBS,MDBRST))
    ELSE
      IF (IBLINFO < 0 .OR. IBLINFO > IMAX_BLINFO) IBLINFO = 1
      IBLINFO = IMAP_BLINFO(IBLINFO)
!     ROBHDR(JOBS,MDBRST) = ZCHSTAT_BLINFO(ROBHDR(JOBS,MDBRST),IBLINFO)
    ENDIF
!           3.26.2 SET HEADER (REPORT) BLACKLIST FLAGS

    IF (IFILL_FBVECTOR_HEAD > 0) THEN
      DO JBL=1,MIN(NBHEAD,32)
        IF (IFEEDBACK(JBL) /= 0) THEN
          ROBHDR(JOBS,MDBRBLE) = ZCHEV1(ROBHDR(JOBS,MDBRBLE),JBL)
        ENDIF
      ENDDO
    ENDIF
    
!           3.26.3 ALSO CHANGE DATUM STATUS, TO BLACKLISTED

    DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
      ROBODY(JBODY,MDBDSTA) = ZCHSTAT_BLACKLST(ROBODY(JBODY,MDBDSTA))
!     ROBODY(JBODY,MDBDSTA) = ZCHSTAT_BLINFO(ROBODY(JBODY,MDBDSTA),IBLINFO)
    ENDDO

    CYCLE REPORT_LOOP
  ENDIF
!*
!     ------------------------------------------------------------------

!        4.       LOOP OVER ALL VARIABLES IN THE REPORT
!                 -------------------------------------

!*          4.1   Find window channel departure.

  IF(ISENSOR < 0 .OR. ISENSOR > MXSENSOR) THEN
    ZWCD  = RMDI
    ZWCD2 = RMDI
  ELSEIF(IOBTYP == NSATEM .AND. ICDTYP == NGTHRB) THEN
    ZWCD  = 1000000.0_JPRB
    ZWCD2 = 1000000.0_JPRB
    DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
      IF(ROBODY(JBODY,MDBVNM) == NVNUMB(50)) THEN
        ICHAN = ROBODY(JBODY,MDBPPP)
        IF(ICHAN == IWINDOW_CH(ISENSOR))  ZWCD = ROBODY(JBODY,MDBOMF)
        IF(ICHAN == IWINDOW_CH2(ISENSOR)) ZWCD2 = ROBODY(JBODY,MDBOMF)
      ENDIF
    ENDDO
  ELSE
    ZWCD  = RMDI
    ZWCD2 = RMDI
  ENDIF


!*          4.2   START LOOP

  DATUM_LOOP: DO JBODY = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    ISQN = ROBODY(JBODY,MDBESQN)
!*
!     ------------------------------------------------------------------

!        5.       FILL THE INPUT VECTOR WITH BODY ENTRY INFORMATION
!                 -------------------------------------------------

!           5.1   VARIABLE NAME

    IVNM = ROBODY(JBODY,MDBVNM)
    ZDATA(NBHEAD+ 1) = IVNM

!           5.2   TYPE OF VERTICAL COORDINATE

    IVCO = ROBODY(JBODY,MDBVCO)
    ZDATA(NBHEAD+ 2) = IVCO

!           5.3   PRESSURE (IN HECTOPASCALS/METRES)

    ZPPP = ROBODY(JBODY,MDBPPP)
    IF(IVCO == 1) THEN
      ZDATA(NBHEAD+ 3) = 0.01_JPRB*ZPPP
    ELSEIF(IVCO == 2) THEN
      ZDATA(NBHEAD+ 3) = ZPPP/RG
    ELSEIF(IVCO == 6) THEN
! For GPSRO impact parameter -> impact height (m)
      ZDATA(NBHEAD+ 3) = ZPPP-ROBHDR(JOBS,MDBRADCURV)
    ELSE
      ZDATA(NBHEAD+ 3) = ZPPP
    ENDIF

!           5.4   REFERENCE LEVEL PRESSURE (IN HECTOPASCALS/METRES)

    ZPRL = ROBODY(JBODY,MDBPRL)
    IF(IVCO == 1) ZPRL = 0.01_JPRB*ZPRL
    IF(IVCO == 2) THEN
      IF(ZPRL /= 0 .AND. IOBTYP /= NLIMB .AND. ICDTYP /= NGPSRO) ZPRL = ZPRL/RG
    ENDIF
    ZDATA(NBHEAD+ 4) = ZPRL

!           5.5   SYNOP PRESSURE CODE

    IF(IOBTYP == NSYNOP) THEN
      ISYPCD = ROBODY(JBODY,MDBSYPC)
    ELSE
      ISYPCD = NMDI
    ENDIF
    ZDATA(NBHEAD+ 5) = ISYPCD

!           5.6   OBSERVED VALUE

    ZVAR = ROBODY(JBODY,MDBVAR)
    ZDATA(NBHEAD+ 6) = ZVAR

!           5.7   FIRST GUESS DEPARTURE

    ZOMF = ROBODY(JBODY,MDBOMF)
    ZDATA(NBHEAD+ 7) = ZOMF

!           5.8   FINAL OBSERVATION ERROR

    ZFOE = ROBODY(JBODY,MDBFOE)
    ZDATA(NBHEAD+ 8) = ZFOE

!           5.9   FIRST GUESS ERROR

    ZFGE = ROBODY(JBODY,MDBFGE)
    ZDATA(NBHEAD+ 9) = ZFGE

!           5.10  WINDOW CHANNEL FG DEPARTURE (1C ONLY)

    ZDATA(NBHEAD+10) = ZWCD
    ZDATA(NBHEAD+13) = ZWCD2

!           5.11  FOR R/S, PASS OBSERVED TEMPERATURE

    ZTEMPT = RMDI
    IF(IOBTYP == NTEMP) THEN
      DATUM_LOOPT: DO JBODY1 = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
        ZPPP1 = ROBODY(JBODY1,MDBPPP)
        IVNM1 = ROBODY(JBODY1,MDBVNM)
        IF(ZPPP1 == ZPPP .AND. &
         & (IVNM1 == NVNUMB(8) .OR. IVNM1 == NVNUMB(10)) ) &
         & ZTEMPT = ROBODY(JBODY1,MDBVAR)  
      ENDDO DATUM_LOOPT
    ENDIF
    ZDATA(NBHEAD+11) = ZTEMPT

!           5.12  RADAR ELEVATION

    IF(IOBTYP == NRADAR) THEN
        ZDATA(NBHEAD+12) = ROBODY(JBODY,MDB_ELEVATION_AT_RADAR_BODY)
    ENDIF

!           5.13  TRIP LEVEL FOR AIRS CHANNEL SENSITIVITY TO SURFACE

    ZTAUSFC = RMDI
    IF(IOBTYP == NSATEM .AND. ICDTYP == NGTHRB) THEN
      ZTAUSFC = ROBODY(JBODY,MDB_TAUSFC_AT_BODY)
    ENDIF
    ZDATA(NBHEAD+14) = ZTAUSFC

!*          5.14  PERFORM BLACKLISTING FOR OBSERVATION BODY ENTRY

    CALL BLACKBOX(NULOUT,2,IPRINT_BODY,&
     & I_NMDI_BODY, IFILL_FBVECTOR_BODY,&
     & IBLINFO,ZCCC,IFEEDBACK,NFEEDBACK,&
     & ZDATA,NBHEAD+NBBODY)  

!           5.15  FEEDBACK BLACKLIST INFORMATION OF THE BODY ENTRY
!                 IBLINFO = 1-monthly, 2-constant, 3-experimental, 4-whitelist
!                 IBLINFO == 8 triggers abort

    IF (IBLINFO == 8) THEN

      WRITE(CLerrmsg,1000) IFEEDBACK(0) 
      WRITE(NULOUT,'(1X,A)') trim(CLerrmsg)
      WRITE(NULERR,'(1X,A)') trim(CLerrmsg)
      CALL ABOR1(trim(CLerrmsg))

    ELSEIF( LVARBC .AND. IBLINFO == 3 .AND. IOBTYP == NSATEM .AND. &
      &     (ICDTYP == NGTHRB .OR. ICDTYP == NSSMI) .AND. IVNM == NVNUMB(50)) THEN
!              5.15.1  VARIATIONAL BIAS CORRECTION
!                IBLINFO == 3 is used to set the STATUS to PASSIVE.

      ROBODY(JBODY,MDBDSTA) = ZCHSTAT_PASSIVE(ROBODY(JBODY,MDBDSTA))

    ELSEIF(IBLINFO /= 0) THEN

      ROBODY(JBODY,MDBDSTA) = ZCHSTAT_BLACKLST(ROBODY(JBODY,MDBDSTA))

      ! Blacklist for atmospheric analysis, but not emissivity atlas
      ! by setting status to passive (but not active)
      IF( IBLINFO == 4 .AND. &
     & IOBTYP == NSATEM .AND. ICDTYP == NGTHRB .AND. IVNM == NVNUMB(50)) THEN
        LLDEBUG=.TRUE.
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_PASSIVE(ROBODY(JBODY,MDBDSTA))
      ELSE
        IF (IBLINFO < 0 .OR. IBLINFO > IMAX_BLINFO) IBLINFO = 1
        IBLINFO = IMAP_BLINFO(IBLINFO)
        ROBODY(JBODY,MDBDSTA) = ZCHSTAT_BLINFO(ROBODY(JBODY,MDBDSTA),IBLINFO)
      ENDIF

!              5.15.2 SET BODY BLACKLIST FLAGS
      IF (IFILL_FBVECTOR_BODY > 0) THEN
        DO JBL=1,MIN(NBBODY,32)
          IF (IFEEDBACK(NBHEAD+JBL) /= 0) THEN
            ROBODY(JBODY,MDBDBLE) = ZCHEV1(ROBODY(JBODY,MDBDBLE),JBL)
          ENDIF
        ENDDO
      ENDIF

!              5.15.3  SET FLAG
      IFL = 0
      IF(ZCCC /= 0) IFL = AINT(ZCCC/0.25_JPRB)
      IFLAG = MAX(MIN(IFL,NFLLIM(3)),NFLLIM(0))
      CALL NFLGDSE(JBODY,'BLACK',IFLAG)
    ENDIF
!*
!     ------------------------------------------------------------------

!        6.       CLOSE THE LOOP OVER THE ...
!                 ---------------------------

!           6.1   ... DATUM

  ENDDO DATUM_LOOP

!           6.1   ... REPORT

ENDDO REPORT_LOOP
!*
!     ------------------------------------------------------------------

!        7.       RETURN
!                 ------
IF (LHOOK) CALL DR_HOOK('BLACK',1,ZHOOK_HANDLE)
END SUBROUTINE BLACK
