      SUBROUTINE LBSRCH2(PATHID,BRTTMP,FCSTMP,RLAT,TERTYP,VGUESS,PGUESS,
     1                 SIMRAD,CLOPHO,ERSTAT)
      IMPLICIT NONE
C***********************************************************************
C
C   NAME- LBSRCH
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 6/11/93    PROGRAMMER- CARLA A. NEIGH, SMSRC
C   VERSION- 2.0    DATE- 5/25/94    PROGRAMMER- JEFF MANNING, SMSRC
C            XATOV-7 ADDED THE PARAMETER FILE /CDBPARM/ BEFORE THE
C            COMMON /COMCDB/.
C   VERSION- 2.1    DATE- 7/06/94    PROGRAMMER- ALEX POZDNYAK, SMSRC
C            SATOV-16  ARGUMENT RGUESS CHANGED TO PGUESS AND HAVE
C            DIMENSION NUMCHN + NANCIL.
C   VERSION- 2.2    DATE- 8/09/94    PROGRAMMER- SURYA JANDHYALA, SMSRC
C            XATOV-27  ADDED AN EXTRA CALLING ARGUMENT 'NUMLVL' IN THE
C                      CALL TO PCSTBL.
C   VERSION- 2.3    DATE- 12/20/94    PROGRAMMER- ALEX POZDNYAK, SMSRC
C            XATOV-82  ARGUMENTS NUMCHN AND NUMLVL REMOVED FROM CALL TO
C                      PCSTBL. OPEN STATEMENTS REMOVED.
C   VERSION- 2.4    DATE- 08/30/95    PROGRAMMER- LI LU, SMSRC
C            ATOVS-187 USE OF LOCAL PARAMETER LIBLIM IS REMOVED AND
C	     REPLACED WITH RETPARM:LIBLIM.
C   VERSION- 3.0    DATE- 06/03/96    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 06/11/96    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.2    DATE- 07/30/97    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.3    DATE- 10/07/97    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.4    DATE- 11/19/97    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.5    DATE- 04/20/98    PROGRAMMER- LEAH WILSON (RSTX)
C   VERSION- 3.6    DATE- 10/12/99    PROGRAMMER- LEAH WILSON (RAYTHEON)
C   VERSION- 3.7    DATE- 11/9/00     PROGRAMMER- M.P.FERGUSON (RITSS)
C   VERSION- 3.8    DATE- 05/03/01    PROGRAMMER- FRANK TILLEY (RAYTHEON)
C
C   FUNCTION-   THIS SUBROUTINE PERFORMS LIBRARY SEARCH TO FIND
C               THE FIRST GUESS TEMPERATURE/MIXING RATIO VECTOR AND THE
C               FIRST GUESS RADIANCE VECTOR FOR A RETRIEVAL DATA POINT.
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE ON
C                THE CRAY.
C   VERSION 3.1- ADDED BUFFERS TO THE SAVE STAMEMENT IN ORDER FOR VALUES
C                TO BE PRESERVED BETWEEN CALLS.
C   VERSION 3.2- CONVERT CDB UTILITIES TO NEW 8-BYTE CONVENTION.
C   VERSION 3.3- ADD CLOSENESS MEASURE TO SUBROUTINE CALL.
C   VERSION 3.4- USE SPLIT LAND/SEA EIGENVECTORS.
C   VERSION 3.5- ADD /MONSTA/ TO MONITOR HOW RETRIEVAL FLAG IS SET TO 0.
C   VERSION 3.6- COUNT HOW RETRIEVAL FLAG IS SET TO 0 PER FRAME.  ADD
C                /FRMINF/ (AND /INSPARM/ AND /INSCOM/ SO /FRMINF/ WORKS).
C                INVOLVES LBRETSPT0.
C   VERSION 3.7  FIRST GUESS CHANNEL COMBINATIONS CALCULATED FROM CDB
C                CDB EIGFLAGS AND PASSED TO PCSTBL SO THAT ONLY CHANNELS
C                ACTUALLY USED IN FIRST GUESS ARE CONVERTED TO BRIGHTNESS
C                TEMPERATURES.
C   VERSION 3.8  FOR WR #153 - REMOVED REQUIREMENT FOR NCEP FORECAST
C                DATA FROM THE CRITERIA FOR MAKING A FIRST GUESS UNLESS
C                HIRS CHANNEL 8 IS SPECIFIED IN THE CHANNEL COMBINATION.
C                REMOVED UNDECLARED VARIABLE 'PCSLIM' FROM THE CALLS
C                TO SRCHFG AND SRCHF2. PCSLIM WAS DECLARED IN THOSE
C                TWO SUBROUTINES, BUT IT WAS NEVER USED. ADDED FLAG
C                'USEFCS' TO THE ARGUMENTS FOR CALLS TO SRCHFG AND
C                SRCHF2.
C   VERSION- 4.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C        Replace R4SPV equivalence test with ISR4SPV function
C
C   FILES-
C    UNIT   I/O         DSN                  DESCRIPTION
C    ----   ---  -------------------  ------------------------------
C    CLRUNT  I    NSS. ... .FGLIBCLR   CLEAR FIRST GUESS LIBRARY.
C    CLDUNT  I    NSS. ... .FGLIBCLD   CLOUDY FIRST GUESS LIBRARY.
C    CDBUNT  I    NSS. ... .CDB        COEFFICIENT DATABASE.
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   PATHID  INT     I    RETRIEVAL PATH ID (1 = CLEAR/CLOUD-CLEARED,
C                        2 = CLOUDY, 3 = NO-HIRS).
C   BRTTMP  REAL    I    ARRAY (DIM RETPARM:NUMCHN)
C                        CONTAINING THE BRIGHTNESS TEMPERATURES
C                        FOR EACH OF THE SOUNDINGS INSTRUMENT
C                        CHANNELS FOR A RETRIEVAL DATA POINT.
C   FCSTMP  REAL    I    FORECAST SURFACE POTENTIAL TEMPERATURE.
C   RLAT    REAL    I    LATITUDE OF RETRIEVAL DATA POINT.
C   TERTYP  INT     I    TERRAIN TYPE OF RETRIEVAL DATA POINT
C                        (0 = SEA, 1 = LAND).
C   VGUESS  REAL    O    ARRAY (DIM RETPARM:NUMLVL) CONTAINING
C                        THE FIRST GUESS FOR TEMPERATURE AND WATER
C                        VAPOR MIXING RATIO.
C   PGUESS  REAL    O    ARRAY (DIM RETPARM:NUMCHN+RETPARM:NANCIL)
C                        CONTAINING THE FIRST GUESS RADIANCES.
C   SIMRAD  REAL    O    ARRAY (DIM RETPARM:NUMCHN) CONTAINING
C                        SIMULATED RADIANCES.
C   CLOPHO  REAL    O    CLOSENESS MEASURE.
C   ERSTAT  INT     O    ERROR RETURN CODE
C                         = 0 IF NO ERROR OCCURRED,
C                         = 10 IF A NON-FATAL ERROR OCCURRED,
C                         = 99 IF A FATAL ERROR OCCURRED.
C
C   LOCAL PARAMETERS-
C   NAME    TYPE   DESCRIPTION
C   ----    ----   -----------
C   CDBST   INT    CDB ERROR STATUS CODE.
C   FIRST   LOG    LOGICAL FLAG SET TRUE ON FIRST CALL TO ROUTINE,
C                  AND SET FALSE ON SUBSEQUENT CALLS.
C   LIBUNT  INT    FIRST GUESS LIBRARY UNIT NUMBER.
C   NMCLST  INT    THE NUMBER OF GUESS LIBRARY VECTORS TO AVERAGE
C                  TOGETHER IN GENERATING THE FINAL GUESS VECTOR.
C   NUMOBS  INT    ARRAY (DIM 2) CONTAINING THE NUMBER OF OBSERVATIONS
C                  IN EACH OF THE RETRIEVAL PATH FIRST GUESS LIBRARIES.
C   STATUS  INT    ERROR STATUS RETURNED FROM CALLED ROUTINES.
C   TABLE   REAL   ARRAY (DIM (RETPARM:NUMCHN)+7 X RETPARM:LIBLIM X 2)
C                  CONTAINING THE PRINCIPAL COMPONENT SCORES,
C                  BRIGHTNESS TEMPERATURES, FORECAST SURFACE POTENTIAL
C                  TEMPERATURE, LATITUDE, AND TERRAIN TYPE FOR EACH
C                  OF THE RETRIEVAL PATH FIRST GUESS LIBRARIES.
C   USEFCS  LOG    FLAG SPECIFYING WHETHER OR NOT THE NCEP FORECAST
C                  SURFACE POTENTIAL TEMPERATURE IS TO BE USED.
C
C   SUBPROGRAMS CALLED- PCSTBL, INTCOEF, SRCHFG, LBSRC$
C
C   FUNCTIONS USED-
C
C   EXIT STATES-
C     ERSTAT = 10 : FIRST GUESS COULD NOT BE DETERMINED.
C     ERSTAT = 99 : I/O ERROR OCCURRED READING A FIRST GUESS
C                   LIBRARY OR THE CDB.
C
C***********************************************************************
C
      INCLUDE 'RETPARM'
      INCLUDE 'CLASIF'
      INCLUDE 'MONSTA'
      INCLUDE 'SPGUNT'
      INCLUDE 'SPVAL'
      INCLUDE 'INSPARM'
      INCLUDE 'INSCOM'
      INCLUDE 'FRMINF'
