Viewing contents of file '../idllib/iuedac/iuelib/pro/filecopy.pro'
;******************************************************************************
;+
;*NAME:
;
; FILECOPY (General IDL Library 01) 22-FEB-81
;
;*CLASS:
;
; i/o
;
;*CATEGORY:
;
;*PURPOSE:
;
; On VMS system: to copy one file from an input tape to an output tape
;
;*CALLING SEQUENCE:
;
; FILECOPY,IN,BUFSIZE,NTRIES,OUT
;
;*PARAMETERS:
;
; IN (REQ) (I) (0) (I)
; Input unit number
;
; BUFSIZE (REQ) (I) (0) (I)
; Maximum record length in bytes on tape file
; (This value may be larger than the actual length)
;
; NTRIES (REQ) (I) (0) (I)
; Number of retries in the case of a tape read error
;
; OUT (REQ) (I) (0) (I)
; Output tape unit number
;
;*EXAMPLES:
;
; FILECOPY,0,50,3,1
; Where: 1=output unit
; 3=how many times to try the copy
; 50=an over-estimate of the record length(in bytes on tape file)
; 0=input unit
;
;*SYSTEM VARIABLES USED:
;
; !err
; !err_string
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
; PARCHECK
; TINIT
; PLATFORM
;
;*FILES USED:
;
; The file corresponding to unit IN is copied directly to the
; output tape.
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
; VMS systems only
;
; Device Dependent - Two tape drives must be available, allocated,
; and tapes mounted on both drives.
; This procedure is not suitable for batch operation,
; or for use by remote users.
;
;*NOTES:
;
; The output tape is positioned at a double EOF prior to copy. (An
; empty tape should begin with an EOF.) The output tape is left between
; a double EOF after the copied file.
; The input tape should be at the beginning of the file to be copied, and
; will be left after the EOF defining the file.
;
; Must have mounted two tapes:
; MOUNT,n or SPAWN,'MOUNT MTn:/FOR
; Tape drives must be mounted before entering IDL Version 2.
;
; tested with IDL Version 2.1.2 (sunos sparc) not used on
; tested with IDL Version 2.1.2 (ultrix mispel) not used on
; tested with IDL Version 2.1.2 (vms vax) 5 Nov 91
;
;*PROCEDURE:
;
; Uses TINIT to position output tape between double end-of-files.
; FILECOPY then copies the input file directly to the output
; tape, and will retry as many times as specified by NTRIES. (If
; no tries are successful, FILECOPY will print an appropriate message to
; the terminal, and rewind the output tape to the original EOF's.
; After each unsuccessful try, the output tape is repositioned between
; the original EOF's.)
; Upon successful completion of the copy, FILECOPY prints a message to the
; terminal, indicating the number of records copied.
; Finally, the output tape is positioned between EOF marks, and the
; input tape will be left at the end of the copied file.
;
;*MODIFICATION HISTORY:
;
; Feb 22 1981 FHS3 GSFC initial program
; May 5 1987 RWT GSFC VAX Mods: use ON_IOERROR for handling tape
; errors and end-of-files, and add PARCHECK
; Jun 18 1987 RWT GSFC use TINIT for positioning output tape.
; May 8 1991 PJL GSFC modified for IDL Version 2 including
; modifying use of !ERR
; Jun 20 1991 PJL GSFC cleaned up; updated prolog
; Aug 19 1991 GRA CASA cleaned up; tested on VAX (9-track Q-bus)
; Sep 11 1991 GRA CASA set on_ioerror to null in the event of
; error writing to output tape; tested on
; VAX; updated prolog.
; Sep 16 1991 PJL GSFC corrected typo in prolog
; Nov 4 1991 GRA CASA defined sys = !version.os for system
; dependent branching.
; 13 Jun 94 PJL replaced !version with PLATFORM
;
;-
;******************************************************************************
pro filecopy,in,bufsize,ntries,out
;
npar = n_params(0)
if (npar eq 0) then begin
print,'FILECOPY,IN,BUFSIZE,NTRIES,OUT'
retall
endif ; npar eq 0
parcheck,npar,4,'FILECOPY'
;
;;; sys = !version.os
platform,dummy,tapectrl=tapectrl
;
;;; if sys ne 'vms' then begin
if (tapectrl.device ne '') then begin
print,'This procedure is for VMS systems only'
return
;;; endif ; sys
endif ; tapectrl.device ne ''
;
a = bytarr(bufsize)
nrec = 0 ; file size
;
; position output tape at double eof
;
tinit,out
;
; copy file
;
while nrec ge 0 do begin ; copying each record
on_ioerror, try2 ; go to try2 if error occurs
taprd,a,in ; get data
error = !err
if error gt 0 then goto, goon2
redo2:
on_ioerror, null ; cancel io error
on_ioerror, try3 ; go to try3 if error
nerr = 0 < ntries ; number of erroneous retries
redo3:
while nerr lt ntries do begin ; retry errors
skipf,in,-1,1
taprd,a,in
error = !err
if error gt 0 then nerr=ntries+1 ; success
endwhile ; retries
on_ioerror,null ; cancel io error
if nerr le ntries then begin ; fatal error
print,'Fatal error - copy aborted'
skipf,in,1 ; position input after file
if nrec gt 0 then skipf,out,-nrec,1 ; erase output data
nrec=-1 ; termination flag
error = -1 ; with an error condition
endif ; fatal error
;
goon2:
on_ioerror,null ; cancel io error
on_ioerror, try4
error = !err
if error gt 0 then begin ; valid data record
b = a(0:error-1) ; get data
tapwrt,b,out
nrec=nrec+1 ; count records copied
endif ; copy valid data
error = !err
if error eq -4 then begin ; eof = finished copy
weof,out
print,nrec,' Records copied'
nrec=-1 ; termination flag
endif ; end-of-file
endwhile ; copy data records
;
; file copy complete, clean up output tape
;
weof,out ; make double eof
skipf,out,-1 ; position between eofs
on_ioerror, null ; turn-off error branching
return ; copy complete
;
; tape io errors
;
try2:
error = !err
if error eq -4 then goto, goon2 else begin
print,'Error reading input tape'
print,'Record ',nrec,' has error ',!err_string
goto, redo2
endelse ; error
try3:
nerr = nerr +1 ; error again
goto, redo3
try4:
print,'Error writing to output tape'
print,!err_string
print,'Aborting filecopy'
on_ioerror,null
retall
end ; filecopy