      SUBROUTINE STBDVR (STB1ST,FRMTIM,SNDTIM,OBSQUL,GEOPOT,
     1                   SLAT,SLON,DELTAH, DELTAL, DELTAS, DELTAT,
     2                   FCINCR,ERSTAT)
      IMPLICIT NONE
C
C***********************************************************************
C
C   NAME- STBDVR
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- ANY
C
C   VERSION- 1.0    DATE- 01/18/95   PROGRAMMER- LEAH CASEY (HUGHES STX)
C   VERSION- 2.0    DATE- 07/28/95   PROGRAMMER- ALEX POZDNYAK  (SMSRC)
C   VERSION- 2.1    DATE- 08/25/95   PROGRAMMER- ALEX POZDNYAK  (SMSRC)
C        ATOVS-177: THE I/O DESCRIPTION FOR FCINCR WAS CHANGED FROM
C                   I TO I/O IN THE DOC BLOCK. FCINCR IS INITIALIZED
C                   TO A MISSING VALUE WHEN STBDVR IS BEING CALLED FOR
C                   THE FIRST TIME. THE LINE OF CODE WAS REMOVED THAT
C                   SETS FCINCR TO I4SPV IF IFAIL IS NOT EQUAL TO 0.
C                   THE STATEMENT "SAVE" FOR VARIABLE FCINCR WAS ADDED
C                   TO THE CODE.
C        ATOVS-182: LOCAL ARGUMENT FCILOC WAS ADDED FOR FORECAST INCREME
C                   THE VARIABLE NAME IN THE "SAVE" STATEMENT WAS
C                   CHANGED FROM FCINCR TO FCILOC. THE VALUE OF FCILOC W
C                   ASSIGNED TO FCINCR BEFORE RETURNING TO THE CALLING
C                   ROUTINE. FCILOC REPLACED FCINCR IN CALL TO PIKNMC.
C   VERSION- 3.0    DATE- 05/14/96   PROGRAMMER- ALEX POZDNYAK, FDC
C      FOR REHOSTING TO THE CRAY, CHANGED ALL I*4 DECLARATIONS TO
C      INTEGER, ALL L*4 TO LOGICAL, AND ALL R*4 DECLARATIONS TO REAL.
C   VERSION- 3.1    DATE- 05/04/98   PROGRAMMER- BRIAN BARIL (RSTX)
C                   STB1ST WAS ADDED TO THE CALLING ROUTINE TO PREVENT 
C                   THE NMC FILES FROM BEING NEEDLESSLY READ MORE THAN
C                   ONCE.  (L. WILSON - REMOVE SML FROM SUBROUTINE CALL
C                   SINCE IT IS IN TOZONE, AND MODS TO MAKE OBSQUL INT.)
C                   ADAPTED TO RETURN THE UPPER DEPARTURE REGARDLESS OF
C                   SURFACE LEVEL.
C   VERSION- 3.2    DATE- 04/18/00   PROGRAMMER- LEAH WILSON (RAYTHEON)
C                   SOFT-CODE SML TEST LIMIT.
C
C   FUNCTION- THIS ROUTINE IS A DRIVER FOR THE STABILITY DEPARTURE
C             CALCULATION AT THE RETRIEVAL GRID POINT LOCATION.  THE
C             VALUES OF STABILITY DEPARTURE, UPPER AND LOWER DEPARTURE,
C             STABILITY TIME DIFFERENCE (BETWEEN THE RETRIEVAL AND THE
C             FORECAST) AND FORECAST INCREMENT (LENGTH OF FORECAST) ARE
C             RETURNED TO THE CALLING ROUTINE FOR OUTPUT TO THE
C             OPERATIONAL DATA BASE.
C
C   CALLING SEQUENCE PARAMETERS-
C     NAME       TYPE  I/O  DESCRIPTION
C     ---------  ----  ---  -------------------------------------------
C     FRMTIM     INT    I   ARRAY (DIM 3) STORING THE FRAME TIME AS YEAR
C                           MONTH, DAY/HOUR, MINUTE/SECOND.
C     GEOPOT     REAL   I   ARRAY (DIM RETPARM:PRFTLV) OF RETRIEVED
C                           GEOPOTENTIAL HEIGHTS AT PRFTLV LEVELS.
C     OBSQUL     INT    I   OBSERVATION QUALITY FLAG OF RETRIEVAL
C     SLAT       REAL   I   VARIABLE CONTAINING RETRIEVAL LATITUDE.
C     SLON       REAL   I   VARIABLE CONTAINING RETRIEVAL LONGITUDE.
C     SNDTIM     INT    I   ARRAY (DIM 3) OF RETRIEVAL TIME, IN SAME FOR
C                           AS FRMTIM ARRAY.
C     DELTAH     REAL   O   VARIABLE CONTAINING UPPER DEPARTURE
C     DELTAL     REAL   O   VARIABLE CONTAINING LOWER DEPARTURE.
C     DELTAS     REAL   O   VARIABLE CONTAINING STABILITY DEPARTURE.
C     DELTAT     INT    O   VARIABLE CONTAINING TIME DIFFERENCE BETWEEN
C                           RETRIEVAL AND FORECAST.
C     FCINCR     INT   I/O  FORECAST INCREMENT IS EQUAL TO THE LENGTH OF
C                           FORECAST (EITHER 6, 12, OR 18 HOURS).
C     ERSTAT     INT    O   ERROR RETURN CODE.
C
C
C   COMMON AREA PARAMETERS- RETPARM, MONSTA, OZONE, SPVAL
C
      INCLUDE 'RETPARM'
      INCLUDE 'MONSTA'
      INCLUDE 'OZONE'
      INCLUDE 'STBCOM'
      INCLUDE 'SPVAL'
