	SUBROUTINE GETD(trace,tracelen,ilogic,*)
C
C Subroutine to get d-space input and logic
C
	include 'logic.common'
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,GET_LOGICAL,DEF_LOGICAL,GET_FNUMBER
	LOGICAL DTOTT,TTTOD,DTOPDF,PDFTOD,DTOIND,INDTOD
	INTEGER*4 NAMREC,FULREC,DIREC,ISEQ,JCARD
	INTEGER*2 NCH,pklogic,tracelen,imode
	CHARACTER*(*) trace
	CHARACTER*50 formnum,temp
	CHARACTER*150 cpeak,cerr,parm
	CHARACTER*10 three/'3STRONGEST'/
	integer len,cplen,celen
	PARAMETER (m_pk = 20)
	real peaks(m_pk),peakerr(m_pk)
	real pdmin(m_pk),pdmax(m_pk)
	INTEGER*2 pdf1,pdf2,pdfmin(m_pk),pdfmax(m_pk),intmin
	INTEGER*4 IND,IND1(m_pk),ind2(m_pk),dindex,aindex
	INTEGER*2 JC(210)
	INTEGER*2 JC1(42),JC2(42),JC3(42),JC4(42),JC5(42)
	EQUIVALENCE (JC1(1),JC(1))
	EQUIVALENCE (JC2(1),JC(43))
	EQUIVALENCE (JC3(1),JC(85))
	EQUIVALENCE (JC4(1),JC(127))
	EQUIVALENCE (JC5(1),JC(169))

	BYTE INTB(210)
	BYTE IN1(42),IN2(42),IN3(42),IN4(42),IN5(42)
	EQUIVALENCE (IN1(1),INTB(1))
	EQUIVALENCE (IN2(1),INTB(43))
	EQUIVALENCE (IN3(1),INTB(85))
	EQUIVALENCE (IN4(1),INTB(127))
	EQUIVALENCE (IN5(1),INTB(169))
	INTEGER*2    NUMJC,dummy2

	trace = '/PEAKS=('
	tracelen = 8
	ipeaks = 0

C if /DSPACE is present, all input will be as d-spaces
	twave = wave0
	IF (CLI$PRESENT('dspace')) then
	  twave = 0
	ELSEIF (CLI$PRESENT('wavelength')) then
	  FLAG = GET_FNUMBER('wavelength',twave)
	  IF (FLAG) TYPE *,'Invalid wavelength entered',twave
	ENDIF

	imode = 0
	pklogic = 0
	dindex = 101
	IF (.not. CLI$PRESENT('PEAKS')) goto 10

	do i=1,m_pk
	  FLAG = GET_FNUMBER('PEAKS',peaks(i))
	  IF (.not. FLAG) then
	    ipeaks = i
	  ELSE
	    IF (ipeaks .eq. 0) goto 10
	    goto 21
	  ENDIF
	enddo

21	do i=1,ipeaks
	  FLAG = GET_FNUMBER('error',peakerr(i))
	  IF (FLAG .and. i .eq. 1 .and. PROMPT) then
	    write (lo,'(A)') '$Enter minimum error in peak positions: '
	    read (li,'(F10.0)',end=3) peakerr(i)
	  ELSEIF (FLAG .and. i .eq. 1) then
	    peakerr(i) = 0.0
	  ELSEIF (FLAG) then
	    peakerr(i) = peakerr(i-1)
	  ENDIF
C reset negative errors for GJJ
	  peakerr(i) = abs(peakerr(i))
	enddo

	do i=ipeaks,1,-1
C is the PEAK at a location in the index?
	  flag = .true.
	  x = peaks(i)
	  IF (twave .gt. 0) flag = TTTOD(x,x,twave)
	  IF (FLAG) flag = DTOIND(x,ind,N_REGIONS)
	  IF (.not. FLAG) then
	    WRITE (LO,'(/A,F7.3/)') 
	1	' *** Invalid position: Rejecting peak at',peaks(i)
	    ipeaks = ipeaks - 1
	    do j=i,ipeaks
	      peaks(j) = peaks(j+1)
	      peakerr(j) = peakerr(J+1)
	    enddo	 
	  ENDIF
	enddo
	goto 20

10	ipeaks = 0
	deferr = 0.0
	if (wave0 .gt. 0) then 
	  write (lo,'(A,f7.5,a)') 
	1	' Enter peak positions as two-theta angles'//
	1	' (wavelength = ',wave0,')'
	ELSE
	  write (lo,'(A)') ' Enter peak positions as d-space values '//
	1	'(in Angstroms)'
	ENDIF
	do i=1,m_pk
