SUBROUTINE SCREEN

!**** SUBROUTINE SCREEN - CONTROL THE IFS OBSERVATION SCREENING

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

!*    PURPOSE
!     -------

!        CONTROL THE IFS OBSERVATION SCREENING

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

!     ***CALL SCREEN

!        SCREEN IS CALLED BY CNT1 IF LOGICAL SWITCH 'LSCREEN' EQUALS TRUE

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

!        DEALMOD - RELEASE UNNECESSARY MODEL FIELDS
!        SUSCRE1 - INITIALIZE SCREENING COMMONS ON LEVEL 1
!        SUFGER  - SETUP FIRST GUESS ERRORS INTO OBSERVATIONS
!        SUFGLIM - SETUP FIRST GUESS ERROR FLAG LIMITS
!        BLINIT  - INITIALIZE BLACKLISTING INTERFACE
!        DECIS   - MAKE  SCREENING DECISIONS
!        UPECMA  - UPDATE THE EXTENDED CMA FOR COMPRESSION
!        PRSTA   - PRINT SCREENING STATISTICS
!        DEALSCR - RELEASE THE ARRAYS USED IN SCREENING

!*    METHOD
!     ------

!        THERE ARE TWO MODES TO PERFORM THE SCREENING, EITHER IN 3DVAR OR
!     IN 4DVAR MODE. 3DVAR MODE (LSCRE4D EQUALS .FALSE.) CONSIDERES ALL THE
!     OBSERVATIONS FROM THE TIME WINDOW (USUALLY 6 HOURS) TOGETHER, AND THE
!     SELECTION PREFERS OBSERVATIONS CLOSE TO THE MIDDLE OF THE TIME WINDOW.
!     IN 4DVAR MODE (LSCRE4D EQUALS .TRUE.) THE SELECTION IS PERFORMED FOR
!     EACH (USUALLY ONE HOUR) TIME WINDOW (OR SLOT) SEPARATELY, THUS LEADING
!     TO LESS REJECTION OF DATA DUE TO REDUNDANCIES.

!**   MODIFICATIONS
!     -------------

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

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

USE YOMCT0   , ONLY : LSCREEN_OPENMP
USE YOMDIMO  , ONLY : NOBTOT   ,NACTIM
USE YOMLUN   , ONLY : NULOUT   
USE YOMSCC   , ONLY : LSCRE4D  ,LSCDPR
USE YOMECTAB , ONLY : NTSLTOB  ,NTSLTOBOFF
USE YOMDB
USE YOMOBS
USE OML_MOD, ONLY : OML_INIT, OML_INIT_LOCK, OML_MAX_THREADS

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IRET, INFO(1)
INTEGER(KIND=JPIM), ALLOCATABLE :: ITS(:)
INTEGER(KIND=JPIM) :: IACTIM, IOBTOT, IOFFTOT, JSLOT, ITSLOT, &
 & ILEN

LOGICAL :: LLUPECMA
LOGICAL :: LL_F_SCR_WORK_TS
LOGICAL :: LL_OPENMP_SCREEN

INTEGER(KIND=JPIM) :: INUMT

REAL(KIND=JPRB) :: ZINFO(1)

REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB) :: ZHOOK_TS_LOOP

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

#include "blinit.intfb.h"
#include "dealmod.intfb.h"
#include "dealscr.intfb.h"
#include "decis.intfb.h"
#include "ecset.intfb.h"
#include "ecset_thsafe.intfb.h"
#include "post_prsta.intfb.h"
#include "pre_prsta.intfb.h"
#include "prsta.intfb.h"
#include "sufger.intfb.h"
#include "sufglim.intfb.h"
#include "suscre1.intfb.h"
#include "upecma.intfb.h"

#include "openmp_obs.h"

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

!*       1.    INITIALIZATION
!              --------------

!*          1.0   INFORM

