      SUBROUTINE SRCHF2(PATH,LIBUNT,PCSTBL,NUMOBS,TBLSIZ,NMCLST,
     1                  BRTTMP,RLAT,TERTYP,VGUESS,RGUESS,SIMRAD,CLOPHO,
     2                  USEFCS,ERSTAT)
      IMPLICIT NONE
C***********************************************************************
C
C   NAME- SRCHF2
C
C   LANGUAGE- VS FORTRAN  TYPE- SUBROUTINE      COMPUTER- CRAY J916
C
C   VERSION- 1.0    DATE- 06/11/93    PROGRAMMER- CARLA A. NEIGH, SMSRC
C   VERSION- 2.0    DATE- 09/30/95    PROGRAMMER- HAL J. BLOOM,HSTX
C   VERSION- 2.1    DATE- 05/10/96    PROGRAMMER- M.P. FERGUSON, HSTX
C   VERSION- 3.0    DATE- 01/17/97    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.1    DATE- 05/02/97    PROGRAMMER- TIM GARDNER (HSTX)
C   VERSION- 3.2    DATE- 09/05/97    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.3    DATE- 11/19/97    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.4    DATE- 03/06/98    PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.5    DATE- 04/13/99    PROGRAMMER- M.P.FERGUSON (HSTX)
C   VERSION- 3.6    DATE- 05/03/01    PROGRAMMER- FRANK TILLEY (RAYTHEON)
C   VERSION- 3.7    DATE- 06/05/02    PROGRAMMER- RICH KELLEY (CSC) 
C   VERSION- 3.8    DATE- 03/26/07    PROGRAMMER- FRANK TILLEY (IMSG)
C
C
C   FUNCTION-  THIS SUBROUTINE SEARCHES THE FIRST GUESS LIBRARY TO
C              OBTAIN THE FIRST GUESS TEMPERATURE/MIXING RATIO
C              VECTOR AND THE FIRST GUESS RADIANCE VECTOR.
C
C   VERSION -2.0 THE SUBROUTINE WAS REWRITTEN USING A NEW CALCULATION OF
C             PCS, NEW DISTANCE AND CLOSENESS SOFTWARE.  MODIFICATIONS
C             WERE MADE TO UTILIZE 6 PCS,INCLUDE SFC PRESSURE IN THE
C             TABLE BUILD AND USE IT TO RESTRICT THE SEARCH FROM DATA
C             BELOW 850 MB.
C   VERSION -2.1 SUBROUTINE MODIFIED TO READ EIGENVALUE INFORMATION
C             FROM CDB.
C
C   VERSION 3.0- EIGENVECTOR INFORMATION IS READ FROM THE CDB AND
C                SIMULATED RADIANCE VALUES ARE LOCATED ON THE GUESS
C                RECORD.
C
C   VERSION 3.1- SEARCH MODIFICATIONS WERE MADE OVER THE ANTARCTIC WHICH
C                ARE ASSOCIATED WITH THE UPPER LEVEL RETRIEVAL UPGRADE.
C
C   VERSION 3.2- READ FIRST GUESS INFORMATION FROM FGLIB BUFFERS INSTEAD
C                OF DIRECTLY FROM LIBRARY FILES.  STORE CLOSENESS MEASURE.
C
C   VERSION 3.3- RTOVS UPGRADE TO EXECUTE SUING SPLIT LAND/SEA EIGENVECTORS.
C                ALSO, ADD PCSLIM TO SUBROUTINE CALL.  CHANGE LOGIC ABOUT
C                FIRST CALLS TO CLSPTH TO USE FIRST CALL BASED ON TERTYP.
C
C   VERSION 3.4- REMOVE USAGE OF CHARACTER RECBUF WHEN ACCESSING FIRST GUESS
C                DATA.
C
C   VERSION 3.5- REMOVE INCLUSION OF SEA FIRST GUESSES SOUTH OF -60 S FOR USE A
C                AS FIRST GUESS FOR ANTARCTIC RETRIEVALS.
C
C   VERSION 3.6- WR #153 - REMOVED UNUSED CALLING ARGUMENT 'PCSLIM' AND
C                ADDED ARGUMENT 'USEFCS', WHICH CONTROLS THE REPLACEMENT
C                OF HIRS CHANNEL 8 WITH THE FORECAST SURFACE POTENTIAL
C                TEMPERATURE. ADDED 'IMPLICIT NONE' AND INCLUDED 'SPVAL'.
C   VERSION 3.7- ABSORBED VALUES OF TWO CONSTANTS, CNVFC1 AND CNVFC2 
C                INTO INCLUDE MEMBER PLPHSCON.  THIS WAS DONE IN RESPONSE TO
C                FPDT PR47, DATED 8/13/2001.
C   VERSION 3.8- ADDED A THIRD DIMENSION TO 'PCSTBL' TO MATCH ITS DECLARATION
C                IN THE CALLING ROUTINE.
C
C
C   CALLING SEQUENCE PARAMETERS-
C   NAME    TYPE   I/O   DESCRIPTION
C   ----    ----   ---   -----------
C   PATH      INT   I    RETRIEVAL PATH IDENTIFICATION NUMBER
C                        1 = CLEAR/CLOUD-CLEARED, 2 = CLOUDY,
C                        3 = NOHIRS.
C   LIBUNT    INT   I    UNIT NUMBER FOR THE FIRST GUESS LIBRARY.
C   PCSTBL    REAL  I    ARRAY (DIM 7+NUMCHN X TBLSIZ,2)
C                        CONTAINING THE PRINCIPAL COMPONENT SCORES,
C                        BRIGHTNESS TEMPERATURES, FORECAST SURFACE
C                        POTENTIAL TEMPERATURE, LATITUDE AND TERRAIN
C                        TYPE FROM THE FIRST GUESS LIBRARY.
C   NUMOBS    INT   I    NUMBER OF OBSERVATIONS IN PCSTBL.
C   TBLSIZ    INT   I    LENGTH OF THE PCSTBL.
C   NMCLST    INT   I    NUMBER OF CLOSEST GUESS LIBRARY VECTORS TO
C                        AVERAGE TO CREATE THE FINAL FIRST GUESS.
C   BRTTMP    REAL  I    ARRAY (DIM RETPARM:NUMCHN) CONTAINING THE
C                        BRIGHTNESS TEMPERATURES (K) FOR THE RETRIEVAL
C                        DATA POINT.
C   NUMEIG    INT   I    NUMBER OF EIGENVECTORS TO USE IN DISTANCE
C                        COMPUTATION.
C   RLAT      REAL  I    LATITUDE OF RETRIEVAL DATA POINT.
C   TERTYP    INT   I    TERRAIN TYPE OF RETRIEVAL DATA POINT (0 = SEA,
C                        1 = LAND).
C   VGUESS    REAL  O    ARRAY (DIM RETPARM:NUMLVL) CONTAINING THE
C                        FIRST GUESS FOR TEMPERATURE AND WATER
C                        VAPOR MIXING RATIO.
C   RGUESS    REAL  O    ARRAY (DIM RETPARM:NUMCHN+NANCIL) CONTAINING
C                        THE FIRST GUESS RADIANCES.
C   SIMRAD    REAL  O    ARRAY (DIM RETPARM:NUMCHN) CONTAINING THE
C                        FIRST GUESS RADIANCES FROM SIMULATED DATA.
C   CLOPHO    REAL  O    SMALLEST CLOSENESS MEASURE.
C   USEFCS    LOG   I    FLAG SET TO .TRUE. IF HIRS CHANNEL 8 IS TO BE
C                        REPLACED WITH THE FORECAST SURFACE POTENTIAL
C                        TEMPERATURE.
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   BIT      INT   NUMBER OF BIT TO BE CHECKED.
C   CHNAVG   REAL  ARRAY (DIM NUMCHN) CONTAINING CHANNEL AVERAGES.
C   DIST     REAL  DISTANCE BETWEEN PRINCIPAL COMPONENT SCORES FOR
C                  THE RETRIEVAL DATA POINT AND A LIBRARY RECORD.
C   DF       REAL  ARRAY (DIM 18) CONTAINING DIFFERENCE BETWEEN
C                  GUESS AND OBSERVED VECTORS.
C   EIGVAL   REAL  ARRAY (DIM NUMCHN) CONTAINING EIGENVALUES.
C   EIGVCT   REAL  ARRAY (DIM NUMCHN X NUMCHN) CONTAINING EIGENVECTORS.
C   ELEM     INT   DO LOOP COUNTER FOR ARRAY ELEMENTS.
C   FLAG     INT   HOLDS ONE EIGENVECTOR FLAG WORD.
C   LFIRST   LOG   INDICATES IF THIS IS THE FIRST EXECUTION 
C   LIBLAT   REAL  LATITUDE FOR THE FIRST GUESS LIBRARY MEMBER.
C   LIBTER   INT   TERRAIN TYPE FOR THE FIRST GUESS LIBRARY MEMBER
C                  (0 = SEA, 1 = LAND).
C   MAXREA   REAL  LARGEST REAL*4 NUMBER THAT CAN BE REPRESENTED.
C   MINDST   REAL  ARRAY (DIM MAXVEC) CONTAINING MINIMUM DISTANCE.
C   MINREC   INT   RECORD NUMBER FOR MINIMUM DISTANCE.
C   NCHAN    INT   ARRAY (DIM NUMCHN X 3) CONTAINING THE CHANNEL
C                  COMBINATION ARRAY FOR THE FIRST GUESS.
C   NEIG     INT   ARRAY (DIM 3) CONTAINING THE NUMBER OF EIGENVECTORS
C                  TO USE FOR EACH PATH.
C   NMLIBR   INT   THE NUMBER OF FIRST GUESS LIBRARY ELEMENTS.
C   OBS      INT   DO LOOP COUNTER FOR OBSERVATIONS.
C   PCS      REAL  PRINCIPAL COMPONENT SCORES FOR THE OBSERVED DATA.
C   SUMDF    REAL  SUM OF THE VECTOR DIFFERENCES.
C   XEIGVL   REAL  ARRAY (DIM NUMCHN X 3) CONTAINING EIGENVALUES
C                  FOR EACH PATH.
C   XEIGVCT  REAL  ARRAY (DIM NUMCHN X NUMCHN X 3) CONTAINING
C                  EIGENVECTORS FOR EACH PATH.
C
C   SUBPROGRAMS CALLED- SRCHF$
C
C   FUNCTIONS USED- DISTSQ, ABS, NINT
C
C   EXIT STATES-
C      ERSTAT = 10 : A FIRST GUESS COULD NOT BE DETERMINED.
C      ERSTAT = 99 : I/O ERROR OCCURRED READING THE FIRST GUESS
C                    LIBRARY.
C
C***********************************************************************
C
      INCLUDE 'RETPARM'
      INCLUDE 'CLASIF'
      INCLUDE 'FGLBUF'
      INCLUDE 'SPVAL'
      INCLUDE 'PLPHSCON'
