pro writefits, filename, data, header, NaNvalue = NaNvalue, Append = Append ;+ ; NAME: ; WRITEFITS ; PURPOSE: ; Write an an IDL array into a disk FITS file. Works with all types ; of FITS files except random groups ; ; CALLING SEQUENCE: ; WRITEFITS, filename, data [, header, NaNvalue = , /APPEND] ; ; INPUTS: ; FILENAME = String containing the name of the file to be written. ; ; DATA = Image array to be written to FITS file. If DATA is ; undefined or a scalar, then only the FITS header (which ; must have NAXIS = 0) will be written to disk ; ; OPTIONAL INPUT: ; HEADER = String array containing the header for the FITS file. ; If variable HEADER is not given, the program will generate ; a minimal FITS header. ; ; OPTIONAL INPUT KEYWORD: ; NaNvalue - Value in the data array to be set to the IEEE NaN ; condition. This is the FITS representation of undefined ; values ; APPEND - If this keyword is set then the supplied header and data ; array are assumed to be an extension and are appended onto ; the end of an existing FITS file. Note that the primary ; header in the existing file must already have an EXTEND ; keyword to indicate the presence of an FITS extension. ; ; OUTPUTS: ; None ; ; RESTRICTIONS: ; (1) It recommended that BSCALE and BZERO not be used (or set equal ; to 1. and 0) with REAL*4 or REAL*8 data. ; (2) WRITEFITS will remove any group parameters from the FITS header ; ; EXAMPLE: ; Write a randomn 50 x 50 array as a FITS file creating a minimal header. ; ; IDL> im = randomn(seed, 50, 50) ;Create array ; IDL> writefits, 'test', im ;Write to a FITS file "test" ; ; PROCEDURES USED: ; CHECK_FITS, HOST_TO_IEEE, IS_IEEE_BIG(), SXDELPAR, SXADDPAR, SXPAR() ; ; MODIFICATION HISTORY: ; WRITTEN, Jim Wofford, January, 29 1989 ; MODIFIED, Wayne Landsman, added BITPIX = -32,-64 support for UNIX ; Use new BYTEODER keywords 22-Feb-92 ; Modify OPENW for V3.0.0 W. Landsman Dec 92 ; Work for "windows" R. Isaacman Jan 93 ; More checks for null data Mar 94 ; Work for Linux W. Landsman Sep 95 ; Added call to IS_IEEE_BIG() W. Landsman Apr 96 ;- On_error, 2 if N_params() LT 2 then message, /NONAME, $ 'Syntax: WRITEFITS, filename, data,[ header, NaNvalue =, /APPEND ] ; Get information about data siz = size( data ) naxis = siz(0) ;Number of dimensions if naxis GT 0 then nax = siz( 1:naxis ) ;Vector of dimensions lim = siz( naxis+2 ) ;Total number of data points type = siz(naxis + 1) ;Data type if N_elements(header) LT 2 then mkhdr, header, data $ else if naxis GT 0 then $ check_FITS, data, header, /UPDATE, /FITS hdr = header if not keyword_set( APPEND) then begin sxaddpar, hdr, 'SIMPLE', 'T', ' Written by IDL: ' + !STIME sxdelpar, hdr, [ 'GCOUNT', 'GROUPS', 'PCOUNT', 'PSIZE' ] endif ; For floating or double precision test for NaN values to write if naxis NE 0 then begin NaNtest = keyword_set(NaNvalue) and ( (type EQ 4) or (type EQ 5) ) if NaNtest then NaNpts = where( data EQ NaNvalue, N_NaN) ; If necessary, byte-swap the data. Do not destroy the original data vms = (!VERSION.OS EQ "vms") Big_endian = IS_IEEE_BIG() if (not Big_endian) then begin newdata = data host_to_ieee, newdata endif ; Write the NaN values, if necessary if NaNtest then begin if (N_NaN GT 0) then begin if type EQ 4 then data(NaNpts) = $ float( [ 127b, 255b, 255b, 255b ], 0, 1 ) $ else if type EQ 8 then data(NaNpts) = $ double( [ 127b, replicate( 255b,7)], 0 ,1) endif endif endif ; Open file and write header information if keyword_set( APPEND) then begin if (strmid( hdr(0),0,8 ) NE 'XTENSION') then begin message, $ 'ERROR - "XTENSION" must be first keyword in header extension',/CON return endif test = findfile( filename, COUNT = n) if n EQ 0 then message, $ 'ERROR - FITS file ' + filename + ' not found' hprimary = headfits( filename ) extend = where( strmid(hprimary,0,8) EQ 'EXTEND ', Nextend) openu, unit, filename, /BLOCK, /GET_LUN if Nextend EQ 0 then begin message,'EXTEND keyword not found in primary FITS header',/CON message,'Recreate primary FITS header with EXTEND keyword ' + $ 'before adding extensions', /CON return endif file = fstat(unit) nbytes = file.size point_lun, unit, nbytes npad = nbytes mod 2880 if npad NE 0 then writeu, unit, replicate(32b, 2880 - npad) endif else begin if !VERSION.OS EQ "vms" then $ openw, unit, filename, /NONE, /BLOCK, /GET_LUN, 2880 else $ openw, unit, filename, /GET_LUN endelse ; Determine if an END line occurs, and add one if necessary endline = where( strmid(hdr,0,8) EQ 'END ', Nend) if Nend EQ 0 then begin message,'WARNING - An END statement has been appended to the FITS header',/INF hdr = [ hdr, 'END' + string( replicate(32b,77) ) ] endline = N_elements(hdr) - 1 endif nmax = endline(0) + 1 ; Convert to byte and force into 80 character lines bhdr = replicate(32b, 80l*nmax) for n = 0l, endline(0) do bhdr(80*n) = byte( hdr(n) ) npad = 80l*nmax mod 2880 writeu, unit, bhdr if npad GT 0 then writeu, unit, replicate(32b, 2880 - npad) ; Write data if naxis EQ 0 then goto, DONE bitpix = sxpar( hdr, 'BITPIX' ) nbytes = N_elements( data) * (abs(bitpix) / 8 ) npad = nbytes mod 2880 if not big_endian then $ writeu, unit, newdata $ else writeu, unit, data ; ASCII Tables padded with blanks (32b) otherwise pad with zeros if keyword_set( APPEND) then begin exten = sxpar( header, 'XTENSION') if exten EQ 'TABLE ' then padnum = 32b else padnum = 0b endif else padnum = 0b if npad GT 0 then writeu, unit, replicate( padnum, 2880 - npad) DONE: free_lun, unit return end