#ifdef RS6K
@PROCESS NOOPTIMIZE
#endif
SUBROUTINE VERCO(KSET)

!**** SUBROUTINE VERCO - CHECK VERTICAL CONSISTENCY OF MULTILEVEL REPORTS

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

!*    METHOD
!     ------

!     ***CHECK VERTICAL CONSISTENCY OF MULTILEVEL REPORTS TEMP/PILOT/SATEM

!     - CHECK EACH VARIABLE SEPARATELY
!     - SEARCH FOR LAYERS WHERE THERE IS, AT LEAST, ONE VARIABLE WITH FLAG
!       VALUE GRATER THAN ZERO.
!       SUCH A LAYER IS CONSIDERED AS POTENTIALLY BAD. WHEN FOUR SUCCESSIVE
!       POTENTIALLY "BAD" LAYRS ARE FOUND, THEY BECOME "REALLY BAD". IN
!       SUCH A CASE FOR
!       * GEOPOTENTIAL: ALL DATA IN THOSE LAYERS AND ABOVE THESE FOUR ARE
!                       REJECTED AND A PROPER EVENT IS HIT
!       * WIND AND HUMIDITY VARIABLES: ONLY VARIABLES AT THOSE LAYERS
!                                      ARE REJECTED (AND AN EVENT SET)
!                                      (HUMIDITY VARIABLE USED IN TEMP-
!                                      REPORTS IS Q).
!       * TEMPERATURE : AS FOR WIND
!       * THICKNESS AND PWC: ALL VARIABLES OF THE REPORT ARE REJECTED

!     - SATEM THICKNESSES ARE A SPECIAL CASE: EVEN IF ONLY ONE FLAGGED
!       LAYER (OBSERVATION), THAT WOULD BE USED BY THE MINIMIZATION, IS
!       FOUND FROM THE PROFILE, THE WHOLE THICKNESS
!       PROFILE IS REJECTED. THIS IS REQUIRED BY THE MINIMIZATION STEP
!       WHERE ONLY COMPLETE SATEM PROFILES ARE ALLOWED.

!     - FOR SATEMS THERE ARE TWO SPECIAL MULTILEVEL CHECKS: (applied in ADVAR)
!       * MAKE A SUMMARY OF THE F.G. FLAGS FOR THE DIFFERENT LAYERS
!       * CHECK THE STABILITY WITHIN THE TROPOSPHERE. THE TWO LAYERS TO BE
!         USED BY THE STABILITY CHECK ARE SET IN SUBROUTINE SETLEV
!     - IF THE REPORT IS CONSIDERED BAD AFTER EITHER OF THESE CHECKS
!       THE WHOLE PROFILE IS REJECTED

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

!     ***CALL VERCO(KSET)
!     WHERE KSET = ECSET

!        VERCO IS CALLED BY SUBROUTINE DECIS

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

!        RDBFLD  - GET THE (MAXIMUM) RDB-FLAG FOR DATUM
!        FLGDMX  - GET THE MAXIMUM DATUM FLAG
!        FINDL   - FIND INDEX OF THE CLOSEST STD-PRESS LEVEL
!        NGEDSTA - GET DATUM STATUS

!**   MODIFICATIONS
!     -------------
!     97-10-30 Per Unden - Add vertical consistency check for temperature

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

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

USE YOMLUN   , ONLY : NULOUT
USE YOMOBSET_THSAFE
USE YOMOBS   , ONLY : LMFSCREEN
USE YOMCOCTP , ONLY : NTEMP    ,NPILOT   ,NSATEM
USE YOMVNMB  , ONLY : NVNUMB
USE YOMSCREE , ONLY : NDFLMN
USE YOMLEVSE , ONLY : NSTDPL
USE YOMNMEV  , ONLY : ND1EVENT
USE YOMDB
USE YOMSCC   , ONLY : LSCDPR
USE OML_MOD, ONLY : OML_MY_THREAD

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSET 
INTEGER(KIND=JPIM) :: IDSTA(4),IFLAGS(5)
LOGICAL :: LLGEO (NSTDPL)  ,LLTHI (NSTDPL)  ,LLPWC (NSTDPL)&
 & ,LLWND (NSTDPL)  ,LLHUM (NSTDPL)  ,LLTEM (NSTDPL)&
 & ,LLGEOF(NSTDPL)  ,LLTHIF(NSTDPL)  ,LLPWCF(NSTDPL)&
 & ,LLWNDF(NSTDPL)  ,LLHUMF(NSTDPL)  ,LLTEMF(NSTDPL)  