ccft
      INCLUDE 'RTPLVL'

C
      INTEGER PATH, LIBUNT, NUMOBS, TBLSIZ,  TERTYP, ERSTAT, NUMEIG
      REAL BRTTMP(NUMCHN),PCSTBL(21+NUMCHN,TBLSIZ,2)
      REAL VGUESS(NUMLVL), RGUESS(NUMCHN+NANCIL), SIMRAD(NUMCHN), RLAT
      REAL EIGVCT(NUMCHN,NUMCHN),EIGVAL(NUMCHN),CHNAVG(NUMCHN)
      LOGICAL USEFCS, badval

      real tempval, mr2tdew, tdew

C
      INTEGER NEIG(3), MAXVEC, NMCLST, JJ, II, ICH2, ICH, NMIN, I, K
      INTEGER EIGFLG(2), AVGFLG(2), CLSTBL(16,4,2,2), CHAN
      INTEGER NUMINT(4), ITEST, JX, IX
      INTEGER BIT,FLAG
C
      PARAMETER (MAXVEC = 20)
C
      INTEGER ELEM, OBS, LIBTER, NCH(3), NCHAN(NUMCHN,3)
      INTEGER MINREC(MAXVEC), IDUM
      REAL MAXREA, DISTSQ, LIBLAT, RDUM
      REAL UPR1, LWR1, UPR2, LWR2, UPR3, LWR3, TR(2), PHO
      REAL PCS(18), MINDST(MAXVEC), CLSBND(16,4)
      REAL SUMM,DF(18),SUMDF,DIST, CLOPHO
      REAL RMEAN(NUMCHN,3),XEIGVCT(NUMCHN,NUMCHN,3),XEIGVL(NUMCHN,3)
      LOGICAL LFIRST
