PRO FXTPIO_WRITE, UNIT, FILE, KEYWORD, ERRMSG=ERRMSG
;+
; Project     : SOHO - CDS
;
; Name        :	FXTPIO_WRITE
;
; Purpose     :	Copy FITS files from disk to tape -- internal routine.
;
; Explanation :	Procedure will copy a disk FITS file to the specified tape 
;		unit, at the current tape position.  Used for true disk FITS 
;		files, not SDAS/Geis files.  Called by FXTAPEWRITE.
;
; Use         :	FXTPIO_WRITE, UNIT, FILE
;		FXTPIO_WRITE, UNIT, FILE, KEYWORD
;
; Inputs      :	UNIT	= IDL tape unit number (scalar: 0-9).
;		FILE	= Disk FITS file name, with extension.
;
; Opt. Inputs :	KEYWORD	= Keyword to place file name into.  If not supplied or 
;			  equal to the null string '' then the file name is 
;			  not put into the header before writing it to tape.
;
; Outputs     :	None.
;
; Opt. Outputs:	None.
;
; Keywords    : ERRMSG	= If defined and passed, then any error messages will
;			  be returned to the user in this parameter rather
;			  than being handled by the IDL MESSAGE utility.  If
;			  no errors are encountered, then a null string is 
;			  returned.  In order to use this feature, the string
;			  ERRMSG must be defined first, e.g.,
;
;				ERRMSG = ''
;				FXTPIO_WRITE, 1, FILE, ERRMSG=ERRMSG
;				IF ERRMSG(0) NE '' THEN ...
;
; Calls       :	REMCHAR, FXHREAD, FXPAR, FDECOMP, FXADDPAR, FITSTAPE
;
; Common      :	None.
;
; Restrictions:	Supported under VMS and (NOW) under UNIX running IDL Versions
;		3.1 or later when the UNIX versions of TAPRD, TAPWRT, etc. are
;		included in a user library directory.
;
; Side effects:	None.
;
; Category    :	Data Handling, I/O, FITS, Generic.
;
; Prev. Hist. :	William Thompson, March 1992, from FITSWRITE by D. Lindler, W.
;						Landsman, and M. Greason.
;		William Thompson, Jan. 1993, renamed to be compatible with DOS 
;						file naming limitations.
;
; Written     :	William Thompson, GSFC, March 1992.
;
; Modified    :	Version 1, William Thompson, GSFC, 12 April 1993.
;			Incorporated into CDS library.
;		Version 2, Donald G. Luttermoser, GSFC/ARC, 14 March 1995.
;			Added ERRMSG keyword.  Updated documentation concerning
;			UNIX.
;		Version 3, Donald G. Luttermoser, GSFC/ARC, 9 May 1995.
;			Removed the "PRINT, FILE" line from this routine and
;			placed it in FXTAPEWRITE which drives this procedure.
;
; Version     :	Version 3, 9 May 1995.
;
;-
;
	ON_ERROR,2	; Return to caller if error is encountered.
	MESSAGE = ''	; Set to non-null string if error is encountered.
;
	REMCHAR, FILE, ' '
	OPENR, LUN, FILE, /BLOCK, /GET_LUN
	FXHREAD, LUN, H, STATUS		; Get FITS header
	IF STATUS LT 0 THEN BEGIN
		FREE_LUN, LUN
		MESSAGE = 'Error reading FITS header.'
		GOTO, HANDLE_ERROR
	ENDIF
;                    
;  Add file name to supplied keyword.
;
	IF N_PARAMS() LT 3 THEN KEYWORD = ''
	IF KEYWORD NE '' THEN BEGIN
		FDECOMP, FILE, DISK, DIR, NAME, EXTEN, VERS
		FXADDPAR, H, KEYWORD, NAME
	ENDIF
;
;  Write FITS header to tape.
;
	NLINES = 1			; Count of lines in header.
	WHILE STRMID(H(NLINES-1),0,8) NE 'END     ' DO NLINES=NLINES+1
	NRECS=(NLINES+35)/36		; Number of 2880 byte records required.
	NWRITE = 0
	FOR I=0,NRECS-1 DO BEGIN
		HBUF = BYTARR(2880)+32B	; Blank header
		FOR J=0,35 DO BEGIN
			LINE = I*36+J
			IF LINE LT NLINES THEN HBUF(J*80) = BYTE(H(LINE))
		ENDFOR
		STATUS = FITSTAPE('write', UNIT, 8, HBUF)
		NWRITE = NWRITE+1
		IF STATUS LT 0 THEN BEGIN
			MESSAGE = 'Error in writing FITS data to tape.'
			GOTO, HANDLE_ERROR
		ENDIF
	ENDFOR
;
;  Read and write the rest of the FITS file, until the EOF is reached.
;
	X = BYTARR(2880)
	ON_IOERROR, DONE
	WHILE NOT EOF(LUN) DO BEGIN
		READU, LUN, X
		STATUS = FITSTAPE('write', UNIT, 8, X)
		IF STATUS LT 0 THEN BEGIN
			MESSAGE,'Unexpected error',/CONTINUE
			GOTO, DONE
		ENDIF
	ENDWHILE
;
;  Close the input file.
;
DONE:
	FREE_LUN, LUN
;
;  Write two EOF marks, and position between them.
;
	STATUS = FITSTAPE('weof', UNIT)
	STATUS = FITSTAPE('weof', UNIT)
	SKIPF, UNIT, -1
;
	IF N_ELEMENTS(ERRMSG) GT 0 THEN ERRMSG = MESSAGE
	RETURN		; Return with no errors.
;
; Error handling portion of the procedure.
;
HANDLE_ERROR:
	IF N_ELEMENTS(ERRMSG) EQ 0 THEN MESSAGE, MESSAGE
	ERRMSG = MESSAGE
	RETURN
;
	END