C*************************************************************************
	SUBROUTINE GET_NAME(*,trace,tracelen)
C*************************************************************************
C Subroutine to search through PDF1 to match a name
C     suspends search following a control-C
C*************************************************************************
	include 'logic.common'
	INTEGER*2 tracelen
	CHARACTER*(*) trace
	CHARACTER*40 name,CNAME*200
	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	CHARACTER*1 QM
	INTEGER*4 CARDNO
	LOGICAL CLI$GET_VALUE
	BYTE CHFORM(200),CHNAME(205)
	INTEGER*2 LCHFORM,LCHNAME
C control-C trap
	INTEGER*2 IN_CHAN,iosb(4)
	INTEGER*4 STATUS,SYS$ASSIGN,SYS$QIOW,code
	LOGICAL*4 YOURANG
C this prevents variable YOURANG from being optimized out of loop
	VOLATILE YOURANG
	EXTERNAL CCAST


	trace = '/NAME="'
	tracelen = 7

	CALL TBLMOVE(TABLE,TABLE1,N_Lwords)
	IF (nphase .gt. 10000 .and. prompt) then
	  WRITE(lo,'(a,i6,a)') ' Searching through',nphase,
	1	' entries is going to take QUITE a while',
	2	'$Do you really want to do this? (default=N): '
	  READ(li,'(A)',end=3) QM
	  IF (QM .ne. 'Y' .and. QM .ne. 'y') goto 3
 	ELSEIF (nphase .gt. 1000 .and. prompt) then
	  WRITE(lo,'(a,i6,a)') ' Searching through',nphase,
	1	' entries is going to take a while',
	2	'$Do you really want to do this? (default=Y): '
	  READ(li,'(A)',end=3) QM
	  IF (QM .eq. 'N' .or. QM .eq. 'n') goto 3
	ENDIF
	len = 0
	IF (.not. CLI$GET_VALUE('NAME',name,len)) THEN 
100	  IF (.not. PROMPT) THEN 
	    write (lo,'(a)') ' Unable to prompt for NAME string'
	    return 1
	  ENDIF
	  write (lo,'(a)') '$Enter name: '
	  Read (li,'(q,a)') len,name
	ENDIF
	IF (len .eq. 0) goto 100
C convert string to upper case
	CALL STR$UPCASE(name(1:len),name(1:len))

!	OPEN (UNIT=LUNn,NAME='PS_JCPDS:NAME.DIRECT',STATUS='old',
!	1	READONLY,SHARED,FORM='UNFORMATTED',ACCESS='DIRECT')

C prepare to trap Control-C
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

	DO 20 N=1,N_Lwords
	  IF (TABLE(N).EQ.0) GOTO 20
	  DO J=0,31
	    IF (YOURANG) THEN
C search was interupted by a ^C
	      WRITE(lo,'(a)') ' *** SEARCH ABORTED BY CONTROL C. ***'
	      RETURN 1
	    ENDIF
	    IF (IBITS(TABLE(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
	      ISET = JCARD / 10000
	      ICARD = MOD(JCARD,10000)
C	get name info
	      CALL READNAM(NAMREC,LUNN,QM,FCOR,CHFORM,LCHFORM,CHNAME,LCHNAME)
C convert name from BYTE to string
	      write (cname,'(200a1)') (CHNAME(i),i=1,LCHNAME)
C find string starting point, if 0 then string not found
	      IF (INDEX(CNAME(1:LCHNAME),name(1:len)).EQ.0) 
	1	CALL BITSET(TABLE1,ISEQ,N_cards,0)
	    ENDIF
	  enddo
20	continue

	trace = '/NAME="'//name(1:len)//'"'
	tracelen = 8 + len
	RETURN
3	RETURN 1
	END
C!****************************************************************************
C** AST Subroutine to capture ^C interupts 
C*****************************************************************************
	SUBROUTINE CCAST(YOURANG)
	LOGICAL*4 YOURANG
	YOURANG = .TRUE.
	RETURN
	END