C
      DATA LFIRST/.TRUE./
      DATA MAXREA/3.402823E+38/
C
      SAVE XEIGVCT,XEIGVL,NCH,RMEAN,LFIRST,NEIG,NCHAN
C
C
      ERSTAT = 0
C
C    SET CLEAR/CLOUDY FGLLIB INDEX
C
      IDUM = LIBUNT - 29
C
C   IF THIS IS THE FIRST CALL TO SRCHFG FOR THIS TERTYPE, 
C   READ EIGENVECTOR AND CHANNEL AVERAGE VALUES FOR THIS PATH AND 
C   FILL ARRAYS ACCORDING TO WHICH CHANNELS ARE USED AS DEFINED 
C   BY THE EIGENVECTOR CHANNEL FLAGS.

      JJ=TERTYP + 1
      IF(LFIRST) THEN
        LFIRST = .FALSE.
        DO 5 II = 1,2
          CALL CLSPTH(II,JJ,EIGVCT,EIGVAL,CLSBND,NUMINT,CLSTBL,
     +                CHNAVG,AVGFLG,EIGFLG,NUMEIG)
          NEIG(II) = NUMEIG
          DO 4 CHAN = 1,NUMCHN
            IF ( CHAN .LE. 20) THEN
              FLAG = EIGFLG(1)
              BIT = 32 - CHAN
            ELSE
              FLAG = EIGFLG(2)
              BIT = 32 - CHAN + 20
            ENDIF
            IF (BTEST(FLAG,BIT)) THEN
              NCH(II) = NCH(II) + 1
              NCHAN(NCH(II),II) = CHAN
              RMEAN(NCH(II),II) = CHNAVG(CHAN)
              XEIGVL(NCH(II),II)=EIGVAL(CHAN)
            ENDIF
 4        CONTINUE
