	SUBROUTINE ignsub(wavel,*)

	REAL wavel

	include '[-.shared]jcpds.parms'
	include 'SEARCH.cmn'
	include 'SEARCH.par'

	INTEGER*4 ICARD,NAMREC,FULREC,DIREC,ISEQ
	LOGICAL DTOTT,TTTOD,DTOPDF,PDFTOD,DTOIND,INDTOD
	LOGICAL PDFTOCU,CUTOPDF
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,GET_LOGICAL,DEF_LOGICAL,GET_FNUMBER
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	LOGICAL EXRtst,displf,setf
	DIMENSION dsp(200)
	INTEGER*2 INT(200)
	INTEGER NDS
	character ans*1,qm*1
	real x,xl,xh,xmin,xmax

	xmin = 0.0
	xmax = 0.0
	nds = 0 
	WIDTH = 0.0
	MINI = -1
	displf = .false.
	iqual = 0
	IF (CLI$PRESENT('DISPLAY'))  displf = .true.

	icard = 0
	IF (CLI$PRESENT('CARD')) then
	  iqual = 1
	  FLAG = GET_NUMBER('CARD',icard)
	  IF (CLI$PRESENT('IMIN')) FLAG = GET_NUMBER('IMIN',MINI)
	  IF (CLI$PRESENT('WIDTH')) FLAG = GET_FNUMBER('WIDTH',WIDTH)
	ELSEIF (CLI$PRESENT('PEAK')) then
	  IF (CLI$PRESENT('EXCLUDE')) then
	    iqual = 2
	  ELSEIF (CLI$PRESENT('INCLUDE')) then
	    iqual = 3
	  ELSEIF (PROMPT) THEN
	    WRITE(lo,'(A)') '$Exclude peak(s) ([Y]/N): '
	    read (li,'(A1)',err=3) ians
	    IF (ians .eq. ' ' .or. ians .eq. 'y' .or. ians .eq. 'Y') 
	1	iqual = 2
	    IF (iqual .eq. 0) Then
	      WRITE(lo,'(A)') '$Include peak(s) ([Y]/N): '
	      read (li,'(A1)',err=3) ians
	      IF (ians .eq. ' ' .or. ians .eq. 'y' .or. ians .eq. 'Y') 
	1	iqual = 3
	    ENDIF
	  ENDIF
	  IF (CLI$PRESENT('WIDTH')) FLAG = GET_FNUMBER('WIDTH',WIDTH)
	  do i=1,200
	    FLAG = GET_FNUMBER('PEAK',dsp(nds+1))
	    IF (FLAG) goto 11
	    FLAG = .true.
	    IF (WAVEL .gt. 0.) flag = 
	1	TTTOD(dsp(NDS+1),dsp(NDS+1),wavel)
	    IF (FLAG) NDS = NDS + 1
	  ENDDO
	ELSEIF (CLI$PRESENT('RANGE')) then
	  IF (CLI$PRESENT('EXCLUDE')) then
	    iqual = 4
	  ELSEIF (CLI$PRESENT('INCLUDE')) then
	    iqual = 5
	  ELSEIF (PROMPT) THEN
	    WRITE(lo,'(A)') '$Exclude region ([Y]/N): '
	    read (li,'(A1)',err=3) ians
	    IF (ians .eq. ' ' .or. ians .eq. 'y' .or. ians .eq. 'Y') 
	1	iqual = 4
	    IF (iqual .eq. 0) Then
	      WRITE(lo,'(A)') '$Include region ([Y]/N): '
	      read (li,'(A1)',err=3) ians
	      IF (ians .eq. ' ' .or. ians .eq. 'y' .or. ians .eq. 'Y') 
	1	iqual = 5
	    ENDIF
	  ENDIF
	  FLAG = GET_FNUMBER('RANGE',xl)
	  IF (FLAG) goto 11
	  IF (xl .eq. 0) xl = 0.0001
	  FLAG = GET_FNUMBER('RANGE',xh)
	  IF (FLAG) goto 11
	  IF (xh .eq. 0) xl = 0.0001
	  xmin = min(xl,xh)
	  xmax = max(xl,xh)
	ENDIF