C
C   LOCAL PARAMETERS-
C     NAME          TYPE      DESCRIPTION
C     --------      ----      -----------
C     STB1ST        LOG       VARIABLE SET TO .TRUE. IF THIS IS 1ST
C                             CALL TO STBDVR.
C     CNSTP         REAL      ARRAY (DIM 2) OF CONSTANTS RELATING
C                             PRESSURE LEVELS 1&2 AND 3&4.
C     FCHRS         INT       VALID FORECAST TIME.
C     FHOURS        INT       JULIAN HOUR OF CURRENT FRAME TIME.
C     FRCHRS        INT       VALID FORECAST TIME CLOSEST TO CURRENT
C                             FRAME TIME.
C     HOURS         INT       ARRAY (DIM 5) STORING THE JULIAN HOUR OF
C                             EACH NMC FORECAST FILE.
C     STATUS        INT       ERROR STATUS CODE RETURNED BY CALLED
C                             ROUTINE.
C     IPRESS        INT       ARRAY (DIM 4) OF RETRIEVAL PRESSURE LEVEL.
C     GLOBEG        REAL      ARRAY (DIM 5 X 4 X 2 X 145 X 37) OF GLOBAL
C                             GRIDDED NMC GEOPOTENTIAL HEIGHTS WHERE
C                             THERE ARE 5 NMC FORECAST FILES, 4 PRESSURE
C                             LEVELS, 2 HEMISPHERES,(1=NORTH, 2=SOUTH),
C                             145 LONGITUDES IN 2-1/2 DEGREE INCREMENTS,
C                             AND 37 LATITUDES IN 2-1/2 DEGREE
C                             INCREMENTS.
C     JHOURS        INT       JULIAN HOUR OF RETRIEVAL.
C     PINPUT        INT       ARRAY (DIM 4) OF INPUT PRESSURES IN
C                             ASCENDING ORDER.
C     RINPUT        REAL      ARRAY (DIM 4) OF REAL VALUES OF PINPUT.
C     STBDIF        INT       MAXIMUM TIME DIFFERENCE ALLOWED FOR
C                             FINDING CLOSEST FORECAST TO RETRIEVAL.
C     STDBUG        INT       STABILITY DEBUG (1 = ON).
C     NMCFIL        INT       FLAG DENOTING WHICH FORECAST FILE IS
C                             CHOSEN.
C     K             INT       DO LOOP VARIABLE.
C     HI8NMC        REAL      ARRAY (DIM 4) OF GEOPOTENTIAL HEIGHTS
C                             INTERPOLATED TO THE RETRIEVAL LOCATION.
C     HI8TOV        REAL      ARRAY (DIM 4) OF GEOPOTENTIAL HEIGHTS FOR
C                             FOUR TOVS PRESSURE LEVELS.
C     IFAIL         INT       TEST FAILURE FLAG WHOSE VALUE DETERMINES
C                             WHICH, IF ANY, COUNTERS ARE INCREMENTED
C                             IN COMMON BLOCK /MONSTA/.  IF THIS FLAG
C                             GETS SET TO A NON-ZERO VALUE, NO STABILITY
C                             DEPARTURE IS CALCULATED.
C     FCILOC        INT       LOCAL VARIABLE FOR FORECAST INCREMENT.
C
C   SUBROUTINES CALLED- STBFLG, RDNMC, PIKNMC, NMC2RT, STABLT.
C
C   FUNCTIONS USED- JULHR
C
C   EXIT STATES- ERSTAT = 99 - FATAL ERROR: ERROR OCCURRED IN A LOWER
C                              LEVEL ROUTINE.
C
C***********************************************************************
C
      INTEGER     FRMTIM(3), SNDTIM(3), FCINCR, ERSTAT, DELTAT, OBSQUL
      REAL        SLAT, SLON, GEOPOT(PRFTLV)
      REAL        DELTAS, DELTAL, DELTAH
