
C
C     FSEARCH SCANS A DIRECTORY FILE BASED ON A SPECIFIED SEARCH STRING 
C     (CONTAINING WILD CARD CHARACTERS, IF DESIRED) AND RETURNS SUCCESSIVE FILE
C     SPECIFICATIONS MATCHING THE SPECIFICATIONS.  WHEN THERE ARE NO MORE
C     FILE MATCHING THE SPECIFICATIONS, THE FILE SPECIFICATION STRING IN BLANK.
C
C     CALLS THE RMS SYSTEM SERVICES SYS$PARSE AND SYS$SEARCH WHICH REQUIRES
C     SETTING UP FAB AND NAM BLOCKS.
C
C     CALLING ARGUMENTS:
C     IFIRST   I*2   INPUT   =1 ON FIRST CALL TO FSEARCH, TO SET UP FOR
C                            SUBSEQUENT SEARCHES
C                            =0 ON SUBSEQUENT CALLS
C     CSEARCH  A     INPUT   FILE SPECIFICATION TO SEARCH FOR
C     CFOUND   A     OUTPUT  FILE SPECIFICATION OF FILE THAT WAS FOUND
C
C     KIM TOLBERT         3/1/86
C
C***************************************************************************
C
      SUBROUTINE FSEARCH(IFIRST, CSEARCH, CFOUND)
C
      INTEGER*2 IFIRST
C
      INCLUDE '($FABDEF)'
      INCLUDE '($NAMDEF)'
      INCLUDE '($RMSDEF)/LIST'
C
      INTEGER*4 SYS$PARSE, SYS$SEARCH, STATUS
C
      RECORD /FABDEF/ FAB
      RECORD /NAMDEF/ NAM
C
      CHARACTER CSEARCH*(*), CFOUND*(*)
      CHARACTER CLOOK*100, CEXFOUND*100
C
      IF (IFIRST .NE. 1) GO TO 100
C
      FAB.FAB$B_BID = FAB$C_BID        ! BLOCK IDENTIFIER FOR FAB BLOCK 
      FAB.FAB$B_BLN = FAB$C_BLN        ! LENGTH OF FAB  BLOCK
      NAM.NAM$B_BID = NAM$C_BID        ! BLOCK IDENTIFIER FOR NAM BLOCK 
      NAM.NAM$B_BLN = NAM$C_BLN        ! LENGTH OF NAM BLOCK 
C
      FAB.FAB$L_NAM = %LOC(NAM)
      FAB.FAB$L_FOP = IBSET(FAB.FAB$L_FOP, FAB$V_NAM)
C
      FAB.FAB$L_FNA = %LOC(CSEARCH)    ! ADDRESS OF FILE SPEC. TO BE PROCESSED 
      FAB.FAB$B_FNS = LEN(CSEARCH)     ! LENGTH OF FILE SPEC. TO BE PROCESSED 
C
      NAM.NAM$L_RSA = %LOC(CLOOK)      ! RESULTANT STRING ADDRESS IN NAM BLOCK 
      NAM.NAM$B_RSS = LEN(CLOOK)       ! RESULTANT STRING SIZE IN NAM BLOCK 
      NAM.NAM$L_ESA = %LOC(CEXFOUND)   ! EXPANDED STRING AREA ADDRESS 
      NAM.NAM$B_ESS = LEN(CEXFOUND)    ! EXPANDED STRING LENGTH 
C
      STATUS = SYS$PARSE(FAB)          ! ANALYZE FILE SPEC. AND FILL IN NAM
      IF (.NOT. STATUS) CALL LIB$SIGNAL(STATUS)
C
100   CONTINUE
      STATUS = SYS$SEARCH(FAB)         ! SEARCH FOR NEXT FILE MEETING SPECS. 
C
      IF (STATUS .EQ. RMS$_NMF) THEN   ! CHECK FOR NO MORE FILES STATUS
         CFOUND = ' '
         GO TO 900
      END IF
C
      IF (STATUS) THEN
         CFOUND=CLOOK(1:NAM.NAM$B_RSL) ! TRANSFER ONLY THOSE CHARACTERS FILLED 
      ELSE
         CFOUND = ' '
      END IF
C
900   CONTINUE
      RETURN
      END