24	  write (lo,'(A,i3,a)') '$Enter peak position',ipeaks+1,': '
	  read (li,'(q,F10.0)',end=20,err=24) k,peaks(ipeaks+1)
	  if (k .eq. 0) goto 20 
	  write (lo,'(A,f6.3,a)') '$Minimum error in peak positions '//
	1	'(default=',deferr,'): '
	  read (li,'(q,F10.0)',end=20,err=24) k,peakerr(ipeaks+1)
C reset negative errors for GJJ
	  peakerr(ipeaks+1) = abs(peakerr(ipeaks+1))
	  if (k .eq. 0) then 
	    peakerr(ipeaks+1) = deferr
	  else
	    deferr = peakerr(ipeaks+1)
	  endif
C is the PEAK at a location in the index?
	  flag = .true.
	  x = peaks(ipeaks+1)
	  IF (twave .gt. 0) flag = TTTOD(x,peaks(ipeaks+1),twave)
	  IF (FLAG) flag = DTOIND(x,ind,N_REGIONS)
	  IF (FLAG) then
	    ipeaks = ipeaks + 1
	  ELSE
	    WRITE (LO,*) '*** Invalid position: Rejecting peak',
	1	peaks(ipeaks+1)
	  ENDIF
	enddo

20	IF (IPEAKS .eq. 0) THEN
	  write (lo,'(/A/)') ' Error -- no peaks input for search'
	  return 1
	endif

	do i=1,ipeaks
	  if (imode .eq. 0 .and. peakerr(i) .le. 0) then
	    write (lo,'(/,2A/)') ' ***',
	1  ' Note: /FAST mode will be used, /EXACT requires non-zero errors'
	    imode = 2	
	  ENDIF
	  IF (twave .gt. 0) then
C	convert 2T's to D's, if appropriate
	    flag = TTTOD(pdmin(i),peaks(i)+peakerr(i),twave)
	    pdmax(i) = 1.E5	! (in case peakerr>peaks)
	    flag = TTTOD(pdmax(i),peaks(i)-peakerr(i),twave)
	  ELSE
	    pdmin(i) = peaks(i) - peakerr(i)
	    pdmax(i) = peaks(i) + peakerr(i)
	  ENDIF
	  flag = DTOIND(pdmax(i),ind1(i),N_REGIONS)
	  flag = DTOIND(pdmin(i),ind2(i),N_REGIONS)
	ENDDO

C now get the type of logic
	IF (CLI$PRESENT('OR') .or. ipeaks .eq. 1) THEN
	  pklogic = 1
	ELSEIF (CLI$PRESENT('AND')) THEN
	  pklogic = 2
	ENDIF
	IF (pklogic .eq. 0 .and. PROMPT) THEN
25	  write (lo,'(A)') ' Choose a logic type: ',
	1 ' 	(1) OR   -- materials with ANY of the selected peaks',
	2 ' 	(2) AND  -- materials with ALL of the selected peaks',
	5 '$Enter your choice (default=2): '
	  read(li,'(q,i)',err=25) ITMP,pklogic
	  IF (ITMP .eq. 0 .or. pklogic .gt. 2 .or. pklogic .le. 0) pklogic = 2
	ENDIF
	IF (pklogic .eq. 0) THEN
	  write (lo,'(/A/)') ' *** Logic type not set: using /AND'
	  pklogic = 2
	ENDIF

C get the index choice from the command line
	IF (CLI$PRESENT('LEVEL')) THEN
	  len = 0
	  STATUS = CLI$GET_VALUE('LEVEL',parm,len)
	  IF (len .gt. 1 .and. parm(1:len) .eq. three(1:len)) then
	    dindex = -1
	    imode = 2
	  ELSEIF (len .gt. 0) THEN
	    READ(parm(1:len),'(I)',err=121) dindex
	  ENDIF
	ENDIF
C get the mode type from the command line
121	IF (CLI$PRESENT('FAST')) THEN
	  imode = 2
	ELSEIF (CLI$PRESENT('EXACT') .and. imode .eq. 2) THEN
	  write (lo,'(/A/)') 
	1 ' *** Previous option overrides /EXACT mode'
	ELSEIF (CLI$PRESENT('EXACT')) THEN
	  imode = 1
	ENDIF
