C-------------------------------------------------------------------------
	SUBROUTINE GETPEAKS(filename,ln,sname,s_ln,dname,d_ln,
	1	pname,p_ln,fileform,STATUS)
C-------------------------------------------------------------------------
C This is a general purpose subroutine which reads in peaks. The 
C subroutine first attempts to read a diffractogram/peak data file
C using subroutine READDATA (N.B. some data file formats include peaks
C others have pairs of peak and data files). If only a data file is
C found, the program also looks for a "generic" peak file with the 
C same root name.
C
C If a data file is read without errors, the name of the file is 
C stored in DNAME. (Note that the diffractogram data is not used 
C at this time. The file is merely validated and the data will be 
C reread by subroutine GETDATA if the REPORT command is used.)
C If peaks are read from a file without errors, the name of the file
C is stored in PNAME. The peaks are then stored in the peak array.
C
C If a peak or data file is read, the SEARCH NAME is set from the 
C file name.
C-------------------------------------------------------------------------
C Subroutine READDATA is designed to accomodate many different
C file formats. It is recommended that these two subroutines be modified
C to add additional file formats rather than modify this subroutine. 
C					Brian Toby
C-------------------------------------------------------------------------
C Parameters:
C	FILENAME(:ln)   the name of the input file name or file root name
C	SNAME(:s_ln)    is set as the search name if the read is successful
C	DNAME(:d_ln)    is set as the name of the diffractogram file
C	PNAME(:p_ln)    is set as the name of the peak file
C	FILEFORM        is the specified format string, if any
C-------------------------------------------------------------------------
	CHARACTER*(*) filename,sname,dname,pname,FILEFORM
	INTEGER ln,s_ln,d_ln,p_ln
	INTEGER STATUS
	LOGICAL STAT
C-------------------------------------------------------------------------

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

	LOGICAL DTOTT,TTTOD,DTOPDF,PDFTOD,DTOIND,INDTOD,flag
	character*40 node,device,dir,name*60,type*20,ver*5
	integer*2 len_node,len_device,len_dir,len_name,len_type,len_ver

