PRO Rdfits, image, file, log=log, header=header, nosign=nosign, swap=swap, $ exab=exab, skip=skip, rewind=rew, stream=stream, keep=keep, $ remote=rem, bs=bs, dir_w=rd_dir, noread=noread, n_retry=n_retry, $ nofilemarks=nofilemarks, hd_blocks=hd_blocks, sync=sync ;+ ; NAME: ; RDFITS ; PURPOSE: ; Read a simple FITS-Formated File into an IDL-Array. Size and ; scaling of the image are automatically recognized and set by the ; information of the header. ; CATEGORY: ; Image transfer ; CALLING SEQUENCE: ; RDFITS,IMAGE,FILE,[KEYWORDS] ; INPUTS: ; IMAGE : Name of array to read file into ; OPTIONAL INPUT PARAMETER: ; FILE : String containing the filename of the FITS-File to ; be read. If omitted, either exab or streamer must ; be set. ; KEYWORDS: ; LOG : (Flag/input) if set, the header information is copied to ; stdout. If LOG is a string, the header gets written to ; a file with that name. Existing files get appended. ; HEADER: (output) in this stringarray the header is passed back ; to the caller ; SWAP : (Flag) byte-swap the low/high byte of each integer ; NOSIGN: (Flag) Data is unsigned integer ; EXAB : (input) Read file from Exabyte number EXAB. It is ; checked, if such an device exists on the desired host. ; STREAM: (Flag) Read file from an quarter inch tape ; ; The following keywords are only recognized, if either EXAB or ; STREAM is set ; ; NOFILEMARKS: (Flag) Files on tape are written without separating ; filemarks. RDFITS then calls another routine (RD_TAPE) ; for transfering the data to disk. Caution: Keyword ; SKIP changes units from files to records!!!! ; ; HD_BLOCKS: (input) Only for reading tapes w/o filemarks. This is ; the number of tape blocks needed for the complete fits ; header. Normally, one block is enough, so you don't ; need to set this keyword. If however you happen to ; have a small blocking factor on tape and a very large ; FITS header, you may have to set this. Example: ; Header contains 100 Lines (each of which has 80 Char ; by default). If you are using a blocking factor of ; 2880, you will need (100*80)/2880=2.77 blocks, so set ; HD_BLOCKS to 3. For a blocking size of 4096 (the ; default) you would need a value of two, whereas with a ; size of 16k (=16384) the whole header fits into one ; block, so HD_BLOCKS needn't be set. ; ; SYNC: (Flag) when reading files w/o filemarks from tape, try ; to sync to a real FITS header start by scanning for ; the 'SIMPLE' entry. This is experimental and may fail. ; ; REMOTE: (input) String containing the name of the host, where ; the Exabyte/Streamer-Tape is located Exabytes are ; available on Venus(1/2), Mars(1), Dewey(0), Louie(1); ; Streamer Tapes on Venus and Mars. ; ; REWIND: (Flag) Rewind the tape before reading a file. ; ; SKIP : (input) skip SKIP files (or RECORDS, if NOFILEMARKS is ; set) before reading a file. May be positive or negative. ; ; BS : (input) Blocking size for the tape. DEFAULT: 4096 ; ; KEEP : (Flag/input) By default, the disk-file is removed ; after reading the image. If KEEP is set and is a string ; it is used to rename the file and keep it on disk. If ; KEEP is not a string, the header is searched for a ; FILENAME-statement, and that name is used. If no name ; is found, you are prompted to type in a name. ; ; DIR_W : (input) Name of the directory to write the temporary ; file to. This is usefull, if the local machine, the ; exabyte-host and the server are physically different ; machines. Using a local directory that is located on ; the exabyte-host will minimize the network use to ; transfer data. ; ; OUTPUTS: ; IMAGE : The read-in data ; SIDE EFFECTS: ; contens and size of image (if defined) is altered ; RESTRICTIONS: ; Only works with Basic FITS files, i.e. the *first line* of the ; header must contain the statement ; SIMPLE = T ; ; PROCEDURE: ; The header is read line-by-line until the END-Statement is ; found. Size and scaling factor of the image are extracted. ; When reading from tape (EXAB or STREAM), the file is copied to ; the disk (filename tmp.fits) and removed after reading the image. ; MODIFICATION HISTORY: ; 05-04-1991 PS ; 06-03-1992 PS allow for different blocking sizes (BS) ; 12-10-1992 PS The '92 version of the AT1-Software writes some ; zeroes into the FITS-header, which caused some ; difficulties with the byte-to-string conversion. ; The 0's are replaced by 32 (ASCII for ' ') ; 15-10-1992 PS Implement the possibility of reading also ; bytearrays. For this, the BITPIX header card must ; be set to `8'. ; 27-04-1994 PS Uncompress zipped files on the fly ; 17-07-1995 PS Add some decent error checking for empty files ; when reading from exabyte (e.g. double ; filemarks -> empty file), new keyword n_retry ; 22-08-1995 PS New keyword NOFILEMARKS for reading tapefiles ; written without separating filemarks. Also ; added keyword hd_blocks, which is only needed ; for reading tapes w/o filemarks. ; 06-08-1998 PS if a file is not found, look also for file.gz ; 07-01-1999 PS Byteswap was wrong for 32bit data ;--- on_error, 2 hdr = bytarr(80) count = 0 zipped = 0 retries = 0 cd, '.', current = work_dir IF NOT keyword_set(n_retry) THEN n_retry = 0 IF NOT keyword_set(rd_dir) THEN $ rd_dir = work_dir $ ELSE BEGIN l = strlen(rd_dir) IF strmid(rd_dir, l-1, 1) EQ '/' THEN rd_dir = strmid(rd_dir, 0, l-1) ENDELSE rdfile = rd_dir+'/tmp.fits' IF n_params() EQ 2 THEN BEGIN files = findfile(file) sf = size(files) IF sf(0) EQ 0 THEN BEGIN ;;; see if it is compressed: try with extension files = findfile(file+'.gz') sf = size(files) IF sf(0) EQ 0 THEN message, "File doesn't exist !!" ENDIF IF sf(1) GT 1 THEN BEGIN message, 'Ambiguous filename. Possible Expansions are :', /cont print, files return ENDIF IF ((strpos(files, '.gz'))(0) GE 0) OR ((strpos(files, '.Z'))(0) GE 0) THEN $ BEGIN origfile = file file = nnumber(abs(fix(1e5*randomn(undef))), 5) file = '/tmp/tmp'+file+'.fits' spawn, 'cat '+files +' | gunzip > '+file zipped = 1 ENDIF ENDIF IF keyword_set(rem) THEN BEGIN CASE strupcase(rem) OF 'MARS' : cmd0 = 'rsh mars ' 'VENUS': cmd0 = 'rsh venus ' 'DEWEY': cmd0 = 'rsh dewey ' 'DAISY': cmd0 = 'rsh daisy ' 'LOUIE': cmd0 = 'rsh louie ' ELSE : BEGIN message, 'unknown host : '+rem+' trying local machine', $ /continue cmd0 = '' END ENDCASE ENDIF ELSE cmd0 = '' ;----- ; Lesen vom Band... ;----- s_exab = size(exab) & s_exab = s_exab(s_exab(0)+1) IF keyword_set(nofilemarks) THEN BEGIN file = rdfile rd_tape, file, exab=exab, bs=bs, rew=rew, skip=skip, $ remote=rem, hd_blocks=hd_blocks, dir_w=rd_dir, sync=sync GOTO, ondisk ENDIF IF s_exab NE 0 OR keyword_set(stream) THEN BEGIN IF NOT keyword_set(bs) THEN bs = '4k' IF s_exab NE 0 THEN BEGIN ;; IF exab GT 2 THEN message, 'Only Exabyte devices 1 and 2 possible' IF strmid(strtrim(exab, 2), 0, 1) EQ '/' THEN $ dev = exab $ ELSE $ dev = '/dev/nrst'+strtrim(fix(exab), 1) ENDIF ELSE $ dev = '/dev/nrst8' ; ; existiert das gesuchte Geraet, falls kein remote verlangt ist? ; ;; if cmd0 eq '' then begin ;; on_ioerror,fehler ;; openr,u1,dev,/get_lun ;; free_lun,u1 ;; on_ioerror,null ;; goto,ok fehler: ;; on_ioerror,null ;; message,'No such tape device on this host !!' ;; endif ok: ;----- ; Zurueckspulen? ;----- IF keyword_set(rew) THEN BEGIN writeu, -1, 'Rewinding Tape...' spawn, cmd0+'mt -f '+dev+' rew' print, ' ok' ENDIF ;----- ; Files ueberspringen? ;----- IF keyword_set(skip) THEN BEGIN IF skip GE 1 THEN BEGIN IF skip EQ 1 THEN $ writeu, -1, 'skipping forward 1 File...' $ ELSE $ writeu, -1, 'skipping forward '+strtrim(skip, 1)+' Files...' spawn, cmd0+'mt -f '+dev+' fsf '+strtrim(skip, 1) ENDIF ELSE BEGIN IF skip EQ -1 THEN $ writeu, -1, 'skipping backward 1 File...'$ ELSE $ writeu, -1, 'skipping backward '+strtrim(-skip, 1)+' Files...' spawn, cmd0+'mt -f '+dev+' nbsf '+strtrim(-skip, 1) ENDELSE print, ' ok' ENDIF ;----- ; Lesen von Exabyte mittels dd, speichern auf Platte ;----- Retry: cmd = cmd0+'dd if='+dev+' of='+rdfile+' bs='+strtrim(bs, 2) print, 'Stand by, loading from Tape.....' spawn, cmd file = rdfile ENDIF Ondisk: openr, unit, file, /get_lun IF (eof(unit) AND s_exab NE 0) THEN BEGIN free_lun, unit retries = retries+1 IF retries GE n_retry THEN message, 'End of file...' message, 'Found empty input file, retrying', /info GOTO, retry ENDIF IF keyword_set(log) THEN BEGIN s_log = size(log) IF s_log(s_log(0)+1) EQ 7 THEN $ openw, logunit, log, /append, /get $ ELSE $ logunit=-1 ENDIF sx = 1 & sy = 1 & sz = 1 header = bytarr(80*200) REPEAT BEGIN readu, unit, hdr header(80*count:80*count+79) = hdr count = count+1 hd1 = string(hdr(0:77)) IF keyword_set(log) THEN printf, logunit, hd1 CASE strmid(hd1, 0, 6) OF 'BITPIX' : BEGIN i = fix(strmid(hd1, 10, 21)) CASE i OF 8 : refpix = 8b 16 : refpix = fix(16) 32 : refpix = long(32) ELSE : message, 'No support for '+strtrim(i, 2)+ $ ' bytes per pixel' ENDCASE END 'NAXIS ' : npic = fix(strmid(hd1, 10, 21)) 'NAXIS1' : sx = fix(strmid(hd1, 10, 21)) 'NAXIS2' : sy = fix(strmid(hd1, 10, 21)) 'NAXIS3' : sz = fix(strmid(hd1, 10, 21)) 'BSCALE' : bsc = float(strmid(hd1, 10, 21)) 'BZERO ' : bze = float(strmid(hd1, 10, 21)) ELSE : ENDCASE ENDREP UNTIL strpos(hd1, 'END ') EQ 0 IF keyword_set(log) THEN IF logunit GT 0 THEN free_lun, logunit CASE npic OF 1 : image = replicate(refpix, sx) 2 : image = replicate(refpix, sx, sy) 3 : image = replicate(refpix, sx, sy, sz) ELSE: ENDCASE ;----- ; Read until end of block ;----- nhead = count*80 header = header(0:nhead-1) ix = where(header EQ 0, nix) IF nix GT 0 THEN header(ix) = 32 tmp = string(header) header = strarr(count) FOR i = 0, count-1 DO header(i) = strmid(tmp, 80*i, 80) iblocks = fix(nhead/2880.)+1 dif = fix(2880.*iblocks-nhead) tmp = bytarr(dif) readu, unit, tmp ;----- ; read Image ;----- IF NOT keyword_set(noread) THEN readu, unit, image free_lun, unit ;----- ; delete file, if temporarily uncompressed ;----- IF zipped THEN BEGIN spawn, 'rm '+file file = origfile ENDIF ;----- ; Temporaeres File (bei lesen von Exabyte) loeschen ;----- IF (size(exab))(1) NE 0 OR keyword_set(stream) THEN BEGIN IF keyword_set(keep) THEN BEGIN s_k = size(keep) IF s_k(s_k(0)+1) EQ 7 THEN $ ;keep ist string filename = work_dir+'/'+keep $ ELSE BEGIN ;;; filename im Header? pos_file = strpos(header, 'FILENAME') filename = '' IF max(pos_file) GE 0 THEN BEGIN ipos = (where(pos_file GE 0))(0) filename = dos_name(strmid(header(ipos), $ pos_file(ipos)+9, 24)) ENDIF ELSE BEGIN print, 'Please enter Name for diskfile:' read, filename ENDELSE ENDELSE IF strlen((findfile(filename))(0)) NE 0 THEN BEGIN message, 'Given filename allready exists. Moving to ' + $ ''+filename+'~', /cont spawn, 'mv '+filename+' '+filename+'~' ENDIF message, 'Keeping as '+filename, /cont spawn, 'mv '+rdfile+' '+filename ENDIF ELSE $ spawn, 'rm '+rdfile ENDIF ;----- ; Vertauschen von High- und Lowbyte? ;----- IF keyword_set(swap) THEN BEGIN CASE refpix OF 8: 16: byteorder, image, /sswap 32: byteorder, image, /lswap ENDCASE ENDIF ;----- ; Daten als vorzeichenlose Integer? ;----- IF keyword_set(nosign) THEN BEGIN image = long(image) image = image+32768 ENDIF ;----- ; scaling of the pixels? ;----- IF keyword_set(bsc) THEN IF bsc NE 1 THEN $ image=image*bsc IF keyword_set(bze) THEN IF bze NE 0 THEN $ image = image+bze ;----- ; Extension? ;----- ;nbyt=long(sx*sy*sz*2) ;iblocks=fix(nbyt/2880.)+1 ;dif=fix(2880.*iblocks-nbyt) ;tmp=bytarr(dif) ;readu,unit,tmp ;while not EOF(1) do begin END