> From:	IN%"eeliason%astrog.span@Sds.Sdsc.Edu" 19-MAY-1989 18:20 To:	TOBY@PETVAX.LRSM.UPENN.EDU1 Subj:	CDOPEN,CDREAD,CDCLOSE in file CD_ACCESS.FOR   . Return-path: eeliason%astrog.span@Sds.Sdsc.EduN Received: from Sds.Sdsc.Edu by PETVAX.LRSM.UPENN.EDU via TCP; Fri May 19 18:19  ESTH Received: from astrog.span by Sds.Sdsc.Edu with VMSmail ; Fri, 19 May 89
  22:19:44 GMT ! Date: Fri, 19 May 89 22:19:44 GMT ' From: eeliason%astrog.span@Sds.Sdsc.Edu 4 Subject: CDOPEN,CDREAD,CDCLOSE in file CD_ACCESS.FOR To: TOBY@PETVAX.LRSM.UPENN.EDU0 Message-Id: <890519221944.21c00d2f@Sds.Sdsc.Edu>2 X-ST-Vmsmail-To: SDS::"TOBY@PETVAX.LRSM.UPENN.EDU"  6 	subroutine cdopen (file_nam, chan, sblk, fsize, ierr) C K C_TITLE	CDOPEN locates the specified CDROM file and returns file parameters  C  C_ARGS4 	character*50	file_nam	!input - cdopen entry point; & C					File specification, must include$ C					file_name and ext, may include$ C					device, directory and version;( C					ddcn:[dir1.dir2...]file_name.ext;v/ 	integer*4	chan		!return - cdopen entry point;  ' C					The channel assigned to the CDROM  C					device by cdopen.   C					input - cdatt entry point;$ C					The channel assigned by cdopen( C					which must be supplied when cdatt  C					is called./ 	integer*4	sblk		!return - cdopen entry point;  $ C					The starting block of the file! C					just opened.  This value is " C					required input for calls to 
 C					cdread. 0 	integer*4	fsize		!return - cdopen entry point; $ C					The size of the file in bytes.. 	integer*4	ierr		!return - cdopen entry point; C					Error return value, $ C					0 = no error, -1 = fatal error! C					return - cdatt entry point; $ C					Same as for cdopen entry point C A C	The following arguments provide return data for the cdatt entry ? C	point only.  They are not to be included in the cdopen call.   C / 	byte		abuf(2048)	!return - cdatt entry point;  $ C					The user supplied buffer which' C					will contain the attribute record  C					on return.1 	integer*4	att_blk		!return - cdatt entry point;  ! C					The length in blocks of the  C					attribute record. - 	integer*4	stid		!return - cdatt entry point; # C					The standard ID of the format % C					in which the CDROM was written.  C					   1  -  High Sierra C					   2  -  ISO C_VARS< 	include '($syssrvnam)'		!FORTRAN system service definitions- 	include '($iodef)'		!FORTRAN I/O definitions 0 	include '($ssdef)'		!FORTRAN system definitions C G C_DESC	CDOPEN is part of a package of low level routines which give the B C	caller access to data written on a CDROM.  This package includesE C	CDOPEN, CDATT, CDREAD AND CDCLOSE.  CDOPEN must be called first to  @ C	assign a channel to the CDROM reader and to find and open the D C	requested file.  If the user desires the extended attribute recordB C	(if it exists), he must make a call to CDATT IMMEDIATELY after aE C	successful call to CDOPEN FOR THAT SAME FILE.  NOTE: CDATT is not a F C	separate subroutine but is an entry point within the CDOPEN routine.F C	Once the CDROM file is opened, CDREAD can be used to read blocks of E C	data.  CDCLOSE deassigns the channel to the CDROM reader which was  0 C	assigned by CDOPEN in effect closing the file. C A C	These routines work at the block level.  In particular, CDREAD  C C	returns in block size chunks.  It does not do any logical record  > C	handling.  The calling program must take care of any record C C	deblocking.  The routines use a standard 512 byte block.  CDOPEN  D C	converts the file starting block to this convention if the volume @ C	was written using a different block size.  The number of bytesA C	returned by cdread is 512 times the number of blocks requested.  C D C	The routines recognize and can access both the ISO and High SierraB C	CDROM formats.  This occurs automatically and is transparent to > C	to the caller.  If the CDROM was not written in a recognizedE C	format, CDOPEN will issue an error message and return to the caller 5 C	with an error condition - without opening the file.  C B C	The CDOPEN routine will use the value assigned to the PIC$CDROM C C	logical name as defaults if it is defined.  The user will want to B C	assign a value to PIC$CDROM if the cdreader device on his systemD C	is other than DUB0: or if he will be consistantly using a specificB C	directory on the CDROM disk.  Particularly if the device is not F C	DUB0:, it will be desirable to have PIC$CDROM defined in the system C C	logical name table.  Either a device, a directory or both may be  3 C	assigned to the logical name.  The DCL command is  C ) C		$DEFINE/SYS PIC$CDROM ddcu:[directory]  C  C	Examples:  C  C		$DEFINE/SYS PIC$CDROM DUA2:# C		$DEFINE PIC$CDROM DUB1:[MIRANDA] & C		$DEFINE PIC$CDROM [URANUS.C2678XXX] C B C	Before running any programs built with this subroutine, the user< C	must make the CDROM disk volume available to the system.   C . C		+ Insert the correct disk into the drive.   C 7 C		+ Issue the DCL mount command with foreign qualifier  C			i.e. $MOUNT/FOREIGN DUB0:  C E C	CDOPEN locates the file specified by the caller.  Defaults for the  D C	device and directory are taken from the user defined logical name D C	PIC$CDROM if it exists.  If not provided by PIC$CDROM, the device B C	defaults to DUB0: and the directory to the highest level (root) E C	directory.  Any user specified device or directory included in the  H C	file specification supercede the defaults.  After assigning a channel G C	to the CDROM device, the routine searches down the directory tree to  H C	the requested level and then searches for the file name.  If the file G C	is found, the assigned channel, the file starting block, the size of  F C	the file in bytes and an error value of 0 (sucessful completion) is > C	returned to the calling program.  If any error condition is F C	encountered, an appropriate message is issued and an error value of  C	-1 is returned.  C A C	CDATT is a separate entry point in the CDOPEN routine.  It uses C C	information obtained by cdopen about the file but not returned to A C	the caller.  The entry point and argument list for cdatt can be E C	found on the last page of the cdopen subroutine listing.  The data  C C	in the user supplied attribute buffer and length variable should  ? C	be valid if the error value is 0 on return.  If the extended  > C	attribute record does not exist or a read error occurs, the C C	appropriate error message is issued and an error value 	of -1 is  C C	returned.  Information on the content and format of the extended  G C	attribute record can be found in the ISO standard 9660, "Information  C C	processing - Volume and file structure of CD-ROM for information  E C	interchange" (1988) in section 9.5 starting page 23.  An identifier ? C	indicating whether the disk was written in ISO or High Sierra 1 C	format is also returned to the user from CDATT.  C ( C_CALLS	The routine calls the subroutine C 
 C		CDSTAND C C C	which determines in which standard, ISO or HIGH SIERRA, the CDROM C C	was written.  An error return indicates an unacceptable standard.  C . C	The routine calls the PICS system subroutine C  C		B2B C  C	to copy byte strings.  C 2 C	The following VMS system routines are also used: C 
 C		str$upcase 
 C		sys$assign  C		sys$qiow  C		lib$sys_trnlog  C D C_HIST	2Apr87, DMcMacken, ISD, U.S.G.S., Flagstaff, Original Version C_END O C******************************************************************************  c  c	local variables  c  	byte		ibuf(6144)	!I/O buffer " 	byte		dbuf(300)	!directory buffer. 	integer*2	log_blk_sz	!disk logical block size) 	integer*2	blk_fac		!disk blocking factor 4 	integer*4	log_blk		!disk logical block             % 	integer*4	blk_len		!no bytes to read % 	integer*2	iosb(4)		!I/O status block - 	integer*4	status		!system call return status  	character*4	dev		!device name 	integer*4	mrk		!string pointer   	integer*4	mrk2		!string pointer2 	character*50	file_up		!uppercase copy of file_nam- 	character*50	dir_str1	!subdirectory string 1 - 	character*50	dir_str2	!subdirectory string 2 & 	character*50	direc		!directory string  	character*50	file		!file string, 	integer*4	root_blk	!root directory location/ 	integer*4	dir_blk		!directory location pointer ( 	integer*4	root_len	!root directory size, 	integer*4	dir_len		!directory record length" 	integer*4	dir_sz		!directory size 	integer*2	file_flg	!file flags . 	integer*4	fid_len		!length of file identifier 	integer*4	ndx		!do loop index! 	logical		found		!file found flag 8 	integer*4	att_len		!length of extended attribute record1 	integer*4	nxt_blk		!next directory block pointer 0 	integer*2	num_sec		!number sectors in directory) 	integer*2	i_sec		!directory sector index  	integer*2	sdx		!standard index / 	integer*2	rb(2)		!root directory block indices / 	integer*2	rl(2)		!root dirctory length indices . 	integer*2	lbs(2)		!logical block size indices2 	integer*2	db(2)		!directory block pointer indices( 	integer*2	ds(2)		!dirctory size indices% 	integer*2	ff(2)		!file flags indices : 	character*50	default_str	!default device/directory string( 	character*4	default_dev	!default device, 	character*50	default_dir	!default directory+ 	integer*4	version_num	!file version number = 	logical*2	version_flag	!flag whether user input file version 5 	character*9	cdrom_log	!device/directory logical name 7 	integer*4	tst_ver		!test version number from directory 0 	integer*4	tst_len		!length of file name to test4 	logical*2	fnd_version	!found a version of file flag6 	logical*2	no_ver		!directory file name has no version. 	integer*4	sysout		!VMS sus$output unit number 	parameter	(sysout=6)  c  	data	rb /183, 159/  	data	rl /191, 167/  	data	lbs /137, 129/ 	data	db /3, 3/  	data	ds /11, 11/  	data	ff /25, 26/  	data	cdrom_log /'PIC$CDROM'/  c  c	assume no errors c 
  	ierr = 0 c ) c	determine device and directory defaults  c 5 	status = lib$sys_trnlog (cdrom_log,, default_str,,,) ! 	if (status .ne. SS$_NORMAL) then 6 c		write (sysout, 5000) status, cdrom_log, default_str  c5000	format (' status = ', i5 / c	1	' cdrom_log = ', a / c	2	' default_str = ', a)  		default_str = ' '  	endif 	mrk = index (default_str, ':')   	mrk2 = index (default_str, ']') 	if (mrk .eq. 0) then  		default_dev = 'DUB0' 	else $ 		default_dev = default_str(1:mrk-1) 	endif 	if (mrk2 .eq. 0) then 		default_dir = ' '  	else ) 		default_dir = default_str(mrk+2:mrk2-1)  	endif c  c	parse file name string c $ 	call str$upcase (file_up, file_nam) 	mrk = index (file_up, ':')  	mrk2 = index (file_up, ']') 	if (mrk .eq. 0) then  		dev = default_dev  	else  		dev = file_up(1:mrk-1) 	endif 	if (mrk2 .ne. 0) then 		direc = file_up(mrk+2:mrk2-1)  		file = file_up(mrk2+1:50) $ 		if (direc .eq. 'ROOT') direc = ' ' 	else  		direc = default_dir  		file = file_up(mrk+1:50) 	endif c - c	test whether caller provided version number  c  	mrk = index (file, ';') 	if (mrk .eq. 0) then  		version_flag = .false. 	else  		version_flag = .true.  	endif 	version_num = 0 	tst_ver = 0 c  c	search for file  c 	 	chan = 0 	 	sblk = 0 
 	fsize = 0 c  c	open channel to device c " 	status = sys$assign (dev, chan,,) 	if (.not. status) then  		write (sysout, 7000)E 7000	format (' **** CDOPEN - error assigning channel to device ****')  		ierr = -1  		return 	endif c  c	read volume descriptor block c 
 	log_blk = 64  	blk_len = 2048 5 	status = sys$qiow (, %val(chan), %val(io$_readlblk), " 	1				iosb,,, ibuf, %val(blk_len), 	2				%val(log_blk),,,) + 	if (.not. status .or. iosb(1) .lt. 0) then  		write (sysout, 7001)E 7001	format (' **** CDOPEN - error reading volume descriptor block ', 
 	1	'****') 		ierr = -1  		return 	endif c  c	determine standard c	get needed parameters  c  	call cdstand (ibuf, sdx, ierr)  	if (ierr .lt. 0) then 		write (sysout, 7005): 7005	format (' **** CDOPEN - invalid CDROM standard ****') 		return 	endif& 	call b2b (ibuf(rb(sdx)), root_blk, 4)& 	call b2b (ibuf(rl(sdx)), root_len, 4)) 	call b2b (ibuf(lbs(sdx)), log_blk_sz, 2)  c                            c	search directory tree  c	starting at root c  	blk_fac = log_blk_sz/512  	log_blk = root_blk*blk_fac  	blk_len = root_len  	mrk2 = index(direc, ' ') - 1  	if (mrk2 .le. 0) then	 		mrk = 0  		found = .true. 	else 	 		mrk = 1  	endif 	do while (mrk .ne. 0) c 3 c	determine name of directory we want on this level  c  		mrk = index (direc, '.')       		if (mrk .eq. 0) then 			dir_str1 = direc  		else 			dir_str1 = direc(1:mrk-1) 	 		direc = direc(mrk+1:50)  		endif  		nxt_blk = log_blk ! 		num_sec = (blk_len + 2047)/2048  		blk_len = 2048 		i_sec = 0  		found = .false. 1 		do while (i_sec .lt. num_sec .and. .not. found)  		i_sec = i_sec + 1  c  c	read directory block c " 		status = sys$qiow (, %val(chan)," 	1				%val(io$_readlblk), iosb,,,  	2				ibuf, %val(blk_len), 	3				%val(nxt_blk),,,) , 		if (.not. status .or. iosb(1) .lt. 0) then 			write (sysout, 7002) @ 7002	format (' **** COPEN - error reading directory block ****') 			ierr = -1	 			return  		endif  c ! c	scan directory entries on level  c  		if (i_sec .eq. 1) then 			mrk2 = ibuf(1) + 1  			mrk2 = ibuf(mrk2) + mrk2  		else 			mrk2 = 1  		endif  		dir_str2 = ' '& 	   	do while (mrk2 .lt. blk_len .and. 	1				ibuf(mrk2) .ne. 0 .and.  	2				dir_str1 .ne. dir_str2)  c   c	copy entry to directory buffer c  			dir_len = ibuf(mrk2) ' 			call b2b (ibuf(mrk2), dbuf, dir_len) ' 			call b2b (dbuf(db(sdx)), dir_blk, 4) & 			call b2b (dbuf(ds(sdx)), dir_sz, 4)( 			call b2b (dbuf(ff(sdx)), file_flg, 2) c , c	construct directory name string from entry c  			if (btest(file_flg, 1)) then  				fid_len = dbuf(33) 				dir_str2 = ' '0 				call b2b (dbuf(34), %ref(dir_str2), fid_len)	  			endif  c ! c	save pointer in case this is it  c	point to next directory entry  c  			log_blk = dir_blk*blk_fac 			mrk2 = mrk2 + dir_len 		enddo  c 4 c	set values depending on whether we found it or not c " 		if (dir_str1 .eq. dir_str2) then 			blk_len = dir_sz  			found = .true.  		else 			found = .false. 		endif  		nxt_blk = nxt_blk + 4  		enddo  		if (.not. found) mrk = 0 	enddo c   c	finished search of directories c	now get file (if possible) c  	if (found) then c  c	open bottom directory  c     	    found = .false.  	    fnd_version = .false.$ 	    num_sec = (blk_len + 2047)/2048 	    blk_len = 2048  	    i_sec = 04 	    do while (i_sec .lt. num_sec .and. .not. found) 		i_sec = i_sec + 1 6 		status = sys$qiow (, %val(chan), %val(io$_readlblk)," 	1				iosb,,, ibuf, %val(blk_len), 	2				%val(log_blk),,,) -  		if (.not. status .or. iosb(1) .lt. 0) then  			write (sysout, 7002)  			ierr = -1	 			return  		endif  c   c	search directory for file name c  		if (i_sec .eq. 1) then 			mrk2 = ibuf(1) + 1  			mrk2 = ibuf(mrk2) + mrk2  		else 			mrk2 = 1  		endif  		dir_str2 = ' '& 	   	do while (mrk2 .lt. blk_len .and. 	1				ibuf(mrk2) .ne. 0 .and.  	2				.not. found) c " c	copy entry into directory buffer c  			dir_len = ibuf(mrk2) ' 			call b2b (ibuf(mrk2), dbuf, dir_len) ' 			call b2b (dbuf(db(sdx)), dir_blk, 4) & 			call b2b (dbuf(ds(sdx)), dir_sz, 4)( 			call b2b (dbuf(ff(sdx)), file_flg, 2) c ' c	construct file name string from entry  c  			fid_len = dbuf(33)  			dir_str2 = ' ' / 			call b2b (dbuf(34), %ref(dir_str2), fid_len)  c 4 c	separate file name and version number if necessary c  			if (version_flag) then  				tst_len = 50 			else ' 				tst_len = index (dir_str2, ';') - 1  				if (tst_len .le. 0) then 					tst_len = 50  					no_ver = .true. 				else 					no_ver = .false. $ 					mrk = index (dir_str2, ' ') - 1 					if (mrk .lt. 0) mrk = 50 & 					read (dir_str2((tst_len+2):mrk),  	1				    6000) tst_ver  6000	format (i3)	 				endif  			endif c  c	point to next directory entry  c  			mrk2 = mrk2 + dir_len c   c	set flags and/or return values c ) 			if (file .eq. dir_str2(:tst_len)) then % 				if (version_flag .or. no_ver .or. ' 	1			    tst_ver .gt. version_num) then  					att_len = dbuf(2) 					sblk = blk_fac *  	1					(dir_blk + att_len) 			     		fsize = dir_sz 					if (version_flag) then  				     	    found = .true.	 					else  					    fnd_version = .true. 
 					endif	 				endif  			endif 		enddo  		log_blk = log_blk + 4 
 	    enddo 	else % 	    tst_len = index (direc, ' ') - 1.% 	    if (tst_len .lt. 0) tst_len = 50o 		if (tst_len .gt. 0) then/ 		    write (sysout, 7003) dev, direc(:tst_len)O7 7003	format (' **** CDOPEN - directory not found ****'/e 	1	x, a, ':[', a, ']') 		else 		    write (sysout, 7008) dev7 7008	format (' **** CDOPEN - directory not found ****'/E 	1	x, a, ':[ROOT]'), 		endif9 	    ierr = -1 	endif c,# c	tell user that file was not founds ca  	if (fnd_version) found = .true. 	if (.not. found) then" 		tst_len = index (direc, ' ') - 1" 		if (tst_len .lt. 0) tst_len = 50 		    if (tst_len .gt. 0) then2 			write (sysout, 7006) dev, direc(:tst_len), file3 7006	format (' **** CDOPEN - file not found ****'/ r 	1	 x, a, ':[', a, ']', a)
 		    else! 			write (sysout, 7009) dev, filer3 7009	format (' **** CDOPEN - file not found ****'/   	1	 x, a, ':[ROOT]', a)	 		    endifi 		ierr = -1i 	endif c	 c	go back to callerm ci 	return	 c	+ c	entry to obtain extended attribute recordi cd. 	entry cdatt (chan, abuf, att_blk, stid, ierr) cc	 	ierr = 0  	if (att_len .eq. 0) then  		write (sysout, 7007)E 7007	format (' **** CDOPEN - there is no extended attribute record ',h
 	1	'****') 		ierr = -1  		return 	endif 	log_blk = blk_fac*dir_blk 	blk_len = 512*blk_fac*att_len 	att_blk = att_len 	stid = sdx	5 	status = sys$qiow (, %val(chan), %val(io$_readlblk),   	1		iosb,,, abuf, %val(blk_len), 	2		%val(log_blk),,,)	+ 	if (.not. status .or. iosb(1) .lt. 0) thene 		write (sysout, 7004)@ 7004	format (' **** CDOPEN - error reading extended attribute ', 	1	'record ****')o 		ierr = -1e 	endif c  	returnr c1 	end% 	subroutine cdstand (ibuf, sdx, ierr)i4 C_TITLE	CDSTAND determines the CDROM format standard C_ARGS2 	byte		ibuf(6144)	!input, volume descriptor buffer' 	integer*2	sdx		!return, standard indexd% 	integer*4	ierr		!return, error valueu C_VARS	nonerB C_DESC	This routine determines whether the cdrom being accessed is< C	in ISO or High Sierra format.  If the routine is unable to= C	determine the standard, a negative error value is returned.i@ C_HIST	3Aug88, DMcMacken, ISD, USGS, Flagstaff, Original Version C_ENDaO C******************************************************************************w cw c	local variables1 c 0 	logical*2	isoflg		!flag indicating ISO standard- 	logical*2	hisflg		!High Sierra standard flagt+ 	integer*2	ndx		!character counter for loopi( 	byte		isostd(5)	!ISO identifying string0 	byte		hisstd(5)	!High Sierra identifying string ce& 	data	isostd /'C', 'D', '0', '0', '1'/& 	data	hisstd /'C', 'D', 'R', 'O', 'M'/ c  c	assume there will be no error  cT	 	ierr = 0N cD c	determine the standard c  	isoflg = .true. 	hisflg = .false.  	ndx = 1# 	do while (isoflg .and. ndx .le. 5)s6 		if (ibuf(ndx + 1) .ne. isostd(ndx)) isoflg = .false. 		ndx = ndx + 1i 	enddo cs c	if not ISO try High Sierra cY 	if (.not. isoflg) thenl 		hisflg = .true.T	 		ndx = 1 $ 		do while (hisflg .and. ndx .le. 5)7 			if (ibuf(ndx + 9) .ne. hisstd(ndx)) hisflg = .false.  			ndx = ndx + 1 		enddoe 	endif c  c	set standard index cs 	if (isoflg) thenO	 		sdx = 2s 	else if (hisflg) then	 		sdx = 1i 	else 	 		sdx = 0d 		ierr = -1  	endif ci 	returnl 	end7 	subroutine cdread (chan, sblk, vblk, nblk, ibuf, ierr)r CDB C_TITLE	CDREAD reads nblk's from vblk of CDROM file open by CDOPEN Co C_ARGS2 	integer*4	chan		!input - channel number of device0 	integer*4	sblk		!input - starting block of file5 	integer*4	vblk		!input - requested virtual block no.i6 	integer*4	nblk		!input - number of blocks to transfer8 	byte		ibuf(4096)	!return - data in user supplied buffer' 	integer*4	ierr		!return - error returno" C					0 = successful, -1 = failure Cs C_VARS; 	include '($syssrvnam)'		!FORTRAN system service defintionst- 	include '($iodef)'		!FORTRAN I/O definitionst C F C_DESC	This routine calls a VMS system service to read  logical blocks@ C	from a CDROM file.  The file must first have been opened by a @ C	call to CDOPEN to assign the channel (chan) and to provide the> C	starting block (sblk) of the file.  The user must supply theE C	virtual block number (vblk - sequential block number from beginnings? C	of file) and the number of blocks (nblk - 512 byte blocks) to	B C	read.  The user must also supply a buffer (ibuf) large enough toB C	hold the blocks requested.  If the read is successful a value of> C	zero (0) is returned in the variable ierr; otherwise a -1 is C	returned.i C C C_HIST	6Apr87, DMcMacken, ISD, U.S.G.S., Flagstaff, Original Versond C  C_ENDiO C******************************************************************************  c	 c	local variables$ cI* 	integer*4	log_blk		!logical block to read, 	integer*4	blk_len		!number of bytes to read- 	integer*4	status		!system call return statusu% 	integer*2	iosb(4)		!I/O status blocku/ 	integer*4	sysout		!VMS sys$output logical units 	parameter	(sysout=6)  c  c	assume no errors cr	 	ierr = 0  c+ c	compute QIO parameters cw 	log_blk = sblk + vblk - 1     	blk_len = 512*nblk  c  c	get block for caller c = 	status = sys$qiow (, %val(chan), %val(io$_readlblk), iosb,,,c* 	1		ibuf, %val(blk_len), %val(log_blk),,,)+ 	if (.not. status .or. iosb(1) .lt. 0) thenv 		write (sysout, 7000)7 7000	format (' **** CDREAD - error reading CDROM ****')e 		ierr = -1t 	endif ct 	return  	end  	subroutine cdclose (chan, ierr) C ? C_TITLE	CDCLOSE closes (deassigns) the channel opened by CDOPENi Cn C_ARGn3 	integer*4	chan		!input, channel assigned by CDOPENn& 	integer*4	ierr		!return, error return& C					0 = successful, -1 = fatal error C_VARS< 	include '($syssrvnam)'		!FORTRAN system service definitionsF C_DESC	This routine calls a VMS system routine to deassign the channelC C	speccified by the caller.  This is equivalent to closing the filer% C	associated with the channel "chan."r CiD C_HIST	6Apr87, DMcMacken, ISD, U.S.G.S., Flagstaff, Original Version C_END O C******************************************************************************d c  c	local variablesl cu0 	integer*4	status		!system service return status. 	integer*4	sysout		!VMS sys$output unit number 	parameter	(sysout=6)d cn	 	ierr = 0 ! 	status = sys$dassgn (%val(chan))  	if (.not. status) then  		write (sysout, 7000)> 7000	format (' **** CDCLOSE - error deassigning channel ****') 		ierr = -1r 	endif cd 	return  	end