C
      INTEGER   FCHRS, JHOURS, HOURS(5), FRCHRS, JULHR
      INTEGER   IFAIL, STATUS, FHOURS, NMCFIL
      INTEGER   K, FCILOC
      REAL      HI8NMC(4), HI8TOV(4)

      LOGICAL   STB1ST,NFIRST
      SAVE      HOURS,FCILOC
C
C
C
C INITIALIZE VARIABLE.
C
C

      ERSTAT = 0
      IFAIL = 0
      DELTAH = R4SPV
      DELTAL = R4SPV
      DELTAS = R4SPV
      DELTAT = I4SPV
      NFIRST = .FALSE. 
C
      IF(STB1ST) THEN
C
C     INITIALIZE  FCINCR TO I4SPV IF STBDVR IS BEING CALLED
C     FOR THE FIRST TIME.
C
          NFIRST = .TRUE.
          FCINCR = I4SPV
          FCILOC = I4SPV
C
C     COMPUTE CONSTANTS TO RELATE PRESSURE LEVELS 1 AND 2, AND 3 AND 4.
C
         CNSTP(1) = 9.80665 / (287.04 *
     1              ALOG(REAL(PINPUT(1))/REAL(PINPUT(2))))
         CNSTP(2) = 9.80665 / (287.04 *
     1              ALOG(REAL(PINPUT(3))/REAL(PINPUT(4))))
         STB1ST = .FALSE.
C
C     READ ALL OF THE NMC FORECAST FILES FOR THE 4 PRESSURE LEVELS INTO
C     BUFFER.
C
         CALL RDNMC(HOURS, STATUS)
         IF (STATUS .EQ. 99) THEN
            ERSTAT = 99
            RETURN
         ENDIF

C
C     CONVERT FRAME TIME TO JULIAN HOURS.
C
         FHOURS = JULHR(FRMTIM)
     
C
C     PICK THE NMC FORECAST FILE CLOSEST IN TIME TO THIS FRAME.
C
         CALL PIKNMC(HOURS,FHOURS, STBDIF,NMCFIL,FCILOC,
     1                          FRCHRS, STATUS)
         FCINCR = FCILOC
         IF (STATUS .EQ. 99) THEN
             ERSTAT = 99
             RETURN
         ENDIF
      ENDIF
C
C     CONVERT TIME OF RETRIEVAL TO JULIAN HOURS.
C
      JHOURS = JULHR(SNDTIM)
C
C     COMPUTE THE NUMBER OF HOURS BETWEEN THE FORECAST AND RETRIEVAL
C     TIMES.  IF THIS DIFFERENCE EXCEEDS THE MAXIMUM, SEARCH THE
C     FORECAST FILES AGAIN TO FIND A CLOSER ONE.
C
      DELTAT = JHOURS - FRCHRS

      IF(ABS(DELTAT).GT.STBDIF) THEN
         CALL PIKNMC(HOURS, JHOURS, STBDIF, NMCFIL, FCILOC,
     1               FCHRS, STATUS)
         FCINCR = FCILOC
         IF (STATUS .EQ. 99) THEN
             ERSTAT = 99
             RETURN
         ENDIF
         DELTAT = JHOURS - FCHRS
         NFIRST = .TRUE.
C
C     RESET THE VALID FORECAST TIME CLOSEST TO THE FRAME TO THIS
C     NEW TIME SO AS NOT TO CALL PIKNMC AGAIN FOR THE NEXT SPOT.
C
         FRCHRS = FCHRS
      ENDIF
C
C     SCREEN THE RETRIEVAL BEFORE THE STABILITY DEPARTURE CALCULATION.
C
C     IF THE 1000 MB HEIGHT IS NOT ABOVE THE SURFACE, TEST FAILS.
C
C     ASSIGN LEVEL 1000 GEOPOTENTIAL TO HI8TOV

      HI8TOV(4) = GEOPOT(IPRESS(4))  

C
C     CHECK FOR SUPERADIABATIC RETRIEVAL.
C

       IF(STABTEST(2).EQ.1.AND.SUPFLG.EQ.1) IFAIL = 222