11	IF (.NOT. DISPLF .and. PROMPT .and. iqual .eq. 0) THEN
	  IF (CLI$PRESENT('EXCLUDE')) then
	    WRITE(LO,'(A)') ' Choose an action:',
	1	' 	1  Exclude peaks from a JCPDS pattern',
	1	' 	2  Exclude specified peak(s)',
	1	' 	3  Exclude specified region',
	1	'$Enter a number (1 to 3) or ? for help: '
	    if (iqual .le. 0 .or. iqual .gt. 3) goto 11
	    if (iqual .eq. 3) iqual = 4
	    read(li,'(i)',err=191,end=3) iqual
	  ELSEIF (CLI$PRESENT('INCLUDE')) then
	    WRITE(LO,'(A)') ' Choose an action:',
	1	' 	1  Include specified peak(s)',
	1	' 	2  Include specified region',
	1	'$Enter a number (1 or 2) or ? for help: '
	    if (iqual .le. 0 .or. iqual .gt. 2) goto 11
	    if (iqual .eq. 1) iqual = 3
	    if (iqual .eq. 2) iqual = 5
	    read(li,'(i)',err=191,end=3) iqual
	  ELSE
	    WRITE(LO,'(A)') ' Choose an action:',
	1	' 	0  Display excluded regions (default)',
	1	' 	1  Exclude peaks from a JCPDS pattern',
	1	' 	2  Exclude specified peak(s)',
	1	' 	3  Include specified peak(s)',
	1	' 	4  Exclude specified region',
	1	' 	5  Include specified region',
	1	'$Enter a number (0 to 5) or ? for help: '
	    read(li,'(i)',err=191,end=3) iqual
	    if (iqual .lt. 0 .or. iqual .gt. 5) goto 11
	  ENDIF
	ENDIF

	if (iqual .eq. 0)  displf = .true.

C**********************************************************************
	IF (iqual .eq. 1) then 
	  if (ICARD .eq. 0) then
	    IF (prompt) then 
102	      WRITE(lo,'(a)') ' Enter the JCPDS card number as'//
	1	' a single 5-6 digit ',' number (set#*10000+card#)'//
	1	' or as 2 numbers (set#, card#). '
	      WRITE(lo,'(a)') '$CARDNUMBER> '
	      READ(li,'(2i6)',end=3,err=102) icard,i
	      if (i .gt. 0) icard = icard*10000 + i
	    ELSE
	      goto 33
	    ENDIF
	  endif
C is ICARD a valid JCPDS number?
	  IF (ICARD .lt. 100 .or. CARDNO/10000 .gt. N_SETNO) then
103	    write (lo,'(A,i)') ' Invalid JCPDS card number: ',icard
	    goto 102
	  ELSE
C lookup a sequence number
	    CALL CARDLOC(ICARD,NAMREC,FULREC,DIREC,ISEQ,N_cards,LUNM,*103)
	  ENDIF
C    get D/I info
	  CALL READDI(DIREC,dsp,INT,NDS,LPDF,0.0,200)
C   get name info
	  CALL READNAM(NAMREC,LUNN,qm,FCOR,CHFORM,LCHFORM,CHNAME,LCHNAME)
	  WRITE(lo,129) ICARD,(CHFORM(i),i=1,LCHFORM)
129	  FORMAT(' [',I6.6,']  ',60a1,10(/,11x,60a1))
	  WRITE(lo,'(11x,60a1)') (CHNAME(i),i=1,LCHNAME)
	  write (lo,'(a)') '$Is this the correct card? (default=Y): '
	  read (li,'(a)',end=3) ans
	  if (ans .eq. 'N' .or. ans .eq. 'n') goto 102
	  if (MINI .eq. -1) then 
104	    i = 0
	    If (PROMPT) then 
	      write(LO,'(a,i3,a)') 
	1	'$Enter the minimum JCPDS intensity to be used (default=',
	2	imin,'): '
	      read(lo,'(q,I)',end=3,err=104) i,mini
	    ENDIF
	    if (i .eq. 0) then mini = imin
	  endif
C remove weak peaks
	  do i=1,nds
	    if (INT(i) .lt. mini) dsp(i) = -1.
	  enddo

	  setf = .true.
	  j = 'ex'
