subr excwrite,x,h
;a special version to write compressed data to exabyte tapes
;the compression scheme is the same as used in fcwrite
if symclass(x) ne 4 then { type,'ERROR - EXCWRITE only accepts arrays'  return}
;if symbol for tape unit is undefined, prompt user for it
if defined($itdout) eq 0 then read,'enter tape unit (probably 0)',$itdout
;if an f0 header was read in add sync word, dimensions, unpacked flag, comments
	bh=zero(bytarr(1024))
	if !narg ge 2 then bh(256)=bmap(h)
	bh(0)=byte([170,170,85,85])
        bh(7)=byte(symdtype(x))		; Fixed for UNIX   LS 21jul92
	bh(4)=1		;this indicates data compression, mode 1
	iq=byte(num_dim(x))
	bh(8)=iq
	for i=0,iq-1 do bh(i*4+192)=reverse(bmap(dimen(x,i)))
if symclass(x) ne 4 and (symdtype(x) ne 1 or symdtype(x) ne 0) then {
 t,'EXCWRITE only supports I*2 or I*1 arrays !!' return }
y=bytarr(num_elem(x))
crunch,x,!crunch_slice,y
n=lmapr(y(0:3))		n=n+n%2		;make even for RMS (would be padded)
bh(10)=reverse(bmap(n)
save=!redim_warn_flag
!redim_warn_flag=0	;just to keep the noise down
redim,y,n
!redim_warn_flag=save	;restore to previous value
wait_for_tape,$itdout		;just in case
tapwrt,$itdout,bh	;write the header record on tape unit $itdout
tapebufout,$itdout,y
;note - tapebufout and tapebufin set up a chain of record writes/reads
;until the data in the array r is done, the logical record size to use (or
;assume) is the third argument
;tapebufout can be replaced by a series of tapwrt's
wait_for_tape,$itdout		;remove this for simultaneous ops, but you must
				;check before changing r or writing again
y=0	;save the memory
endsubr