	SUBROUTINE VALNAME(filename,ln,sname,s_ln,*)
C subroutine to validate the filename FILENAME is valid for a SEARCH 
C NAME. Do this by opening and then deleting all of the possible files
C that the program might write. This will make a mess if the program
C has write but not delete access to the directory in question, but
C anyone who sets up such a brouhaha deserves it.

C use the alternate return address only if there is a unrecoverable
C problem

	CHARACTER*(*) sname,filename
	INTEGER s_ln,ln
	include '[-.shared]jcpds.parms'
	include 'SEARCH.cmn'
	include 'SEARCH.par'

!	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 Can the SEARCH RESULTS file be opened?

775	open(unit=out,file=filename(1:ln),defaultfile='.USRPDF',
	1	status='new',form='unformatted',err=701)
	close(unit=out,disp='delete')

C How about the load file?
	open(unit=out,defaultfile='.SEA_IN',file=filename(1:ln),
	1	err=701,status='new',carriagecontrol='list')
!	call fparse(filename(1:ln),node,len_node,device,len_device,
!	1	dir,len_dir,name,len_name,type,len_type,ver,len_ver)
!	lname = //name(1:len_name)//'.SEA_IN'
!	l_ln = 7 + len_name + 9
!	open(unit=out,file=lname(1:l_ln),err=701,disp='delete',
!	1	status='new',carriagecontrol='list')
	close(unit=out,disp='delete')

C no errors, set SNAME and return
	sname = filename
	s_ln = ln
	RETURN

C------------------------------------------------------------------------
701	WRITE (LO,'(a)') ' VALNAME ERROR -- Invalid SEARCH NAME: '
	1	//filename(1:ln)
	if (prompt) then
	  write (lo,776) sname(1:s_ln)
776	  format(/,'$Enter a search name (default=',A,'): ')
	  read (li,'(q,a)',end=3) ln,filename
	  if (ln .le. 0) then
	    filename = sname
	    ln = s_ln 
	  ENDIF
	  goto 775
	ELSE
3	  Write (lo,'(A)') ' SEARCH NAME remains as: '//sname(1:s_ln)
	  RETURN 1
	ENDIF
	END
