C******************************************************************************
C******************************************************************************
	Subroutine fparse(file,node,len_node,device,len_device,dir,len_dir,
	1	name,len_name,type,len_type,ver,len_ver)
C******************************************************************************
C Subroutine to parse a file name. The file name is returned as six fields
C which can be handled individually. To reconstruct the original name use:
C	file = node(1:len_node)//device(1:len_device)//dir(1:len_dir)//
C	1	name(1:len_name)//type(1:len_type)//ver(1:len_ver)
C Any field in the filename which is not specified will be returned as a 
C null string. 
C						B. H. Toby  10/87
C******************************************************************************
C******************************************************************************
	character*(*) file 
	character*(*) node,device,dir,name,type,ver
	integer*2 len_node,len_device,len_dir,len_name,len_type,len_ver
	include '($fscndef)'
	logical*4 sys$filescan,flag
	structure /string/
	  integer*4 strlen
	  integer*4 stradr
	end structure
	record /string/ xform
	structure /ugh/
	  integer*2 strlen
	  integer*2 code
	  integer*4 stradr
	end structure
	record /ugh/ parm(7)

	parm(1).code = fscn$_node
	parm(2).code = fscn$_device
	parm(3).code = fscn$_directory
	parm(4).code = fscn$_name
	parm(5).code = fscn$_type
	parm(6).code = fscn$_version
	parm(7).code = 0
	parm(7).strlen = 0
	parm(7).stradr = 0
	
	flag = sys$filescan(file,parm,)
	if (.not. flag) call lib$signal(%val(flag))

	xform.stradr = parm(1).stradr
	xform.strlen = parm(1).strlen
	len_node = xform.strlen
	call str_move(xform,node)

	xform.stradr = parm(2).stradr
	xform.strlen = parm(2).strlen
	len_device = xform.strlen
	call str_move(xform,device)

	xform.stradr = parm(3).stradr
	xform.strlen = parm(3).strlen
	len_dir = xform.strlen
	call str_move(xform,dir)

	xform.stradr = parm(4).stradr
	xform.strlen = parm(4).strlen
	len_name = xform.strlen
	call str_move(xform,name)

	xform.stradr = parm(5).stradr
	xform.strlen = parm(5).strlen
	len_type = xform.strlen
	call str_move(xform,type)

	xform.stradr = parm(6).stradr
	xform.strlen = parm(6).strlen
	len_ver = xform.strlen
	call str_move(xform,ver)
	return
	end
C----------------------------------------------------------------------
	subroutine str_move(char1,char2)
	character*(*) char1,char2
	char2 = char1
	return
	end
C******************************************************************************
C******************************************************************************
	Subroutine REMEXT(file)
C******************************************************************************
C Remove a file extension and version number from FILE
C						B. H. Toby  5/91
	character*(*) file 
C******************************************************************************
	character*40 node,device,dir,name
	character*5 type,ver
	integer*2 len_node,len_device,len_dir,len_name,len_type,len_ver
C----------------------------------------------------------------------
	call fparse(file,node,len_node,device,len_device,dir,len_dir,
	1	name,len_name,type,len_type,ver,len_ver)
	file = node(:len_node)//device(:len_device)//dir(:len_dir)//
	1	name(:len_name)
	RETURN
	END