C
      INTEGER PATHID, TERTYP, ERSTAT, NMCLST 
      INTEGER CHANUSED(2,NUMCHN),IFLG,IBT,ITER,ICHAN
      REAL BRTTMP(NUMCHN), VGUESS(NUMLVL), PGUESS(NUMCHN+NANCIL)
      REAL FCSTMP, RLAT, SIMRAD(NUMCHN), CLOPHO
C
      INTEGER LIBUNT, NUMOBS(2), STATUS
      INTEGER CDBST, ICH
      REAL TABLE(21+NUMCHN,LIBLIM,2)
      LOGICAL FIRST, USEFCS
      LOGICAL   ISR4SPV
C
      DATA FIRST/.TRUE./
      DATA USEFCS/.FALSE./
      SAVE FIRST, TABLE, NUMOBS, NMCLST, USEFCS
C
      ERSTAT = 0
C
C  GET TABLES NEEDED FOR LIBRARY SEARCH FOR ALL PATHS ON FIRST CALL
C  TO ROUTINE, THEN OPEN LIBRARIES FOR DIRECT ACCESS.
C
      IF (FIRST) THEN
C
C     CREATE FLAG 'CHANUSED' WHICH INDICATES WHAT THE FIRST GUESS 
C     CHANNEL COMBINATIONS ARE FOR EACH TARM PATH/TERRAIN COMBINA-
C     TION, FOR USE IN PCSTBL.  FIRST FOR CLEARS.
C
        DO ITER = 1,2
          DO ICHAN = 1,NUMCHN
           CHANUSED(ITER,ICHAN) = 0
           IF(ICHAN.LE.20)THEN
             IFLG = P1EGFL(1,ITER)
             IBT = 32-ICHAN
           ELSE
             IFLG = P1EGFL(2,ITER)
             IBT = 32-ICHAN+20
           ENDIF
           IF (BTEST(IFLG,IBT)) THEN
              CHANUSED(ITER,ICHAN) = 1
           ENDIF
          END DO
        END DO
        PRINT *, 'CLEAR, SEA CHANUSED FLAG IS ',(CHANUSED(1,ICH), 
     +     ICH=1,35)
        PRINT *, 'CLEAR, LND CHANUSED FLAG IS ',(CHANUSED(2,ICH), 
     +     ICH=1,35)
