C*************************************************************************
	Subroutine FIND(s_ln,sname,bitmap_ln,bitmap,lsname,ls_ln,
	1	STATUS)
C*************************************************************************
C  VERSION 4 -- 7/92 (B. H. Toby)
C  Uses bitmaps for search and match of peaks 
C*************************************************************************
	CHARACTER*(*) sname,bitmap,lsname
	INTEGER s_ln,bitmap_ln,ls_ln
	INTEGER*4 STATUS
C
	include '[-.shared]jcpds.parms'
	include 'SEARCH.cmn'
	include 'SEARCH.par'
C
	integer*4 ret_stat,timstor,code
	integer*4 lib$show_timer,lib$free_timer,lib$init_timer,tim_prt
	external  lib$show_timer,lib$free_timer,lib$init_timer,tim_prt
	LOGICAL flag,DTOTT,TTTOD,DTOPDF,PDFTOD,DTOIND,INDTOD
	LOGICAL PDFTOCU,CUTOPDF,PDFTOIND
	INTEGER*2 IN_CHAN,iosb(4)
	INTEGER*4 SYS$ASSIGN,SYS$QIOW
	LOGICAL*4 YOURANG
C this prevents variable YOURANG from being optimized out of loop
	VOLATILE YOURANG
	EXTERNAL CCAST
C
	INTEGER*4 NAMREC,FULREC,DIREC,ISEQ,JCARD
	integer prtincr
	integer*4 jcmiss,obmiss
C----------------------------------------------------------------------
C use VMS routine to initalize the timer -- later display processing time
	ret_stat = lib$init_timer(timstor)
	if (.not. ret_stat) call lib$signal(%val(ret_stat))
	WRITE(LO,'(a)') ' ',' *** MATCH Step started'
C----------------------------------------------------------------------
C if REDUCE has not been run first, read in the starting bitmap into TABLE1
C and then transfer to TABLE2
	IF (NSTEP .ne. 1) then
	  write (lo,'(A)') ' WARNING -- you are skipping the REDUCE step'
	  IF (PROMPT) then
	    write(lo,'(A)') '$Continue? ([Y]/N) '
	    read(li,'(a1)') ans
	    if (ans .eq. 'N' .or. ans .eq. 'n') goto 3
	    NSTEP = 0
	  ENDIF
	  CALL GETbit(Nset,BITMAP,bitmap_ln,*3)
	  CALL TBLMOVE(TABLE1,TABLE2,N_Lwords)
	  nph2 = nph1
	ENDIF

	if (nph2 .eq. 0) then
	  TYPE *,'There are no cards left to search'
	  goto 3
	ENDIF
	write (lo,'(/,a,i6,a,i6,a)') ' MATCH step will search',nph2,
	1	' of',N_cards,' cards'

C queue the control C AST to capture the first ^C. YOURANG will be set .TRUE.
C rather than print error messages, print message only if the QIO was OK
	YOURANG = .FALSE.
C ASSIGN A CHANNEL FOR INPUT
	IF (prompt) STATUS = SYS$ASSIGN('SYS$INPUT',IN_CHAN,,)
	IF (STATUS .and. prompt) THEN 
C	  CODE = IO$_SETMODE .OR. IO$M_CTrLCAST
	  CODE = 291
	  STATUS = SYS$QIOW(,%VAL(IN_CHAN),%VAL(CODE),IOSB,,,
	1	CCAST,YOURANG,,,,)
	  IF (.NOT. STATUS .or. IOSB(1)) WRITE(LO,'(a)') 
	1	' Press ^C (control C) *ONCE* to abort search'
	ENDIF

C Make a working copy of the excluded region bitmap table 
C  (2*31416+ 1)/32 = 1964 (= EX_words)
	DO N=1,EX_words
	  ctbl(N) = extbl(N)
	ENDDO

C sort the observed peaks
	CALL DSORT(ds,inten,numob)

C get the non-excluded peaks
	call usepeak
C allowed misses for obs lines 
	OBMSMX = nobs1 * (1. - MINMATCH/100.)

	if (nobs .eq. 0) then
	  TYPE *,'There are no observed lines that are not excluded'
	  goto 3
	ENDIF

C set the range of each peak in the working table
	DO I=1,nobs
	  CALL EXset(ctbl,OBL(I),OBH(I),1)
	enddo
C--------------------------------------------------------------------------
C increment to show completion of the match step
	IF (nph2/32 .gt. N_Lwords/2) then
	  prtincr = N_Lwords / 5. + 1
	ELSEIF (nph2/32 .gt. N_Lwords/4) then
	  prtincr = N_Lwords / 4. + 1
	ELSEIF (nph2/32 .gt. N_Lwords/10) then
	  prtincr = N_Lwords / 2. + 1
	ELSE
	  prtincr = N_Lwords + 1
	ENDIF
	icount = N_Lwords - prtincr
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C do match
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	DO 10 N=N_Lwords,1,-1
	  IF (TABLE2(N).EQ.0) GOTO 10
	  DO J=31,0,-1
	    IF (IBITS(TABLE2(N),J,1).EQ.1) THEN