IF (LHOOK) CALL DR_HOOK('SCREEN',0,ZHOOK_HANDLE)
WRITE(NULOUT,'('' *** START SCREENING OF OBSERVATIONS '')')
WRITE(NULOUT,'(''     ------------------------------- '')')
LLUPECMA= .TRUE.

!*          1.1   RELEASE UNNECESSARY MODEL FIELDS

CALL DEALMOD

!*          1.2   INITIALIZE/ALLOCATE SCREENING COMMONS

CALL SUSCRE1

!*          1.3   SETUP FIRST GUESS ERROR FLAG LIMITS

CALL SUFGLIM

!*          1.4   INITIALIZE BLACKLISTING INTERFACE

CALL BLINIT

!*          1.6   Read in FG error (moved to /ifs/setup/SU0YOMB to have it before trajectory, PB)

!CALL INIFGER

!*          1.7   FINAL SCREENING WORK WITHIN THE TIMESLOT LOOP

LL_F_SCR_WORK_TS = L_F_SCR_WORK_TS

!*          1.8   INITIALIZE OPENMP LOCKS (IF NOT ALREADY; USES OML_MOD)

!$        CALL OML_INIT_LOCK()

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

!*       2.    PROCESS OBSERVATIONS
!              --------------------

!*          2.1   LOOP OVER THE TIMESLOTS

IF (LSCRE4D) THEN
  IACTIM=NACTIM
ELSE
  IACTIM=1
  CALL ECSET(-1,NOBTOT,0)
ENDIF

allocate(ITS(IACTIM))
DO JSLOT = 1,IACTIM
  ITS(JSLOT) = JSLOT
ENDDO

CALL PRE_PRSTA(.TRUE.,ILEN)

INUMT = OML_MAX_THREADS()
LL_OPENMP_SCREEN = &
     & (IACTIM > 1) .AND. &
     & LSCREEN_OPENMP ! NOTE: Set this to .FALSE. in the NAMELIST, if you do *NOT* want to run the
                      !       TIMESLOT_LOOP below in the OpenMP-mode 

IF (LL_OPENMP_SCREEN) THEN
  CALL GSTATS(1790,0)
  CALL GETDB('OBSCOUNT',1,IRET,INFO,0,ZINFO,0, &
       & -1, -1, -1, -1, -1, -1)
  IACTIM = IRET
  DO JSLOT = 1,IACTIM
    ITS(JSLOT) = ROBSU(JSLOT,MDB_TIMESLOT_AT_TIMESLOT_INDEX)
  ENDDO
  IF (IACTIM <= 1) LL_OPENMP_SCREEN = .FALSE.
  CALL PUTDB('OBSCOUNT',1,IRET,INFO,0,ZINFO,0)
  CALL GSTATS(1790,1)
ENDIF

!--Vow, what an OpenMP-loop; just the MPL-routines must be made
!  thread-safe and then ... voila whatta speedup!! SS/17-Dec-2004
!  Using largest timeslots first approach (SS/16-Oct-2007)
!  ICHUNK removed & conditional OpenMP'ing introduced (SS/16-Oct-2007)
CALL GSTATS(1082,0)
!$OMP PARALLEL PRIVATE(JSLOT,IOBTOT,IOFFTOT,ITSLOT,ILEN,IRET,&
!$OMP&                 INFO,ZINFO,ZHOOK_TS_LOOP) IF (LL_OPENMP_SCREEN)
!$OMP DO SCHEDULE(STATIC,1)
TIMESLOT_LOOP: DO JSLOT = 1,IACTIM
  IF (LHOOK) CALL DR_HOOK('SCREEN>TS_LOOP',0,ZHOOK_TS_LOOP)

!*          2.2   IS THE SCREENING DONE IN 3D OR IN 4D MODE

  IF(LSCRE4D) THEN
    ITSLOT  = ITS(JSLOT)
    IOBTOT  = NTSLTOB   (ITSLOT)
    IOFFTOT = NTSLTOBOFF(ITSLOT)
    CALL ECSET_THSAFE(ITSLOT,IOBTOT,IOFFTOT)
    WRITE(NULOUT,'(A,I3)')' SCREENING TIMESLOT ',ITSLOT
  ELSE
    ITSLOT = 1
  ENDIF