C
C     READ THE CLEAR FIRST GUESS LIBRARY AND BUILD A TABLE OF THE
C     PRINCIPAL COMPONENT SCORES FOR EACH RECORD.
C
        CALL PCSTBL(CLRUNT,LIBLIM,TABLE(1,1,1),NUMOBS(1),CHANUSED,
     +     STATUS)
        IF (STATUS .NE. 0) THEN
           print *,'STATUS from PCSTBL for clear: ',STATUS
           ERSTAT = 99
           RETURN
        ENDIF
        PRINT *,' Number of clear observations from guess library: ',NUMOBS(1)
C
C     CREATE FLAG 'CHANUSED' WHICH INDICATES WHAT THE FIRST GUESS 
C     CHANNEL COMBINATIONS ARE FOR EACH TARM PATH/TERRAIN COMBINA-
C     TION, FOR USE IN PCSTBL.  NOW FOR CLOUDIES.
C
        DO ITER = 1,2
          DO ICHAN = 1,NUMCHN
           CHANUSED(ITER,ICHAN) = 0
           IF(ICHAN.LE.20)THEN
             IFLG = P2EGFL(1,ITER)
             IBT = 32-ICHAN
           ELSE
             IFLG = P2EGFL(2,ITER)
             IBT = 32-ICHAN+20
           ENDIF
           IF (BTEST(IFLG,IBT)) THEN
              CHANUSED(ITER,ICHAN) = 1
           ENDIF
          END DO