C	convert bit# and word# to seq#
	      ISEQ = 32*(N-1) + J + 1
C 	get record numbers from seq#
	      READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC
C    check the entry against the observed peaks
	      CALL check(DIREC,jcmiss,obmiss,STATUS)
	      IF (STATUS) THEN
C If we are here, the card is a match
	        NPHASE = NPHASE + 1
	        CALL BITSET(TABLE,ISEQ,N_cards,1)
C 	get record numbers from seq#
	        READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC
	        WRITE(LO,9110) NPHASE,JCARD,jcmiss,obmiss
9110	        FORMAT(' HIT: #',i6,' [',I6.6,']    JCPDS Misses:',i2,
	1		' Obs Misses:',i3)
	      ENDIF
	    ENDIF
	  ENDDO
C have we exceeded the number of allowed phases? (check after each 32 bits)
	  IF (NPHASE .ge. MPHASE) then
	    WRITE(lo,'(a)') '**** MAXIMUM NUMBER OF PHASES EXCEEDED ****'
	    IF (PROMPT) then
	      WRITE(lo,'(a)') '$Continue MATCH step? (Default=N): '
	      READ(li,'(a)') iANS
	      IF (ians .eq. 'Y' .or. ians .eq. 'y') then 
		MPHASE = 2*MPHASE
		GOTO 10
	      ENDIF
	    ENDIF
	    IF (PROMPT .and. nphase .gt. 1) then
	      WRITE(lo,'(a,i5,a)') '$Accept the',NPHASE,
	1		' Hits? (Default=N): '
	      READ(li,'(a)') iANS
	      IF (ians .eq. 'Y' .or. ians .eq. 'y') goto 80
	    ENDIF
	    goto 3
	  ELSEIF (YOURANG) THEN
C search was interupted by a ^C
	    WRITE(lo,'(a)') ' *** MATCH ABORTED BY CONTROL C. '//
	1	' Statistics for this step:'
	    ret_stat = lib$show_timer(timstor,1,tim_prt)
	    ret_stat = lib$show_timer(timstor,2,tim_prt)
	    IF (PROMPT .and. nphase .gt. 1) then
	      WRITE(lo,'(a,i5,a)') '$Accept the',NPHASE,
	1		' Hits? (Default=N): '
	      READ(li,'(a)') iANS
	      IF (ians .eq. 'Y' .or. ians .eq. 'y') goto 80
	    ENDIF
	    goto 3
	  ELSEIF (N .lt. icount) then
	    write (lo,'(a,f5.0,a)') 
	1	' Match is ',100.*(N_Lwords-N)/N_Lwords,'% complete'
	    ret_stat = lib$show_timer(timstor,2,tim_prt)
	    icount = icount - prtincr
	  ENDIF
10	CONTINUE
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C---END MATCH STEP
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
80	CALL TBLCOUNT(TABLE,N_Lwords,nphase)
	WRITE(lo,9900) NPHASE
9900	FORMAT(/,1x,40('*'),/,' POSITIVE MATCH FOR',1X,I4,1X,'PHASE(S)',
	1	/,1x,40('*'),/) 
	IF (NPHASE .eq. 0) then 
	  write (lo,'(A)') ' No matches found, output file not written.'
	else 
	  CALL WRBIT(table,SNAME,S_LN,bitmap,bitmap_ln,dname,d_ln,
	1	lsname,ls_ln,*3)
	ENDIF
C------------------------------------------------------------------------
C use VMS routine to display processing time
	WRITE(LO,'(a)') ' *** MATCH step ended, Statistics for this step:'
	ret_stat = lib$show_timer(timstor,1,tim_prt)
	ret_stat = lib$show_timer(timstor,2,tim_prt)
C release timer storage
	ret_stat = lib$free_timer(timstor)
C------------------------------------------------------------------------
	STATUS = .true.
	RETURN
C------------------------------------------------------------------------
3	STATUS = .false.
	RETURN 
	END 
C!****************************************************************************
C** Subroutine to display time information regurgitated by VMS timing code.
C*****************************************************************************
	integer*4 function tim_prt(string,dummy)
	character*(*) string
	write (*,'(3x,a)') string(:lench(string))
	tim_prt = 1
	return
	end
C!****************************************************************************
C** AST Subroutine to capture ^C interupts 
C*****************************************************************************
	SUBROUTINE CCAST(YOURANG)
	LOGICAL*4 YOURANG
	YOURANG = .TRUE.
	WRITE(*,*) ' Stopping, please hold on...'
	RETURN
	END