!*          2.3   SETUP FIRST GUESS ERRORS INTO OBSERVATIONS

  CALL SUFGER(ITSLOT)

!*          2.4   MAKE SCREENING DECISIONS

  CALL DECIS(ITSLOT)

!*          2.5   COLLECT AND PRINT SCREENING STATISTICS
!                 - done in '4DVAR' mode for timeslots
!                 De-allocate arrays local to time slot

  IF(LSCRE4D) THEN
    IF(LSCDPR) THEN
      WRITE(NULOUT,'('' *** SCREEN_1; STATISTICS FOR ALL REPORTS'')')
      WRITE(NULOUT,'(''     ALL SETS'')')

!           2.5.1 INITIALIZE DB (LOCAL; ALL REPS)

      CALL GETDB('SCREEN',1,IRET,INFO,0,ZINFO,0, &
       & -1, ITSLOT, -1, -1, -1, -1)  
      IF(IRET == 0) THEN
        WRITE(NULOUT,'(''     NO (ANY) REPORTS AVAILABLE '')')
      ELSE
        WRITE(NULOUT,'(''     REPORTS (ANY) FOUND: '',I10)') IRET
      ENDIF
      ILEN = IRET

!*          2.5.2 PRINT STAT

      CALL PRSTA(ITSLOT,.FALSE.,ILEN)

!*          2.5.3 PUT THE DB AWAY

      CALL PUTDB('SCREEN',1,IRET,INFO,0,ZINFO,0)
    ENDIF
  ENDIF

!*          2.6   WORK PREVIOUSLY DONE OUTSIDE THE TIMESLOT LOOP

  IF(.NOT.LL_F_SCR_WORK_TS) CYCLE TIMESLOT_LOOP

!*          2.7   UPDATE THE EXTENDED CMA FOR COMPRESSION

  WRITE(NULOUT,'('' *** SCREEN_2; UPDATE REPORTS '')')
  WRITE(NULOUT,'(''     ALL SETS'')')

!           2.7.1 INITIALIZE DB (LOCAL; ALL REPS)

  CALL GETDB('SCREEN',2,IRET,INFO,0,ZINFO,0,&
   & -1, ITSLOT, -1, -1, -1, -1)  
  IF(IRET == 0) THEN
    WRITE(NULOUT,'(''     NO (ANY) REPORTS AVAILABLE '')')
  ELSE
    WRITE(NULOUT,'(''     REPORTS (ANY) FOUND: '',I10)') IRET
  ENDIF
  ILEN = IRET

!           2.7.2 UPDATE

  IF(LLUPECMA) THEN
    CALL UPECMA(ILEN)
  ENDIF

!*          2.7.3 PUT THE DB AWAY

  CALL PUTDB('SCREEN',2,IRET,INFO,0,ZINFO,0)

!*          2.8   COLLECT AND PRINT SCREENING STATISTICS
!                 - finally done in '3DVAR' mode

  WRITE(NULOUT,'('' *** SCREEN_3; FINAL STATISTICS FOR ANY REPORTS AVAILABLE '')')
  WRITE(NULOUT,'(''     ALL SETS'')')

!           2.8.1 INITIALIZE DB (LOCAL; ALL REPS)

  CALL GETDB('SCREEN',3,IRET,INFO,0,ZINFO,0,&
   & -1, ITSLOT, -1, -1, -1, -1)  
  IF(IRET == 0) THEN
    WRITE(NULOUT,'(''     NO (ANY) REPORTS AVAILABLE '')')
  ELSE
    WRITE(NULOUT,'(''      REPORTS (ANY) FOUND: '',I10)') IRET
  ENDIF
  ILEN = IRET

!*          2.8.2 PREPARE FOR PRINT STAT
   
  CALL PRE_PRSTA(.FALSE.,ILEN)