C
C     EXTRACT FILTER FLAG AND SEE IF RETRIEVAL IS OF DESIRED QUALITY.
C     ONLY 'GOOD' OR 'GOOD BUT REDUNDANT' RETRIEVALS ARE ACCEPTABLE.
C
      IF(STABTEST(3).EQ.1.AND.(OBSQUL.NE.0.AND.OBSQUL.NE.1))IFAIL = 333

C
C     IF THE IFAIL FLAGS IS ACCEPTABLE THEN CALCULATE THE STABILITY
C     DEPARTURE AND ASSOCIATED VALUES FOR THIS RETRIEVAL.
C

      IF(IFAIL.EQ.0) THEN

C
C     FILL IN THE REST OF THE HI8TOV ARRAY.
C
         DO 100 K=1,3
            HI8TOV(K) = GEOPOT(IPRESS(K))


  100    CONTINUE

C
C     IF THE HI8TOV ARRAY IS ALL ZEROS THEN NO RETRIEVAL WAS MADE SO
C     DO NOT COMPUTE ANY STABILITY VALUES.
C
         IF(STABTEST(5).EQ.1) THEN 
            IF(HI8TOV(1).LE.0.0.AND.HI8TOV(2).LE.0.0.AND.HI8TOV(3).LE.
     1                      0.0.AND.HI8TOV(4).LE.0.0) IFAIL = 555
         ENDIF
C
         IF(IFAIL.EQ.0) THEN
C
C     GET NMC GEOPOTENTIAL HEIGHTS AT THE SOUNDING LOCATION.
C

            CALL NMC2RT(NFIRST,SLAT, SLON, NMCFIL, HI8NMC)

C
C     COMPUTE THE STABILITY INDICATOR BETWEEN A RETRIEVAL LOCATION
C     AND THE CLOSEST FORECAST.
C
            CALL STABLT(CNSTP, HI8NMC, HI8TOV, DELTAS, DELTAL,
     1                  DELTAH)

         ENDIF
C
      ENDIF
C
C     IF THE IFAIL FLAG IS SET TO NON-ZERO, SET STABILITY VALUES TO
C     MISSING.  DO NOT RESET THE VALUE IN FCINCR.
C
      IF(IFAIL.NE.0) THEN
         DELTAS = R4SPV
         DELTAL = R4SPV
         DELTAH = R4SPV
         DELTAT = I4SPV
      ENDIF
C
C IF THE SURFACE MODEL LEVEL IS LESS THAN THE LIMIT, DO NOT COMPUTE
C LOWER DEPARTURE.
C
      IF(STABTEST(4).EQ.1.AND.SML.LT.SMLIMIT) THEN
       DELTAS = R4SPV
       DELTAL = R4SPV
c       DELTAT = I4SPV
       IFAIL = 444
      ENDIF
       
C
C     INCREMENT TEST FAILURE AND TOTAL COUNTS.
C
C *** NOTE ***  THE CURRENT FAILURE FLAG REFLECTS ONLY THE
C LAST TEST FAILED.  THE TOTAL NUMBER OF FAILED SPOTS CAN
C BE DETERMINED BY SUMMING THE COUNTS IN THE FAILCT ARRAY.
C IF THE NUMBER OF FAILURES PER TEST IS DESIRED IN THE FUTURE
C AND THE TOTAL NUMBER OF FAILED SPOTS IS STILL DESIRED, THEN
C A 'FAILED SPOTS' VARIABLE NEEDS TO BE ADDED TO THE COMMON
C BLOCK AND THE CODE IN THIS ROUTINE NEEDS TO BE RESTRUCTURED
C TO INCREMENT THE APPROPRIATE COUNTER AS SOON AS A TEST FAILS.
C THE 'FAILED SPOTS' COUNTER COULD THEN BE INCREMENTED BEFORE
C THE ROUTINE RETURNS, IF THE VALUE OF IFAIL IS GREATER THAN 0.
C ****
C
      IF(IFAIL.EQ.111) THEN
         FAILCT(1) = FAILCT(1) + 1
      ELSEIF(IFAIL.EQ.222) THEN
         FAILCT(2) = FAILCT(2) + 1
      ELSEIF(IFAIL.EQ.333) THEN
         FAILCT(3) = FAILCT(3) + 1
      ELSEIF(IFAIL.EQ.444) THEN
         FAILCT(4) = FAILCT(4) + 1
      ELSEIF(IFAIL.EQ.555) THEN
         FAILCT(5) = FAILCT(5) + 1
      ENDIF
      TOTCNT = TOTCNT + 1
C
C     RETURN TO CALLING ROUTINE.
C
      RETURN
      END