C If mode not set, get mode from the user
	IF (imode .eq. 0) then
	  IF (PROMPT) THEN
122	    write (lo,'(A)') ' Choose a search mode: ',
	1 ' 	(1) EXACT  -- use peak positions with errors as input',
	2 ' 	(2) FAST   -- expand peak errors to match bitmap indices',
	5 '$Enter your choice (default=2): '
	    read(li,'(q,i)',err=122) ITMP,imode
	    IF (ITMP .eq. 0 .or. imode .gt. 2 .or. imode .le. 0) imode = 2
	  ELSE
	    write (lo,'(/A/)') 
	1	' *** Mode type not set: defaulting to /FAST'
	    imode = 2
	  ENDIF
	ENDIF

C If level not set, get the level from the user
	IF (dindex .gt. 99 .and. PROMPT .and. imode .eq. 2) then
123	  write (lo,'(A)') ' Choose the threshold for peak index:',
	1 '     -1)  one of the three strongest peaks',
	1 '      0)  peaks >= 0% relative intensity',
	1 '     10)  peaks >=10% relative intensity',
	1 '      .',
	1 '      .    (or next lowest index)',
	1 '      .',
	1 '     99)  peaks >=99% relative intensity',
	5 '$Enter your choice (default=70): '
	  read(li,'(q,i)',err=123) ITMP,dindex
	  IF (ITMP .eq. 0) dindex = 70
	  dindex = max(dindex,-1)
	  dindex = min(dindex,99)
	ELSEIF (dindex .gt. 99 .and. PROMPT) then
124	  write (lo,'(A)') ' Choose the peak threshold:',
	1 '      0)  peaks >= 0% relative intensity',
	1 '     10)  peaks >=10% relative intensity',
	1 '      .',
	1 '      .',
	1 '      .',
	1 '     99)  peaks >=99% relative intensity',
	5 '$Enter your choice (default=70): '
	  read(li,'(q,i)',err=124) ITMP,dindex
	  IF (ITMP .eq. 0) dindex = 70
	  dindex = max(dindex,0)
	  dindex = min(dindex,99)
	ELSEIF (dindex .gt. 99) then
	    write (lo,'(/A/)') 
	1	' *** Threshold not set: defaulting to /LEVEL=70'
	    dindex = 70
	ENDIF

C get the appropriate index file
	call getindex(dindex,aindex,LUNC)
C unable to open the file
	IF (aindex .gt. 99 .and. dindex .eq. -1) THEN
C no three strongest file -- error!
	  write(*,'(2a)') ' ERROR -- Unable to open d-space INDEX file '
	1 ,'(PS_bitmap:DSP3S.BITMAP)'
	  goto 3
	ELSEIF (aindex .gt. 99) THEN
C unable to open a lower intensity peak threshold file -- error!
	  write(*,'(2a)') ' ERROR -- Unable to open d-space INDEX file '
	1 ,'(PS_bitmap:DSP00.BITMAP)'
	  goto 3
	ELSEIF (aindex .ne. dindex .and. imode .ne. 1) THEN
C warn
	  write(*,'(/a,i2,a,i2,a/)') ' *** Unable to open the ',dindex
	1	,'% Index file, will substitute the ',aindex,'% file.'
	    dindex = aindex
	ENDIF
C--------------------------------------------------------------------------
C Assemble trace line
	cplen = 0
	celen = 0
	DO i=1,ipeaks
C determine range used in /FAST search
	  IF (imode .ne. 1) then
	    FLAG = INDTOD(ind1(i),ind2(i),DMAX,DMIN,N_REGIONS)
C   convert d's back to angles
	    IF (twave .gt. 0) then
	      flag = DTOTT(DMAX,DMAX,twave)
	      flag = DTOTT(DMIN,DMIN,twave)
	    ENDIF
C round down (by subtracting 0.0005)
	    X = (DMAX + DMIN)/2.
	    err = abs(dMAX - (dMAX + dMIN)/2.) - 0.0005
	  ELSE