C**********************************************************************
	ELSEIF(iqual .eq. 2 .or. iqual .eq. 3) then
	  IF(iqual .eq. 2) then
	    setf = .true.
	    j = 'ex'
	  ELSEIF(iqual .eq. 3) then
	    setf = .false.
	    j = 'in'
	  ENDIF
	  if (nds .eq. 0 .and. prompt) then
105	    write(lo,'(a,a2,a,/,a)') 
	1	' Enter the positions to be ',j,'cluded, one per line. ',
	1	' Enter a blank line when done.'
	    do i=nds+1,200
	      write (lo,'(A,i3,a)') '$Enter position',nds+1,': '
	      read (li,'(q,F10.0)',end=3,err=105) k,dsp(nds+1)
	      FLAG = .true.
	      IF (WAVEL .gt. 0.) flag = 
	1	TTTOD(dsp(NDS+1),dsp(NDS+1),wavel)
	      IF (FLAG) NDS = NDS + 1
	      if (k .eq. 0) goto 106
	    enddo 
	  endif
	  displf = .true.
C**********************************************************************
	ELSEIF(iqual .eq. 4 .or. iqual .eq. 5) then
	  IF(iqual .eq. 4) then
	    setf = .true.
	    j = 'ex'
	  ELSEIF(iqual .eq. 5) then
	    setf = .false.
	    j = 'in'
	  ENDIF
	  IF (xmax .le. 0 .and. xmin .le. 0 .and. PROMPT) then
110	    IF (WAVEL .le. 0) then
	      write(lo,'(a,a2,a)') 
	1	'$Enter the minimum ',j,'cluded d-space: '
	      READ(li,'(f10.0)',end=3,err=110) xmin
	      if (xmin .eq. 0.) xmin = 0.0001
	      write(lo,'(a,a2,a)') 
	1	'$Enter the maximum ',j,'cluded d-space: '
	      READ(li,'(f10.0)',end=3,err=110) xmax
	      IF (xmax .le. 0 .or. XMax .le. xmin) Then
		Write (lo,'(A)') ' *** Illegal max. d-space'
	        goto 3
	      ENDIF
	    ELSE
	      write(lo,'(a,a2,a)') 
	1	'$Enter the minimum ',j,'cluded two-theta: '
	      READ(li,'(f10.0)',end=3,err=110) xmax
	      write(lo,'(a,a2,a)') 
	1	'$Enter the maximum ',j,'cluded two-theta: '
	      READ(li,'(f10.0)',end=3,err=110) xmin
	      IF (xmin .le. 0 .or. xmin .le. xmax) Then
		Write (lo,'(A)') ' *** Illegal max. angle'
	        goto 3
	      ENDIF
	    ENDIF
	  ENDIF
	  xl = 0.
	  xh = 0.
	  IF (xmin .gt. 0 .and. WAVEL .le. 0) then
	    xl = xmin
	  ELSEIF (xmin .gt. 0) then
	    flag = TTTOD(xh,xmin,wavel)
	    if (.not. flag) xh = 9999.
	  ENDIF
	  IF (xmax .gt. 0 .and. WAVEL .le. 0) then
	    xh = xmax
	  ELSEIF (xmax .gt. 0) then
	    flag = TTTOD(xl,xmax,wavel)
	    if (.not. flag) xl = 0.0001
	  ENDIF

	  IF (xl .gt. 0 .and. xh .gt. 0) THEN
	    flag = dtott(xl,xl,1.5405598)
	    if (.not. flag) xl = 180.
	    flag = CutoPDF(AMax,xl)
	    IF (.not. FLAG) amax = 31416
	    flag = dtott(xh,xh,1.5405598)
	    if (.not. flag) xh = 0.
	    flag = CutoPDF(AMIN,xh)
	    IF (.not. FLAG) amin = -31416
	    call exset(extbl,amin,amax,setf)
	    displf = .true.
	  else
	    WRITE (LO,'(A)') 
	1	' *** No Minimum or maximum -- range unchanged'
	  ENDIF
C**********************************************************************
	ENDIF

106	IF (iqual .gt. 0 .and. iqual .le. 3) then
	  if (nds .eq. 0) goto 3
	  if (WIDTH .eq. 0.0) then
