	PROGRAM FSRCH
C SEARCH THE CRYSTAL DATA/PDF DATA BASE FOR THE GIVEN CHEMICAL
C COMPOSITION AND RSPACES AND SAVE THE MATCHES BACK IN THE SEARCH
C FILE.  THIS PROGRAM GIVES THE SAME RESULTS AS THE CORRESPONDING
C MACRO ROUTINE SEARCH.
C
C**********************************************************************
C
C	ROUTINES USED
C		SEDATA  -  BLOCK DATA VALUES
C		SEDILG  -  CONDUCT DIALOG
C		  SEELEM - PROMPT FOR ELEMENTS AND SET BITS IN MAPS
C			   (SETS BITS FOR DETECTED, EXCLUDED AND REQUIRED)
C		    SEEMAP - SET THE BITS IN A MAP
C		    SEENUM - DETERMINE THE ELEMENT NUMBER
C		  SECODE - SET SPECIAL CODES FOR SEARCH (MINERAL,DELETED,
C		           HYDRATE,ORGANIC,SPACE .NE., AMMONIA, ALLOY)
C		  SESPAC - PROMPT FOR RSPACES AND SET UP BIT MAPS
C		    SERMAP - SET THE WORD AND BIT FOR THE GIVEN NUMBER
C		SEINDX  -  READ AND COMPARE ELEMENT INDEX WITH ELEMENTS
C		  SEBCNT - COUNT # OF BITS IN BUFFER
C		  SERSRC - SEARCH FOR RSPACE MATCHES
C	            SERHIT - DETERMINE RSPACE HITS AND COUNT THEM, IT ALSO
C		             COMPUTES THE FOM
C		    SESAVE - SAVE THE HIT INFO BACK IN FILE
C		  SEIBIT - FIND THE FIRST BIT IN THE MAP
C
	INCLUDE 'SEARCH.INC'
	DIMENSION ID(6),IE(6),IRS(40)
	DATA I0/0/,IM1/"177777/
	ISREC = IPFRST + 1		!FIRST SAVE RECORD
	CALL SEDILG			!GET SEARCH PARAMETERS
	OPEN (UNIT=ILUD,NAME='TN0700.EXT',TYPE='OLD',
     *		ACCESS='DIRECT',RECORDSIZE=128)
	CALL SEINDX (LFULL)		!SEARCH THE CHEM INDEX
C	IF SPECIFIED, SEARCH THE LIGHT ELEMENTS WITHOUT REQUIRING
C	ELEMENTS
	IF (.NOT. LFULL .AND. LNACM) CALL SELGHT (LFULL)
C WRITE HEADER BLOCK
	INACM = 0
	IF (LNACM) INACM = 1		!FLAG FOR SEARCHING LIGHT ELEMENTS
C STORE LAST BUFFER OF MATCHES
	IF (IPTR .GT. 1) THEN
	  WRITE (ILUD'ISREC) ((IMBUF(I,J),I=1,8),J=1,IPTR-1),
     *		((I0,I=1,8),J=IPTR,32)
	END IF
C CREATE REVERSE BIT MAPS FOR DETECTED AND EXCLUDED ELEMENTS
	DO 10 I=1,6
	  ID(I) = IELDET(I).XOR.IM1
	  IE(I) = IELEXC(I).XOR.IM1
10	  CONTINUE
C STORE COUNTERS AND SEARCH PARAMETERS FOR THE CHEM PROGRAM
	ICAM = CAMCON*1000
	DO 15 I=1,NSPACE
15	IRS(I) = RSPAC(I)*1000
	WRITE (ILUD'IPFRST) IPFOM,IMISS,NEHITS,
     *		ICAM,INRKNT,INPKNT,IFGKNT,IEMKNT,IFMKNT,
     *		IMATCH,NSPACE,IPCODE,INCODE,IELREQ,INACM,ID,IE,
     *		(I0,I=1,18),(IRS(I),I=1,NSPACE)
	CLOSE (UNIT=ILUD)
C PRINT THE COUTNERS
	WRITE (ILUO,20) INRKNT,INPKNT,IFGKNT,IEMKNT,IFMKNT,IMATCH
20	FORMAT (1X,I6,' INDEX RECORDS WERE EXAMINED'/
     *		1X,I6,' ENTRIES RESULTED IN A CLOSER STUDY'/
     *		1X,I6,' ELEMENT MAPS CHECKED'/
     *		1X,I6,' R-SPACE MAPS CHECKED'/
     *		1X,I6,' FOM CALCULATIONS'/
     *		1X,I6,' COMPOUNDS FOUND')
	STOP
	END