!*          2.8.3 PUT THE DB AWAY

  CALL PUTDB('SCREEN',3,IRET,INFO,0,ZINFO,0)

!*          2.9   ENDDO TIMESLOTS

  IF (LHOOK) CALL DR_HOOK('SCREEN>TS_LOOP',1,ZHOOK_TS_LOOP)
ENDDO TIMESLOT_LOOP
!$OMP END DO
!$OMP END PARALLEL
CALL GSTATS(1082,1)

deallocate(ITS)
WRITE(NULOUT,'('' *** SCREEN; TIME SLOT LOOP FINISHED '')')
CALL FLUSH(NULOUT)

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

!*       3.    FINISH OFF OBSERVATION PROCESSING
!              ---------------------------------

3 CONTINUE

CALL GSTATS(1789,0)

!*          3.0   BRANCH OFF; OLD/NEW STYLE

IF(.NOT.L_F_SCR_WORK_TS) THEN

!*          3.1   OLD STYLE; UPDATE THE EXTENDED CMA FOR COMPRESSION

  WRITE(NULOUT,'('' *** SCREEN_2; UPDATE REPORTS '')')
  WRITE(NULOUT,'(''     ALL TIME SLOTS AND ALL SETS'')')

!           3.1.1 INITIALIZE DB (LOCAL; ALL REPS)

  CALL GETDB('SCREEN',2,IRET,INFO,0,ZINFO,0,&
   & -1, -1, -1, -1, -1, -1)  
  IF(IRET == 0) THEN
    WRITE(NULOUT,'(''     NO (ANY) REPORTS AVAILABLE '')')
  ELSE
    WRITE(NULOUT,'(''     REPORTS (ANY) FOUND: '',I10)') IRET
  ENDIF
  ILEN = IRET

!           3.1.2 UPDATE

  IF(LLUPECMA) THEN
    CALL UPECMA(ILEN)
  ENDIF

!*          3.1.3 PUT THE DB AWAY

  CALL PUTDB('SCREEN',2,IRET,INFO,0,ZINFO,0)

!*          3.2   COLLECT AND PRINT SCREENING STATISTICS
!                 - finally done in '3DVAR' mode

  WRITE(NULOUT,'('' *** SCREEN_3; FINAL STATISTICS FOR ANY REPORTS AVAILABLE '')')
  WRITE(NULOUT,'(''     ALL TIME SLOTS AND ALL SETS'')')
  IF(LSCRE4D) THEN
    CALL ECSET(-1,NOBTOT,0)
  ENDIF

!           3.2.1 INITIALIZE DB (LOCAL; ALL REPS)

  CALL GETDB('SCREEN',3,IRET,INFO,0,ZINFO,0,&
   & -1, -1, -1, -1, -1, -1)  
  IF(IRET == 0) THEN
    WRITE(NULOUT,'(''     NO (ANY) REPORTS AVAILABLE '')')
  ELSE
    WRITE(NULOUT,'(''      REPORTS (ANY) FOUND: '',I10)') IRET
  ENDIF
  ILEN = IRET

!*          3.2.2 PRINT STAT

  CALL PRSTA(0,.TRUE.,ILEN)
  
!*          3.2.3 PUT THE DB AWAY

  CALL PUTDB('SCREEN',3,IRET,INFO,0,ZINFO,0)

!*          3.3   NEW STYLE; WORK LEFT FROM TIMESLOT LOOP

ELSE

!*          3.3.1 PRINT STAT 

  331 CONTINUE
  CALL POST_PRSTA
ENDIF

CALL GSTATS(1789,1)

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

!*       4 .   TERMINATE SCREENING
!              -------------------

4 CONTINUE

!*          4.1   RELEASE THE ARRAYS USED IN SCREENING

CALL DEALSCR(.TRUE.)

!*          4.3   RETURN

WRITE(NULOUT,'('' *** FINISH SCREENING OF OBSERVATIONS '')')
WRITE(NULOUT,'(''     -------------------------------- '')')

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