C
C   FILL APPROPRIATE EIGENVECTOR ARRAY LOCATIONS ACCORDING TO THE
C   CHANNELS THAT WILL BE USED.
C
          DO 12 ICH2 = 1,NCH(II)
            DO 11 ICH  = 1,NCH(II)
              XEIGVCT(ICH2,ICH,II)=EIGVCT(NCHAN(ICH2,II),ICH)
   11       CONTINUE
   12     CONTINUE
    5   CONTINUE
      ENDIF
   15 NMIN=0
C
C  INITIALIZE MINIMUM DISTANCE AND RECORD NUMBER ARRAYS AS WELL AS
C  THE TEMPERATURE, WATER VAPOR, AND RADIANCE GUESS VECTORS.
C
      DO 10 ELEM = 1, NMCLST
        MINDST(ELEM) = MAXREA
        MINREC(ELEM) = -99
   10  CONTINUE
C
      DO 20 ELEM = 1,NUMLVL
        VGUESS(ELEM) = 0.0
   20 CONTINUE
C
      DO 30 ELEM = 1,NUMCHN
        RGUESS(ELEM) = 0.0
        SIMRAD(ELEM) = 0.0
   30 CONTINUE
C
      ITEST = 0
C
      DO 46 JX=1,NEIG(PATH)
        SUMM=0.
        DO 45 IX=1,NCH(PATH)
          SUMM=SUMM+XEIGVCT(IX,JX,PATH)*
     1    (BRTTMP(NCHAN(IX,PATH))-RMEAN(IX,PATH))
 45     CONTINUE
C
        PCS(JX)=SUMM
 46   CONTINUE
C
      DO 100 OBS = 1, NUMOBS