C set actual range for /EXACT search
	    X = peaks(i) 
	    err = peakerr(i)
	  ENDIF
	  cpeak(cplen+1:) = FORMNUM(X,3,len)
	  cplen = cplen + len + 1
	  cpeak(cplen:cplen) = ','
	  cerr(celen+1:) = FORMNUM(err,3,len)
	  celen = celen + len + 1
	  cerr(celen:celen) = ','
	ENDDO
	trace = trace(1:tracelen)//cpeak(1:cplen-1)//')'
	tracelen = tracelen + cplen
	trace = trace(1:tracelen)//'/ERROR=('//cerr(1:celen-1)//')'
	tracelen = tracelen + 8 + celen
	IF (twave .gt. 0) then
	  trace = trace(1:tracelen)//'/WAVELENGTH='//FORMNUM(twave,6,len)
	  tracelen = tracelen + 12 + len
	ELSE
	  trace = trace(1:tracelen)//'/DSPACE'
	  tracelen = tracelen + 7
	ENDIF

	IF (dindex .eq. -1) THEN
	  trace = trace(1:tracelen)//'/LEVEL=3Strong'
	  tracelen = tracelen + 14
	ELSE
	  trace = trace(1:tracelen)//'/LEVEL=xx'
	  tracelen = tracelen + 9
	  write(trace(tracelen-1:tracelen),'(i2.2)') dindex
	ENDIF
	IF (imode .ne. 1) then
	  trace = trace(1:tracelen)//'/FAST'
	  tracelen = tracelen + 5
	ELSE
	  trace = trace(1:tracelen)//'/EXACT'
	  tracelen = tracelen + 6
	ENDIF
	IF (pklogic .eq. 1) THEN
	  trace = trace(1:tracelen)//'/OR'
	  tracelen = tracelen + 3
	ELSE
	  trace = trace(1:tracelen)//'/AND'
	  tracelen = tracelen + 4
	ENDIF

C----------------------------------------------------------------------
C start FAST search
	IF (pklogic .eq. 1) then
C OR together d's -- start with blank slate
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
	ELSE
C AND together d's -- start with all hits and then eliminate
	  CALL TBLSET(TABLE1,N_cards,nph1)
	ENDIF

	DO i=1,ipeaks
	  FLAG = INDTOD(ind1(i),ind2(i),DMAX,DMIN,N_REGIONS)
	  read(LUNC,rec=ind1(i)) (TABLE2(j1),j1=1,N_Lwords)

	  DO j=ind1(i)+1,ind2(i)
	    read(LUNC,rec=j) (TABLE3(j1),j1=1,N_Lwords)
	    CALL TBLOR(TABLE2,TABLE3,TABLE2,N_Lwords)
	  ENDDO
	  temp = FORMNUM(peaks(i),3,len)
	  parm = 'peak @ '//temp(1:len)//' +- '
	  k = 11 + len
	  temp = FORMNUM(peakerr(i),3,len)
	  parm = parm(1:k)//temp(1:len)//' (actual range: '
	  k = k + len + 16
	  IF (twave .gt. 0) then
C	convert D's to 2T's
	    flag = DTOTT(DMAX,TTMIN,twave)
	    flag = DTOTT(DMIN,TTMAX,twave)
	    dmax = ttmax
	    dmin = ttmin
	  ENDIF
	  temp = FORMNUM(dmin,3,len)
	  parm = parm(1:k)//temp(1:len)//' to '
	  k = k + len + 4
	  temp = FORMNUM(dmax,3,len)
	  parm = parm(1:k)//temp(1:len)//')'
	  k = k + len + 1
C count the number of matching cards
	  CALL TBLCOUNT(TABLE2,N_Lwords,nph2)
	  write (lo,'(1x,a,i6)') parm(1:k)//'  # entries =',nph2

C OR together d's
	  IF (pklogic .eq. 1) then
	    CALL TBLOR(TABLE1,TABLE2,TABLE1,N_Lwords)
C AND together d's
	  ELSE
	    CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	  ENDIF
	ENDDO
C now done with the index
	CLOSE(UNIT=LUNC)

C if this is /FAST mode, we are done, if not we still have the /EXACT left
	IF (imode .ne. 1) RETURN
C----------------------------------------------------------------------
C now narrow down the range by applying the /EXACT constraints 
C   set the minimum allowable intensity?
	intmin = dindex
C  convert the peak positions to PDF values
	do i=1,ipeaks
	  flag = dtoPDF(pdf1,pdmin(i))
	  if (.not. flag) goto 31
	  flag = dtoPDF(pdf2,pdmax(i))
	  if (.not. flag) goto 31
	  pdfmin(i) = min(pdf1,pdf2)
	  pdfmax(i) = max(pdf1,pdf2)
	ENDDO