C
C     IF CHANNEL 8 IS SET IN THE CHANNEL COMBINATIONS FOR
C     CLOUDY RETRIEVALS, IT IS TO BE REPLACED WITH THE
C     FORECAST SURFACE POTENTIAL TEMPERATURE. SET THE
C     'USEFCS' FLAG TO .TRUE.
C
          IF (CHANUSED(ITER,8).EQ.1) USEFCS = .TRUE.
        END DO
        PRINT *, 'CLOUDY, SEA CHANUSED FLAG IS ',(CHANUSED(1,ICH), 
     +     ICH=1,35)
        PRINT *, 'CLOUDY, LND CHANUSED FLAG IS ',(CHANUSED(2,ICH), 
     +     ICH=1,35)
C
C     READ THE CLOUDY FIRST GUESS LIBRARY AND BUILD A TABLE OF THE
C     PRINCIPAL COMPONENT SCORES FOR EACH RECORD.
C
        CALL PCSTBL(CLDUNT,LIBLIM,TABLE(1,1,2),NUMOBS(2),CHANUSED,
     +      STATUS)
        IF (STATUS .NE. 0) THEN
           print *,'STATUS from PCSTBL for cloudy: ',STATUS
           ERSTAT = 99
           RETURN
        ENDIF
        PRINT *,' Number of cloudy observations from guess library: ',NUMOBS(2)
C
C     GET THE NUMBER OF VECTORS TO AVERAGE
C
        CALL INTCOEF(CDBUNT,'RETRIEVE','LIBSRCH ','NBRONLN ',
     1               1,0,0,0,NMCLST,'GET',CDBST)
        IF(CDBST.NE.0) THEN
           CALL LBSRC2$(104,CDBST)
           GO TO 900
        ENDIF
C
        FIRST = .FALSE.
      ENDIF
C
C  COMPUTE THE PRINCIPAL COMPONENT SCORES FOR THE INPUT BRIGHTNESS
C  TEMPERATURES AND GET THE LIBRARY UNIT FOR THE APPROPRIATE PATH.
C
      IF (PATHID .EQ. 1) THEN
         LIBUNT = CLRUNT
      ELSEIF (PATHID .EQ. 2) THEN
C
CCFT FOR WR #153 - CHANGED THE  REQUIREMENT FOR NCEP
C    FORECAST DATA FROM THE LIBRARY SEARCH CRITERIA UNLESS
C    HIRS CHANNEL 8 IS SPECIFIED IN THE CHANNEL COMBINATION
C    FOR THE GUESS AND RETRIEVAL.
C
         IF (USEFCS) THEN
            IF (.NOT. ISR4SPV(FCSTMP)) THEN
               BRTTMP(8) = FCSTMP
            ELSE
               ERSTAT = 10
               LBRETSPT = LBRETSPT + 1
               LBRETSPT0(FRAMNO) = LBRETSPT0(FRAMNO) + 1
               RETURN
            ENDIF
         ENDIF
         LIBUNT = CLDUNT
      ELSE
         CALL LBSRC2$(103,STATUS)
         ERSTAT = 10
         LBRETPTH = LBRETPTH + 1
         LBRETPTH0(FRAMNO) = LBRETPTH0(FRAMNO) + 1
         RETURN
      ENDIF
C
C  SEARCH THE APPROPRIATE LIBRARY TO OBTAIN THE FIRST GUESS DATA.
C
      IF(TERTYP.EQ.0) THEN
         CALL SRCHFG(PATHID,LIBUNT,TABLE(1,1,PATHID),NUMOBS(PATHID),
     1               LIBLIM,NMCLST,BRTTMP,RLAT,TERTYP,VGUESS,
     2               PGUESS,SIMRAD,CLOPHO,USEFCS,STATUS)
      ELSEIF(TERTYP.EQ.1) THEN
         CALL SRCHF2(PATHID,LIBUNT,TABLE(1,1,PATHID),NUMOBS(PATHID),
     1               LIBLIM,NMCLST,BRTTMP,RLAT,TERTYP,VGUESS,
     2               PGUESS,SIMRAD,CLOPHO,USEFCS,STATUS)
      ENDIF