C
C CHECK TERRRAIN TYPE.  IF THE RETRIEVAL IS ANTARCTIC INCLUDE SAMPLE
C FROM THE OCEAN FOR THE SEARCH.
C
        LIBLAT = PCSTBL(NUMCHN+6,OBS,IDUM)
        LIBTER = NINT(PCSTBL(NUMCHN+7,OBS,IDUM))
CCFT    SFCP = (PCSTBL(NUMCHN+10,OBS))
ccmpf   IF ((TERTYP .EQ. 1) .AND. (RLAT .LT. -60.0)) THEN
ccmpf      IF ((LIBTER .EQ. 0) .AND. (LIBLAT .GE. -60.0)) GOTO 100
ccmpf   ELSE IF (LIBTER .NE. TERTYP) THEN
        IF (LIBTER .NE. TERTYP) THEN
           GOTO 100
        ENDIF
C
        IF (PATH .EQ. 1) THEN
           SUMM=0.
           SUMDF=0.
           DO  7 II=1,NEIG(PATH)
C
C MAKE USE OF THE 2 PCS SAVED AT THE END OF THE FG LIBRARY, AND THE OTHER 10
C STORED IN PLACE OF THE HIRS 4-13 SIMULATED RADIANCES.
C
             IF (II.GE.5.AND.II.LT.7) THEN
               DF(II)=PCS(II)-PCSTBL(NUMCHN+3+II,OBS,IDUM)
             ELSE IF(II.GE.7.AND.II.LT.17) THEN
               DF(II)=PCS(II)-PCSTBL(NUMCHN+5+II,OBS,IDUM)
             ELSE
               DF(II) = PCS(II) - PCSTBL(II,OBS,IDUM)
             ENDIF
             SUMDF=SUMDF+DF(II)*(1.0/XEIGVL(II,PATH))*DF(II)
7          CONTINUE
           IF(SUMDF.EQ.0) SUMDF=10000.
           PHO = SQRT(SUMDF)
           DIST = PHO
        ELSEIF (PATH .EQ. 2) THEN