INTEGER(KIND=JPIM) :: ICMVNM, IDFLMX, IFDPRE,&
 & IFDVAR, IGEO, IHUM, ILAYER, ILEV, INSTA, &
 & IOBTYP, IPWC, IRDBMX, ITEM, &
 & ITHI, IWND, J, JINN, JNLV, JOBS, ITID

REAL(KIND=JPRB) :: ZCMPPP, ZDIFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "findl.intfb.h"
#include "flgdmx.intfb.h"
#include "ngedsta.intfb.h"
#include "rdbfld.intfb.h"

#include "fcobs.h"

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

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

!*          1.0   INFORM

IF (LHOOK) CALL DR_HOOK('VERCO',0,ZHOOK_HANDLE)
ITID = OML_MY_THREAD()
IF(LSCDPR) WRITE(NULOUT,'(''     VERTICAL CONSISTENCY CHECK '')')

!*          1.1   OBSERVATION TYPE

IOBTYP = MOD(OBSET(ITID)%MTYPOB(KSET),100)

!*          1.2   SELECT TEMP/PILOT/SATEM

IF(IOBTYP /= NTEMP  .AND.IOBTYP /= NPILOT .AND.IOBTYP /= NSATEM) GOTO 7
!*
!     ------------------------------------------------------------------

!        2.       LOOP OVER THE OBSERVATIONS
!                 --------------------------

OBS_LOOP: DO JOBS = 1, OBSET(ITID)%MLNSET(KSET)

!*          2.1   FIND OUT OBSERVATION POINTER


!*          2.2   INITIALIZE SOME LOGICAL VARIABLES

  DO J = 1, NSTDPL
    LLGEO (J) = .FALSE.    ! GEOPOTENTIAL
    LLTHI (J) = .FALSE.    ! THICKNESS
    LLWND (J) = .FALSE.    ! WIND
    LLHUM (J) = .FALSE.    ! HUMIDITY
    LLPWC (J) = .FALSE.    ! PRECIPITABLE WATER CONTENT
    LLTEM (J) = .FALSE.    ! TEMPERATURE
    LLGEOF(J) = .FALSE.
    LLTHIF(J) = .FALSE.
    LLWNDF(J) = .FALSE.
    LLHUMF(J) = .FALSE.
    LLPWCF(J) = .FALSE.
    LLTEMF(J) = .FALSE.
  ENDDO
!*
!     ------------------------------------------------------------------

!        3.       SEARCH FOR POTENTIALLY BAD LAYERS
!                 ---------------------------------
!*
!           3.0   FIRST LOOP OVER THE REPORT

  FIRST_LOOP: DO JNLV = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    ILEV = JNLV
!*
!           3.1   VARIABLE AND THE MAXIMUM FLAGS

    ICMVNM = ROBODY(ILEV,MDBVNM)
    
!*
!              3.1.1   GET THE (MAXIMUM) RDB-FLAG FOR DATUM

    CALL RDBFLD(ILEV,IRDBMX,IFDPRE,IFDVAR)
!*
!              3.1.2   GET THE MAXIMUM DATUM FLAG

    CALL FLGDMX(ILEV,IDFLMX,IFLAGS)
!*
!           3.2   FIND INDEX OF THE CLOSEST STD-PRESS LEVEL

    ZCMPPP = ROBODY(ILEV,MDBPPP)
    CALL FINDL(ZCMPPP,ILAYER,ZDIFF)
!*
!           3.3   CHECK VARIABLE FLAGS
!                 - CONSIDER MAXIMUM RDB-, FIRST GUESS AND
!                   AND DEPARTURE FLAGS (NO BLACKLIST FLAG)
!*
!             3.3.1   GEOPOTENTIAL

    IF(ICMVNM == NVNUMB( 3)) THEN
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        LLGEO(ILAYER) = .TRUE.
      ENDIF