C open the DI file
!	OPEN (UNIT=LPDF,NAME='PS_JCPDS:DI.library',STATUS='OLD',
!	1	FORM='UNFORMATTED',ACCESS='DIRECT',READONLY,SHARED)
C count the number of matching cards
	CALL TBLCOUNT(TABLE1,N_Lwords,nph1)
	write (lo,'(a,i6)') ' Before /EXACT constraint: # entries =',nph1
	IF (ilogic .eq. 2) then 
	  CALL TBLAND(TABLE,TABLE1,TABLE1,N_Lwords)
	  CALL TBLCOUNT(TABLE1,N_Lwords,nph1)
	  write (lo,'(a,i6)')
	1 ' Preapplying MATCH step reduces # of entries to ',nph1
	ENDIF
C-----------------------------------------------------------------------
C   /OR logic -- at least one peak must match
	IF (pklogic .eq. 1) then
C     clear table2
	  CALL TBLCLR(TABLE2,N_Lwords,nph2)
C     loop through table, check each hit
	  DO 70 N=N_Lwords,1,-1
	    IF (TABLE1(N).EQ.0) GOTO 70
	    DO 71 J=31,0,-1
	      IF (IBITS(TABLE1(N),J,1).NE.1) GOTO 71
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	  get D/I info -- read each record as needed
	      READ(LPDF,REC=DIREC) NUMJC,JC1,IN1
	      DO I=1,NUMJC
		IF (I .eq. 43) THEN 
		  READ(LPDF,REC=DIREC+1) dummy2,JC2,IN2
		ELSEIF (I .eq. 85) THEN
	  	  READ(LPDF,REC=DIREC+2) dummy2,JC3,IN3
		ELSEIF (I .eq. 127) THEN
	  	  READ(LPDF,REC=DIREC+3) dummy2,JC4,IN4
		ELSEIF (I .eq. 169) THEN
		  READ(LPDF,REC=DIREC+4) dummy2,JC5,IN5
		ENDIF
	  	do k=1,ipeaks
		  if (JC(I) .ge. pdfmin(k) .and. JC(I) .le. pdfmax(k)
	1		.and. INTB(i) .ge. intmin) then
C             we found a matching peak on this card, now go on to next
		    CALL BITSET(TABLE2,ISEQ,N_cards,1)
		    goto 71
		  endif
		ENDDO
	      ENDDO
71	    CONTINUE
70	  CONTINUE
C-----------------------------------------------------------------------
C   /AND logic -- all cards must have a match for every peak
	ELSE
C     clear table2
	  CALL TBLCLR(TABLE2,N_Lwords,nph2)
C     loop through table, check each hit
	  DO 80 N=N_Lwords,1,-1
	    IF (TABLE1(N).EQ.0) GOTO 80
	    DO 81 J=31,0,-1
	      IF (IBITS(TABLE1(N),J,1).NE.1) GOTO 81
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	  get D/I info -- read each record as needed
	      READ(LPDF,REC=DIREC) NUMJC,JC1,IN1
C   look for a match for each peak
	      imin = 1
	      do 83 k=1,ipeaks
		DO I=1,NUMJC
		  IF (I .eq. 43 .and. imin .lt. 43) THEN 
		    READ(LPDF,REC=DIREC+1) dummy2,JC2,IN2
		    imin = 43
		  ELSEIF (I .eq. 85 .and. imin .lt. 85) THEN
	  	    READ(LPDF,REC=DIREC+2) dummy2,JC3,IN3
		    imin = 85
		  ELSEIF (I .eq. 127 .and. imin .lt. 127) THEN
	  	    READ(LPDF,REC=DIREC+3) dummy2,JC4,IN4
		    imin = 127
		  ELSEIF (I .eq. 169 .and. imin .lt. 169) THEN
		    READ(LPDF,REC=DIREC+4) dummy2,JC5,IN5
		    imin = 169
		  ENDIF
C if the peak matches the card go on to the next peak
		  if (JC(I) .ge. pdfmin(k) .and. JC(I) .le. pdfmax(k)
	1		.and. INTB(i) .ge. intmin) goto 83
		ENDDO
C          this peak was not matched on the card, reject the card
		goto 81
83	      ENDDO
C       all peaks were matched
	      CALL BITSET(TABLE2,ISEQ,N_cards,1)
81	    CONTINUE
80	  CONTINUE
	ENDIF
	CALL TBLMOVE(TABLE2,TABLE1,N_Lwords)
!	close (UNIT=LPDF)

1	RETURN
31	WRITE (lo,'(/a,i6,a/)') ' *** Peak #',i,' is out of range'
	if (prompt) goto 10
3	RETURN 1
	END
