      SUBROUTINE QCHECK(QVECTR,QFSTGS,TMPVCT,PRLVLS,CHGFLG,QFLAG)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME-  QCHECK
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- HDS 9000
C
C   VERSION- 1.0    DATE- 5/12/92    PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 2.0    DATE- 07/19/94   PROGRAMMER- FRANK TILLEY (SMSRC)
C       ATOVS-12    EXPLICITLY DECLARED R*4 FUNCTION "W".
C   VERSION- 2.1    DATE- 1/27/95    PROGRAMMER- CARLA NEIGH (SMSRC)
C     ** ATOVS-58 : ADD CHECK FOR MISSING VALUES FOR MIXING RATIO.
C                   IF RETRIEVED OR FIRST GUESS VALUE IS MISSING FOR A
C                   LEVEL, CHECKS FOR THAT LEVEL ARE SKIPPED.
C   VERSION- 3.0    DATE- 6/3/96    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 4.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C        Replace R4SPV equivalence test with ISR4SPV function
C   VERSION- 4.1    DATE- 10/17/06   PROGRAMMER- FRANK TILLEY (IMSG)
C        REPLACED FUNCTION W WITH FUNCTION TDEW2MR FOR COMPUTING 
C        MIXING RATIO.
C
C   FUNCTION- THIS SUBROUTINE CHECKS A VECTOR OF RETRIEVED WATER VAPOR
C             MIXING RATIOS AND PERFORMS TWO TESTS.  THE FIRST TEST
C             CONSTRAINS RETRIEVED WATER VAPOR MIXING RATIOS TO NO
C             MORE THAN A 50% DEVIATION FROM THE FIRST GUESS. THE
C             SECOND TEST CHECKS FOR RETRIEVED WATER VAPOR MIXING RATIOS
C             THAT ARE NOT BETWEEN 0.0 AND THE SATURATION MIXING RATIO.
C             IF THE RETRIEVED WATER VAPOR MIXING RATIO IS LESS THAN
C             ZERO, THE RETRIEVED WATER VAPOR MIXING RATIO IS REPLACED
C             WITH A VERY SMALL POSITIVE VALUE. IF THE RETRIEVED WATER
C             VAPOR MIXING RATIO IS GREATER THAN THE SATURATION MIXING
C             RATIO, THE WATER VAPOR MIXING RATIO IS REPLACED BY THE
C             SATURATION MIXING RATIO.
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR RTOVS BASELINE ON
C                THE CRAY.
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   QVECTR  REAL   I/O   VECTOR (DIM NUMLVL) OF WATER VAPOR MIXING
C                        RATIOS TO BE CHECKED (VALUES ARE IN G/KG).
C                        VALUES IN THE VECTOR ARE REPLACED AS NEEDED.
C   QFSTGS  REAL    I    VECTOR (DIM NUMLVL) OF FIRST GUESS WATER
C                        VAPOR MIXING RATIOS (VALUES ARE IN G/KG).
C   TMPVCT  REAL    I    VECTOR (DIM NUMLVL) OF TEMPERATURES (IN K)
C                        AT LEVELS CORREPSONDING TO VALUES OF WATER
C                        VAPOR MIXING RATIOS.
C   NUMLVL  INT     I    NUMBER OF LEVELS OF WATER VAPOR MIXING RATIO.
C   PRLVLS  REAL    I    VECTOR (DIM NUMLVL) CONTAINING PRESSURE (IN MB)
C                        AT EACH LEVEL FOR THE WATER VAPOR MIXING RATIO.
c   chgflg   LOG    O    FLAG SET TO .TRUE. IF ANY RETRIEVAL MIXING RATIO
C                        VALUE IS ADJUSTED.
C   QFLAG    INT    O    SET TO NON-ZERO VALUE DEPENDING UPON WHAT KIND
C                        OF ADJUSTMENT IS MADE TO THE RETRIEVAL MIXING
C                        RATIO PROFILE.
C                          0 = NO ADJUSTMENT
C                          1 = RETRIEVED MR SUPERSATURATED
C                          2 = RETRIEVED MR IS MORE THEN 50% HIGHER THAN
C                              GUESS MR
C                          3 = RETRIEVED MR IS LESS THAN 0.00001 G/KG
C                          4 = RETRIEVED MR IS MORE THAN 50% LOWER THAN
C                              GUESS MR
C
C   LOCAL PARAMETERS-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   HIVAL   REAL   HIGH VALUE FOR FIRST GUESS CONSTRAINT CHECK.
C   LOVAL   REAL   LOW VALUE FOR FIRST GUESS CONSTRAINT CHECK.
C   LVL     INT    DO LOOP COUNTER FOR LEVELS
C   QGUESS  REAL   GUESS MIXING RATIO FOR A GIVEN LEVEL
C   SATMIX  REAL   SATURATION MIXING RATIO
C   TEMPC   REAL   TEMPERATURE VALUE IN DEGREES CELSIUS.
C
C   FUNCTIONS USED - TDEW2MR
C
C   EXIT STATES- NONE
C***********************************************************************
      INCLUDE 'RETPARM'

      REAL QVECTR(PRFQLV), TMPVCT(PRFQLV), PRLVLS(PRFQLV)
      REAL QFSTGS(PRFQLV)
      logical chgflg
      INTEGER QFLAG