!*
!             3.3.2   THICKNESS
!                     - SATEM, ONLY IF IT WOULD BE USED IN MINIMIZATION

    ELSEIF(ICMVNM == NVNUMB( 4)) THEN
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        IF(IOBTYP == NSATEM) THEN

          CALL NGEDSTA(INT(ROBODY(ILEV,MDBDSTA)),INSTA,IDSTA)
          IF(.NOT.LMFSCREEN .AND. IDSTA(4) == 0) LLTHI(ILAYER) = .TRUE.
        ELSE
          LLTHI(ILAYER) = .TRUE.
        ENDIF
      ENDIF
!*
!             3.3.3   PRECIPITABLE WATER CONTENT

    ELSEIF(ICMVNM == NVNUMB( 6)) THEN
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        LLPWC(ILAYER) = .TRUE.
      ENDIF
!*
!             3.3.4   WIND (U/V/U10M/V10M)

    ELSEIF(ICMVNM == NVNUMB( 1) .OR. ICMVNM == NVNUMB( 2)  .OR.&
       & ICMVNM == NVNUMB(56) .OR. ICMVNM == NVNUMB(57)) THEN  
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        LLWND(ILAYER) = .TRUE.
      ENDIF
!*
!             3.3.5   HUMIDITY (Q)

    ELSEIF(ICMVNM == NVNUMB(63)) THEN
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        LLHUM(ILAYER) = .TRUE.
      ENDIF
!*
!             3.3.6   TEMPERATURE (T)

    ELSEIF(ICMVNM == NVNUMB(8)) THEN
      IF(IRDBMX > NDFLMN .OR.IFLAGS(2) > NDFLMN .OR.IFLAGS(3) > NDFLMN) THEN
        LLTEM(ILAYER) = .TRUE.
      ENDIF
    ENDIF
!*
!           3.6   CLOSE THE FIRST LOOP

  ENDDO FIRST_LOOP
!*
!     ------------------------------------------------------------------

!*       4.       STUDY THE VERTICAL CONSISTENCY OF LAYERS
!                 ----------------------------------------
!*
!           4.0   INITILIZE SOME COUNTERS

  IGEO = 0
  IWND = 0
  IHUM = 0
  IPWC = 0
  ITHI = 0
  ITEM = 0
!*
!           4.1   GEOPOTENTIAL
!                 - LOOP FROM BOTTOM TO TOP OF ATMOSPHERE
!                 - IF 4 BAD LAYERS ARE FOUND, REJECT THOSE LAYERS AND
!                   ALSO THE ONES ABOVE THESE 4

  GEO_LOOP: DO J = NSTDPL, 1, -1
    IF(LLGEO(J)) THEN
      IGEO = IGEO + 1
    ELSE
      IGEO = 0
    ENDIF
    IF(IGEO == 4) THEN
      DO JINN = J+3, 1, -1
        LLGEOF(JINN) = .TRUE.
      ENDDO
      EXIT GEO_LOOP
    ENDIF
  ENDDO GEO_LOOP
!*
!           4.2   THICKNESS
!                 - IF 4 BAD LAYERS FOUND, REJECT ALL LAYERS
!                 - IF 1 BAD LAYER IN SATEM, REJECT ALL LAYERS

  THI_LOOP: DO J = NSTDPL, 1, -1
    IF(LLTHI(J)) THEN
      IF(IOBTYP == NSATEM .AND. .NOT.LMFSCREEN ) THEN
        ITHI = 4
      ELSE
        ITHI = ITHI + 1
      ENDIF
    ELSE
      ITHI = 0
    ENDIF
    IF(ITHI == 4) THEN
      DO JINN = NSTDPL, 1, -1
        LLTHIF(JINN) = .TRUE.
      ENDDO
      EXIT THI_LOOP
    ENDIF
  ENDDO THI_LOOP
!*
!           4.3   PRECIPITABLE WATER CONTENT
!                 - IF 4 BAD LAYERS FOUND, REJECT ALL LAYERS

  PWC_LOOP: DO J = NSTDPL, 1, -1
    IF(LLPWC(J)) THEN
      IPWC = IPWC + 1
    ELSE
      IPWC = 0
    ENDIF
    IF(IPWC == 4) THEN
      DO JINN = NSTDPL, 1, -1
        LLPWCF(JINN) = .TRUE.
      ENDDO
      EXIT PWC_LOOP
    ENDIF
  ENDDO PWC_LOOP