C
C           REPLACE HIRS 8 WITH THE FORECAST SURFACE POTENTIAL
C           TEMPERATURE IF PATH IS CLOUDY AND THE 'USEFCS' FLAG
C           IS SET. (WR #153)
C
           IF (USEFCS) THEN
              PCSTBL(12,OBS,IDUM) = PCSTBL(NUMCHN+5,OBS,IDUM)
           END IF
C
C        CALCULATE DIFFERENCE BETWEEN PCS CALCULATED FROM OBS.
C        RADIANCE VECTOR AND THE GUESS LIBRARY VECTOR.
C
           SUMM=0.
           SUMDF=0.
           DO  8 II=1,NEIG(PATH)
             IF (II.GT.4.AND.II.LT.17) THEN
               DF(II)=PCS(II)-PCSTBL(NUMCHN+3+II,OBS,IDUM)
             ELSE
               DF(II)=PCS(II)-PCSTBL(II,OBS,IDUM)
             ENDIF
             SUMDF=SUMDF+DF(II)*(1.0/XEIGVL(II,PATH))*DF(II)
8          CONTINUE
           IF(SUMDF.EQ.0) SUMDF=10000.
           PHO = SQRT(SUMDF)
           DIST = PHO
        ELSE
C
C       FOR PATH THREE USE DISTSQ...PATH THREE IS NOT BEING USED
C       AT THIS TIME (1/97)
C
           DIST = 1000.
        ENDIF
C
        ITEST = ITEST + 1
C
C       CHECK IF THIS IS ONE OF THE "NMCLST" CLOSEST VECTORS
C
        IF (DIST .LT. MINDST(NMCLST)) THEN
          DO 80 I = 1,NMCLST
            IF (DIST .LT. MINDST(I)) THEN
              IF (I .LT. NMCLST) THEN
                DO 60 K = NMCLST-1,I,-1
                  MINDST(K+1) = MINDST(K)
                  MINREC(K+1) = MINREC(K)
  60            CONTINUE
              END IF
              MINDST(I) = DIST
              CLOPHO = MINDST(I)
              MINREC(I) = OBS + 1
              GOTO 100
            END IF
  80      CONTINUE
        ENDIF
C
  100 CONTINUE
      IF (MINREC(NMCLST) .NE. -99) THEN
C
C     READ THE 'NMCLST' RECORDS WHICH ARE CLOSEST TO THE OBSERVED
C     DATA, EXTRACT THE FIRST GUESS VECTORS AND AVERAGE THEM TO
C     GENERATE THE FINAL FIRST GUESS.
C
        DO 150 I = 1,NMCLST
C
          DO 120 ELEM = 1, NUMLVL
            VGUESS(ELEM) = VGUESS(ELEM) + (FGLLIB(IDUM,MINREC(I),ELEM+4)
     1                                     /FLOAT(NMCLST))
    
  120     CONTINUE


C
C     COMPUTE RADIANCE FIRST GUESS VECTOR.
C     FOR CLOUDY PATH, PLACE THE FORECAST SURFACE POTENTIAL TEMPERATURE
C     IN PLACE OF HIRS CHANNEL 8 IF THE FORECAST SURFACE POTENTIAL
C     TEMPERATURE IS TO BE USED.
C
          DO 130 ELEM = 1, NUMCHN
           IF ((PATH .EQ. 2) .AND. (ELEM .EQ. 8)) THEN
              IF(FGLLIB(IDUM,MINREC(I),NUMLVL+NUMCHN+5).GE.100.0 .AND.
     &           USEFCS) THEN
                 RDUM = CNVFC1 / (EXP(CNVFC2/
     &                  (FGLLIB(IDUM,MINREC(I),NUMLVL+NUMCHN+5)))
     &                  - 1.0)
                 RGUESS(ELEM) = RGUESS(ELEM) + RDUM / FLOAT(NMCLST)
              ELSE
                 RDUM = R4SPV
                 RGUESS(ELEM) = R4SPV
              ENDIF
            ELSE IF (ELEM .NE. 20) THEN
              RGUESS(ELEM)=RGUESS(ELEM)+
     &                     (FGLLIB(IDUM,MINREC(I),ELEM+4+NUMLVL)
     &                      /FLOAT(NMCLST))
              SIMRAD(ELEM) = SIMRAD(ELEM) +
     &                  (FGLLIB(IDUM,MINREC(I),NUMLVL+NUMCHN+10+ELEM)
     &                  / FLOAT(NMCLST))
            ENDIF
  130     CONTINUE
  150   CONTINUE

        IF (RLAT.ne.(-99.0)) THEN
           badval = .false.
           TEMPVAL = CNVFC2/ALOG((CNVFC1/VGUESS(98))+1.0)
           TDEW = MR2TDEW(PRETLV(98),VGUESS(98+51)) + 273.16
           IF ((TDEW - TEMPVAL) .GT. 5.0) badval = .true.
           if (badval) then
            do I = 1, NMCLST
               print *,' '
               Print *,' Guess ',I,' Guess Lat/Lon ',FGLLIB(IDUM,MINREC(I),232),
     +                   FGLLIB(IDUM,MINREC(I),233)
               do ELEM = 62, 100
                  tempval = CNVFC2/ALOG((CNVFC1/(FGLLIB(IDUM,MINREC(I),ELEM+4)))+1.0) 
                  TDEW = MR2TDEW(PRETLV(ELEM),FGLLIB(IDUM,MINREC(I),ELEM+55)) + 273.16
                  print *,'Press ',(NINT(PRETLV(ELEM))),' Temp ',tempval,' mr ',
     +                     FGLLIB(IDUM,MINREC(I),ELEM+55)
               end do
            end do
            print *,' '
            print *,' Guess Mean at Rlat',RLAT
            do ELEM = 51, 100
               tempval = CNVFC2/ALOG((CNVFC1/VGUESS(ELEM))+1.0) 
               tdew = MR2TDEW(PRETLV(ELEM),VGUESS(ELEM+51))
               print *,'Press ',(NINT(PRETLV(ELEM))),' Temp ',tempval,' mr ',
     +                   VGUESS(ELEM+51),' Tdew ',(tdew + 273.16)
            end do
           STOP
          end if
       end if
         

C
      ELSE
C
C     NO FIRST GUESS WAS FOUND.
C
        ERSTAT = 10
      ENDIF
C
      RETURN
      END