C
      REAL TEMPC, SATMIX, HIVAL, LOVAL, TDEW2MR, QGUESS
      INTEGER LVL
      LOGICAL   ISR4SPV
C
      INCLUDE 'SPVAL'

      chgflg = .false.
      QFLAG = 0
C
      DO 10 LVL = 1, PRFQLV
C
        IF (ISR4SPV((QVECTR(LVL))).OR.(ISR4SPV(QFSTGS(LVL)))) GOTO 10
C
C  CONSTRAIN THE RETRIEVED WATER VAPOR MIXING RATIO VALUE TO NO MORE
C  THAN A 50% DEVIATION FROM THE FIRST GUESS.
C
        QGUESS = QFSTGS(LVL)
        HIVAL = 1.5 * QGUESS
        LOVAL =  .5 * QGUESS
        IF (QVECTR(LVL) .GT. HIVAL) THEN
           QVECTR(LVL) = HIVAL
           IF (QFLAG.LT.2) QFLAG = 2
           chgflg = .true.
        ELSEIF (QVECTR(LVL) .LT. LOVAL) THEN
           QVECTR(LVL) = LOVAL
           IF (QFLAG.LT.4) QFlAG = 4
           chgflg = .true.
        ENDIF
C
C  IF THE WATER VAPOR MIXING RATIO IS LESS THAN A MINIMUM VALUE,
C  REPLACE IT WITH A MINIMUM VALUE.
C
c       IF (QVECTR(LVL) .LE. 0.0) THEN
        IF (QVECTR(LVL) .LT. 0.00001) THEN
c          QVECTR(LVL) = 0.0001
           QVECTR(LVL) = 0.00001
           IF (QFLAG.LT.3) QFLAG = 3
           chgflg = .true.
C
        ELSE
C
C  CHECK TO SEE IF THE WATER VAPOR MIXING RATIO IS GREATER THAN THE
C  SATURATION MIXING RATIO.  IF SO, REPLACE THE WATER VAPOR MIXING
C  RATIO WITH THE SATURATION MIXING RATIO.
C
           TEMPC = TMPVCT(LVL) - 273.16
C
           SATMIX = TDEW2MR(PRLVLS(LVL),TEMPC)
C
           IF (QVECTR(LVL) .GT. SATMIX) THEN
              QVECTR(LVL) = SATMIX
              IF (QFLAG.LT.1) QFLAG = 1
              chgflg = .true.
           END IF
C
        ENDIF
C
   10 CONTINUE
C
      RETURN
      END