C has the subroutine been passed a file name?
834	if (ln .le. 0 .and. prompt) THEN
	  fileform = ' '
	  write(lo,'(A)') ' ',
	1	' Enter a data/peak file name (extension is optional)',
	1	' Include a wild card (* or %) to see directory',
	1	'$File name: '
	  read (li,fmt='(q,a)',end=3) ln,filename
	endif
	if (ln .eq. 0) then
	  type *,'GETPEAKS ERROR --  No file to read'
	  goto 3
	endif
	do I=1,ln
	  if (filename(I:I) .eq. '*' .or. filename(I:I) .eq. '%') THEN
	    call lib$spawn('$ directory/nosiz/bri/notra '//filename(1:ln))
	    ln = 0
	    goto 834
	  ENDIF
	enddo

	NPTS = 0
	IF (LENCH(fileform) .gt. 1) filename = filename(:ln)//
	1		'/FORM='//fileform
	Dname = ' '
	d_ln = 0
	Pname = ' '
	p_ln = 0
C So now try to read a raw data file
	CALL READDATA(filename,1,STAT,.true.,.true.,
	1	fileform,node,.false.)
C was there an error?
	IF (.not. STAT) then
	  IF (npoint(1) .gt. 0) then
	    Write (lo,'(A)') ' Warning -- File '//
	1	OFILNAM(1)(:lench(OFILNAM(1))),
	2	'   contains only a diffractogram (no peaks).',
	3  ' You must enter the peaks manually with the EDIT command.'
	  ELSEif (NPKS(1) .gt. 0) THEN
	    Write (lo,'(A)') ' Peaks read successfully (no raw data)'
	  ELSE
	    Write (lo,'(2A)') ' Warning -- unable to locate or read file ',
	1	filename(:lench(filename))
	    ln = 0
	    if (prompt) goto 834
	    goto 3
	  ENDIF
	ELSE
	  Write (lo,'(A)') ' Peaks and raw data read successfully'
	ENDIF
	CALL PS_PAUSE(PROMPT)

C save the file name(s)
	IF (npoint(1) .gt. 0) then
	  Dname = cfilnam(1)
	  d_ln = lench(dname)
	  dname = dname(:d_ln) // '/FORM=' //fileform
	  d_ln = lench(dname)
	ENDIF
	if (NPKS(1) .gt. 0) THEN
	  pname = filename
	  p_ln = lench(pname)
	  pname = pname(:p_ln) // '/FORM=' //node
	ENDIF
C set the search title
	IF (lench(TITLES) .le. 1 .and. lench(ATITLE(1)) .gt. 0) then
	  titles = atitle(1)  
	ELSEIF (DEFAULT .and. lench(ATITLE(1)) .gt. 0) then
	  titles = atitle(1)  
	ELSEIF (lench(ATITLE(1)) .gt. 0) then
	  write (lo,'(1x,A)') 'Changing the SEARCH title from:',
	1	titles,'to',atitle(1)
	  write (lo,'(A)') '$Make this change? ([Y]/N): '
	  read(li,'(A1)',err=3) ians
	  IF (ians .ne. 'N' .and. ians .ne. 'n') titles = atitle(1)  
	ENDIF
C-- set excluded range for the data
C   was diffractogram data read from the file?
	IF (npoint(1) .gt. 0) then
	  numob = 0
C   Set the excluded angle range from range of data
	  call exclr(extbl)
	  flag = TTTOD(dmin,finish(1),wave(1))
	  FLAG = DTOPDF(AMAX,DMIN)
	  call exset(extbl,amax,31416,.true.)
	  flag = TTTOD(dmax,start(1),wave(1))
	  FLAG = DTOPDF(AMIN,DMAX)
	  call exset(extbl,-31416,amin,.true.)
C   was peak data read from the file?
	ELSEIF (NPKS(1) .gt. 0) then
	  dmin = DSPACE(1,1)
	  dmax = DSPACE(1,1)
	  DO I=2,NPKS(1)
	    dmin = min(dmin,DSPACE(I,1))
	    dmax = max(dmax,DSPACE(I,1))
	  ENDDO
C  set excluded angle range from range of peaks
	  call exclr(extbl)
	  FLAG = DTOPDF(AMAX,DMIN)
	  call exset(extbl,amax,31416,.true.)
	  FLAG = DTOPDF(AMIN,DMAX)
	  call exset(extbl,-31416,amin,.true.)
	ENDIF

C----------------------------------------------------------------------------
	numob = 0
C interpret the peaks: pull out d's and I's for a1/a12 (not a2) peaks
	if (NPKS(1) .gt. 0) THEN
C reset the table of hits since we will now be changing the search parameters
	  CALL TBLCLR(TABLE,N_Lwords,NPHASE)
	  NSTEP = 0
	  ymax = RELINT(1,1)
	  DO I=1,NPKS(1)
	    ymax = max(ymax,RELINT(I,1))
	  ENDDO
	  IF (ymax .eq. 0) THEN
	    WRITE (lo,'(A)') ' WARNING -- All peaks have zero intensity'
	    YMAX = 100.
	    CALL PS_PAUSE(PROMPT)
	  ENDIF
	  DO I=1,NPKS(1)
C reject K alpha 2 peaks from search
	    IF (Iwave(I,1) .ne. 3) then
	      numob = numob + 1
	      DS(numob) = DSPACE(I,1)
	      INTEN(numob) = 100 * RELINT(I,1)/ymax
	    ENDIF
	  ENDDO
	  CALL DSORT(ds,inten,numob)
	ENDIF
C convert the datafile name into a SEARCH NAME
	IF (npoint(1) .gt. 0) filename = cfilnam(1)
	ln = lench(filename)
	call fparse(filename(:ln),node,len_node,device,len_device,
	1	dir,len_dir,name,len_name,type,len_type,ver,len_ver)
!	filename = node(1:len_node)//device(1:len_device)//
!	1	dir(1:len_dir)//name(1:len_name)//'_SEA'
!	ln = len_node + len_device + len_dir + len_name + 4
	filename = name(1:len_name)//'_SEA'
	ln = len_name + 4

C test if the SEARCH NAME is valid
C   (preset SNAME just in case VALNAME detects an error)
	sname = 'TEMP_NAME'
	s_ln = 9
	Call valname(filename,ln,sname,s_ln,*4)
				   
	STATUS = 0
	RETURN

4	WRITE (*,'(A)') ' Unable to set the search name to: '
	1	//filename(:ln),
	1	' Search name defaulting to: '//sname(:s_ln)
	CALL PS_PAUSE(PROMPT)
	STATUS = 0
	RETURN
C------------------------------------------------------------------------
3	STATUS = 1
	RETURN
	end