C
      ERSTAT = STATUS
      IF(ERSTAT.EQ.10) THEN
         LBRETNO = LBRETNO + 1
         LBRETNO0(FRAMNO) = LBRETNO0(FRAMNO) + 1
      ENDIF 
      RETURN
C
  900 ERSTAT = 99
      RETURN
      END
C**********************************************************************
      SUBROUTINE LBSRC2$(MSGCOD,STAT)
C
C**********************************************************************
C
C   NAME- LBSRC2$
C
C   LANGUAGE- VS FORTRAN    TYPE- SUBROUTINE    COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 02/29/94   PROGRAMMER- CARLA NEIGH (SMSRC)
C   VERSION- 3.0    DATE- 06/03/96   PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 08/04/97   PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING SUBROUTINE FOR THE
C             SUBROUTINE LBSRCH.  
C
C   VERSION 3.0- DOCUMENTATION AND SYNTAX CHANGES FOR ATOVS BASELINE
C                ON THE CRAY.
C   VERSION 3.1- CONVERSION FROM MMLF TO KIDS CONVENTION.
C
C   FILES-
C     DSN OR DESCRIPTIVE TITLE I/O   UNIT  FUNCTIONAL DESCRIPTION
C     ------------------------ ---   ----  ----------------------
C     .../KIDS                  O    KUNIT KRAY I/A DOCUMENTATION SYSTEM.
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE          TYPE I/O  FUNCTION
C     --------          ---- ---  --------
C     MSGCOD             INT  I   MESSAGE CODE OF ERROR DETECTED.
C     STAT               INT  O   NORMALLY SET TO 0 BUT IF AN ERROR
C                                 OCCURS AN ERROR STATUS CODE IS SET.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
      INCLUDE 'SPGUNT'
C
C   LOCAL PARAMETERS-
C     VARIABLE          TYPE  FUNCTION
C     --------          ----  --------
C     COUNT             INT   COUNT OF TIMES THIS ROUTINE HAS BEEN
C                             CALLED.
C     C4TEMP           CH*4   TEMPORARY FOR WRITING INTO KMSG.
C     C6TEMP           CH*6   TEMPORARY FOR WRITING INTO KMSG.
C     KMSG            CH*100  KIDS MESSAGE BUFFER.
C
C   SUBPROGRAMS CALLED-  KIDS
C
C   EXIT STATES-
C       STAT =  0; INDICATING NO OR A NON-FATAL ERROR WAS DETECTED
C       STAT = 99; INDICATING A FATAL ERROR WAS DETECTED
C
C***********************************************************************
C
      INTEGER    STAT, MSGCOD
      CHARACTER*4 C4TEMP
      CHARACTER*6 C6TEMP
      CHARACTER*100 KMSG
C
      INTEGER COUNT
      DATA COUNT /0/
      SAVE COUNT
C
C   SET THE MAIN MODULE NAME, SINCE KIDS SETS THE SUBROUTINE NAME.
C
      SUBNAM = 'SPGDVR'
      COUNT = COUNT + 1
      IF (COUNT .GT. 1) RETURN
C
      IF (MSGCOD.EQ.101) THEN
        KMSG(1:50)='* FATAL ERROR * #CLEAR EIGENVALUES FOR LIBRARY SEA'
        KMSG(51:100)='RCH DISTANCE COMPUTATION CANNOT BE DETERMINED. '
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
        STAT=99
C
      ELSEIF (MSGCOD.EQ.102) THEN
        KMSG(1:50)='* FATAL ERROR * #CLOUDY EIGENVALUES FOR LIBRARY SE'
        KMSG(51:100)='ARCH DISTANCE COMPUTATION CANNOT BE DETERMINED. '
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
        STAT=99
C
      ELSEIF (MSGCOD.EQ.103) THEN
        KMSG(1:50)='* WARNING * PATHID INDICATES LIBRARY SEARCH FOR NO'
        KMSG(51:100)='-HIRS.  NO-HIRS LIBRARY DOES NOT EXIST.'
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
        STAT=99
C  
      ELSEIF (MSGCOD.EQ.104) THEN
        KMSG(1:50)='* WARNING * PROBLEM WITH RETRIEVE.LIBSRCH.NBRONLN'
        KMSG(51:100)=' - INTCOEF RETURNED CDBST =       '
        WRITE(C6TEMP,'(I6)') STAT
        KMSG(79:84) = C6TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
        STAT=99
      ELSE
C  
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = ' INVALID ERROR MESSAGE CODE = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