107	    i = 0
	    If (PROMPT) then 
	      write(LO,'(a,a2,a,/,a,f6.3,a)') 
	1	' Enter the width on either side of the peak(s) to be '
	1	,j,'cluded -- in degrees','$Two-theta, Cu K alpha (default=',
	2	FFWHM,'): '
	      read(lo,'(q,f10.0)',end=3,err=107) i,width
	    ENDIF
	    if (i .eq. 0) width = FFWHM
	  endif
C reset the table of hits since we have changed the search parameters
	  CALL TBLCLR(TABLE,N_Lwords,NPHASE)
	  NSTEP = 0

	  do 21 i=1,nds
	    if (dsp(i) .le. 0) goto 21
C convert D-space to 2theta at Cu Ka  
	    flag = dtott(dsp(i),x,1.5405598)
	    if (.not. flag) x = 180.

C compute range to be excluded and widen up the window by one unit
	    x1 = min(180.,x+abs(width))
	    flag = CutoPDF(AMAX,x1)
	    if (.not. flag) amax = 31416
	    amax = min(amax+1,31416)

	    x1 = max(0.,x-abs(width))
	    flag = CutoPDF(AMIN,x1)
	    IF (.not. FLAG) amin = -31416
	    amin = max(amin-1,-31416)

	    call exset(extbl,amin,amax,setf)
21	  CONTINUE
	ENDIF

C**********************************************************************
C  Display the excluded regions
400	IF (DISPLF) then
C    Find end and the begining range
	  amin = -31416
	  amax = 31416
	  do i=amin,amax
	    if (EXRtst(extbl,i)) then 
	      amin = i
	    else
	      goto 421
	    endif
	  enddo
421	  do i=amax,amin,-1
	    if (EXRtst(extbl,i)) then 
	      amax = i
	    else
	      goto 422
	    endif
	  enddo
422	  flag = pdftod(amin,dmax)
	  if (.not. flag) then
	    dmax = 1.e10
	    x = 0.0
	  elseIF (wavel .gt. 0) then
	    IF (.not. DTOTT(DMAX,X,wavel)) x = 180.0
	  ENDIF

	  flag = pdftod(amax,dmin)
	  if (.not. flag) then
	    dmin = 1.e10
	    x1 = 0.0
	  elseIF (wavel .gt. 0) then
	    IF (.not. DTOTT(DMIN,X1,wavel)) x1 = 180.0
	  ENDIF

	  write (lo,'(a)') ' ',' Excluded Regions: '
	  IF (wavel .gt. 0) then
	    write (lo,'(a,f6.2,a)') ' 	below',x,' degrees'
	    write (lo,'(a,f6.2,a)') ' 	above',x1,' degrees'
	  ELSE
	    write (lo,'(a,g11.3,a)') ' 	below',DMIN,'Angstroms'
	    write (lo,'(a,g11.3,a)') ' 	above',DMAX,'Angstroms'
	  ENDIF

430	  do i=amin+1,amax-1
	    if (EXRtst(extbl,i)) then 
	      amin = i
	      do j=amin+1,amax-1
		if (.not. EXRtst(extbl,j)) then 
		  amin = j
		  goto 431
		endif
	      enddo
431	      flag = pdftod(i,dmax)
	      flag = pdftod(j,dmin)
	      IF (wavel .gt. 0) then
		IF (.not. DTOTT(DMAX,X1,wavel)) x1 = 0.0
		IF (.not. DTOTT(DMIN,X2,wavel)) x = 180.
	        write (lo,'(2(a,f6.2),a)') 
	1	' 	between',x1,' and',x2,' degrees'
	      ELSE
	        write (lo,'(2(a,g11.3),a)') 
	1	' 	between',dmin,'and',dmax,'Angstroms'
	      ENDIF
	      goto 430
	    endif
	  enddo
	  write (lo,'(a)') 
	  CALL PS_PAUSE(PROMPT)
C no more regions
	ENDIF
1	return
191	call help('IGNORE','search_hlp',prompt)
	goto 11
33	type *,'Unable to prompt for required input'
3	type *,'No actions performed'
	CALL PS_PAUSE(PROMPT)
	return 1
	ENTRY igndsp(wavel)
	DISPLF = .true.
	goto 400
	end