!*
!           4.4   WIND
!                 - IF 4 BAD LAYERS FOUND, REJECT DATA IN THOSE LAYERS

  WND_LOOP: DO J = NSTDPL, 1, -1
    IF(LLWND(J)) THEN
      IWND = IWND + 1
    ELSE
      IWND = 0
    ENDIF
    IF(IWND == 4) THEN
      DO JINN = J, J+3
        LLWNDF(JINN) = .TRUE.
      ENDDO
      IWND = 0
    ENDIF
  ENDDO WND_LOOP
!*
!           4.5   HUMIDITY
!                 - IF 4 BAD LAYERS FOUND, REJECT DATA IN THOSE LAYERS

  HUM_LOOP: DO J = NSTDPL, 1, -1
    IF(LLHUM(J)) THEN
      IHUM = IHUM + 1
    ELSE
      IHUM = 0
    ENDIF
    IF(IHUM == 4) THEN
      DO JINN = J, J+3
        LLHUMF(JINN) = .TRUE.
      ENDDO
      IHUM = 0
    ENDIF
  ENDDO HUM_LOOP
!*
!           4.6   TEMPERATURE
!                 - IF 4 BAD LAYERS FOUND, REJECT DATA IN THOSE LAYERS

  TEM_LOOP: DO J = NSTDPL, 1, -1
    IF(LLTEM(J)) THEN
      ITEM = ITEM + 1
    ELSE
      ITEM = 0
    ENDIF
    IF(ITEM == 4) THEN
      DO JINN = J, J+3
        LLTEMF(JINN) = .TRUE.
      ENDDO
      ITEM = 0
    ENDIF
  ENDDO TEM_LOOP
!*
!     ------------------------------------------------------------------

!*       5.       CLEAN THE PROFILES ACCORDINGLY (REJECT AND HIT AN EVENT)
!                 --------------------------------------------------------
!*
!           5.0   SECOND LOOP OVER THE REPORT

  SECOND_LOOP: DO JNLV = MLNKH2B(JOBS),MLNKH2B(JOBS+1)-1
    ILEV = JNLV
!*
!           5.1   VARIABLE

    ICMVNM = ROBODY(ILEV,MDBVNM)
!*
!           5.2   FIND INDEX OF THE CLOSEST STD-PRESS LEVEL

    ZCMPPP = ROBODY(ILEV,MDBPPP)
    CALL FINDL(ZCMPPP,ILAYER,ZDIFF)
!*
!           5.3   GEOPOTENTIAL

    IF(ICMVNM == NVNUMB( 3)) THEN
      IF(LLGEOF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
!*
!           5.4   THICKNESS

    ELSEIF(ICMVNM == NVNUMB( 4)) THEN
      IF(LLTHIF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
!*
!           5.5   PRECIPITABLE WATER CONTENT

    ELSEIF(ICMVNM == NVNUMB( 6)) THEN
      IF(LLPWCF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
!*
!           5.6   WIND

    ELSEIF(ICMVNM == NVNUMB( 1) .OR. ICMVNM == NVNUMB( 2)  .OR.&
       & ICMVNM == NVNUMB(56) .OR. ICMVNM == NVNUMB(57)) THEN  
      IF(LLWNDF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
!*
!           5.7   HUMIDITY

    ELSEIF(ICMVNM == NVNUMB(63)) THEN
      IF(LLHUMF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
!*
!           5.8   TEMPERATURE

    ELSEIF(ICMVNM == NVNUMB(8)) THEN
      IF(LLTEMF(ILAYER)) THEN
        ROBODY(ILEV,MDBDSTA) = ZCHSTAT_REJECT( ROBODY(ILEV,MDBDSTA))
        ROBODY(ILEV,MDBDEV1) = ZCHEV1( ROBODY(ILEV,MDBDEV1),ND1EVENT(22))
      ENDIF
    ENDIF
!*
!           5.9   CLOSE THE SECOND LOOP

  ENDDO SECOND_LOOP

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

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

ENDDO OBS_LOOP
!*
!     ------------------------------------------------------------------

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