| 1 |
pro MODFITS, filename, data, header, EXTEN_NO = exten_no, ERRMSG = errmsg, $ |
| 2 |
EXTNAME = extname |
| 3 |
|
| 4 |
;+ |
| 5 |
; NAME: |
| 6 |
; MODFITS |
| 7 |
; PURPOSE: |
| 8 |
; Modify a FITS file by updating the header and/or data array. |
| 9 |
; EXPLANATION: |
| 10 |
; The size of the supplied FITS header or data array |
| 11 |
; does not need to match the size of the existing header or data array. |
| 12 |
; ***NOTE** This version of MODFITS must be used with a post Sep 2006 |
| 13 |
; version of FITS_OPEN. |
| 14 |
; |
| 15 |
; CALLING SEQUENCE: |
| 16 |
; MODFITS, Filename_or_fcb, Data, [ Header, EXTEN_NO =, EXTNAME= , ERRMSG=] |
| 17 |
; |
| 18 |
; INPUTS: |
| 19 |
; FILENAME/FCB = Scalar string containing either the name of the FITS file |
| 20 |
; to be modified, or the IO file control block returned after |
| 21 |
; opening the file with FITS_OPEN,/UPDATE. The explicit |
| 22 |
; use of FITS_OPEN can save time if many extensions in a |
| 23 |
; single file will be updated. |
| 24 |
; |
| 25 |
; DATA - data array to be inserted into the FITS file. Set DATA = 0 |
| 26 |
; to leave the data portion of the FITS file unmodified |
| 27 |
; |
| 28 |
; HEADER - FITS header (string array) to be updated in the FITS file. |
| 29 |
; |
| 30 |
; OPTIONAL INPUT KEYWORDS: |
| 31 |
; A specific extension can be specified with either the EXTNAME or |
| 32 |
; EXTEN_NO keyword |
| 33 |
; |
| 34 |
; EXTEN_NO - scalar integer specifying the FITS extension to modified. For |
| 35 |
; example, specify EXTEN = 1 or /EXTEN to modify the first |
| 36 |
; FITS extension. |
| 37 |
; EXTNAME - string name of the extension to modify. |
| 38 |
; |
| 39 |
; |
| 40 |
; OPTIONAL OUTPUT KEYWORD: |
| 41 |
; ERRMSG - If this keyword is supplied, then any error mesasges will be |
| 42 |
; returned to the user in this parameter rather than depending on |
| 43 |
; on the MESSAGE routine in IDL. If no errors are encountered |
| 44 |
; then a null string is returned. |
| 45 |
; |
| 46 |
; EXAMPLES: |
| 47 |
; (1) Modify the value of the DATE keyword in the primary header of a |
| 48 |
; file TEST.FITS. |
| 49 |
; |
| 50 |
; IDL> h = headfits('test.fits') ;Read primary header |
| 51 |
; IDL> sxaddpar,h,'DATE','2001-03-23' ;Modify value of DATE |
| 52 |
; IDL> modfits,'test.fits',0,h ;Update header only |
| 53 |
; |
| 54 |
; (2) Replace the values of the primary image array in 'test.fits' with |
| 55 |
; their absolute values |
| 56 |
; |
| 57 |
; IDL> im = readfits('test.fits') ;Read image array |
| 58 |
; IDL> im = abs(im) ;Take absolute values |
| 59 |
; IDL> modfits,'test.fits',im ;Update image array |
| 60 |
; |
| 61 |
; (3) Add some HISTORY records to the FITS header in the first extension |
| 62 |
; of a file 'test.fits' |
| 63 |
; |
| 64 |
; IDL> h = headfits('test.fits',/ext) ;Read first extension hdr |
| 65 |
; IDL> sxaddhist,['Comment 1','Comment 2'],h |
| 66 |
; IDL> modfits,'test.fits',0,h,/ext ;Update extension hdr |
| 67 |
; |
| 68 |
; (4) Change 'OBSDATE' keyword to 'OBS-DATE' in every extension in a |
| 69 |
; FITS file. Explicitly open with FITS_OPEN to save compute time. |
| 70 |
; |
| 71 |
; fits_open,'test.fits',io,/update ;Faster to explicity open |
| 72 |
; for i = 1,nextend do begin ;Loop over extensions |
| 73 |
; fits_read,io,0,h,/header_only,exten_no=i,/No_PDU ;Get header |
| 74 |
; date= sxpar(h,'OBSDATE') ;Save keyword value |
| 75 |
; sxaddpar,h,'OBS-DATE',date,after='OBSDATE' |
| 76 |
; sxdelpar,h,'OBSDATE' ;Delete bad keyword |
| 77 |
; modfits,io,0,h,exten_no=i ;Update header |
| 78 |
; endfor |
| 79 |
; |
| 80 |
; Note the use of the /No_PDU keyword in the FITS_READ call -- one |
| 81 |
; does *not* want to append the primary header, if the STScI |
| 82 |
; inheritance convention is adopted. |
| 83 |
; |
| 84 |
; NOTES: |
| 85 |
; Uses the BLKSHIFT procedure to shift the contents of the FITS file if |
| 86 |
; the new data or header differs in size by more than 2880 bytes from the |
| 87 |
; old data or header. If a file control block (FCB) structure is |
| 88 |
; supplied, then the values of START_HEADER, START_DATA and NBYTES may |
| 89 |
; be modified if the file size changes. |
| 90 |
; |
| 91 |
; Also see the procedures FXHMODIFY to add a single FITS keyword to a |
| 92 |
; header in a FITS files, and FXBGROW to enlarge the size of a binary |
| 93 |
; table. |
| 94 |
; RESTRICTIONS: |
| 95 |
; (1) Cannot be used to modifiy the data in FITS files with random |
| 96 |
; groups or variable length binary tables. (The headers in such |
| 97 |
; files *can* be modified.) |
| 98 |
; |
| 99 |
; (2) If a data array but no FITS header is supplied, then MODFITS does |
| 100 |
; not check to make sure that the existing header is consistent with |
| 101 |
; the new data. |
| 102 |
; |
| 103 |
; (3) Does not work with compressed files |
| 104 |
; PROCEDURES USED: |
| 105 |
; Functions: N_BYTES(), SXPAR() |
| 106 |
; Procedures: BLKSHIFT, CHECK_FITS, FITS_OPEN, FITS_READ |
| 107 |
; |
| 108 |
; MODIFICATION HISTORY: |
| 109 |
; Written, Wayne Landsman December, 1994 |
| 110 |
; Fixed possible problem when using WRITEU after READU October 1997 |
| 111 |
; New and old sizes need only be the same within multiple of 2880 bytes |
| 112 |
; Added call to IS_IEEE_BIG() W. Landsman May 1999 |
| 113 |
; Added ERRMSG output keyword W. Landsman May 2000 |
| 114 |
; Update tests for incompatible sizes W. Landsman December 2000 |
| 115 |
; Major rewrite to use FITS_OPEN procedures W. Landsman November 2001 |
| 116 |
; Add /No_PDU call to FITS_READ call W. Landsman June 2002 |
| 117 |
; Update CHECKSUM keywords if already present in header, add padding |
| 118 |
; if new data size is smaller than old W.Landsman December 2002 |
| 119 |
; Only check XTENSION value if EXTEN_NO > 1 W. Landsman Feb. 2003 |
| 120 |
; Correct for unsigned data on little endian machines W. Landsman Apr 2003 |
| 121 |
; Major rewrite to allow changing size of data or header W.L. Aug 2003 |
| 122 |
; Fixed case where updated header exactly fills boundary W.L. Feb 2004 |
| 123 |
; More robust error reporting W.L. Dec 2004 |
| 124 |
; Make sure input header ends with a END W.L. March 2006 |
| 125 |
; Assume since V5.5, remove VMS support, assume FITS_OPEN will |
| 126 |
; perform byte swapping W.L. Sep 2006 |
| 127 |
; Update FCB structure if file size changes W.L. March 2007 |
| 128 |
; Fix problem when data size must be extended W.L. August 2007 |
| 129 |
; Don't assume supplied FITS header is 80 bytes W. L. Dec 2007 |
| 130 |
; Check for new END position after adding CHECKSUM W.L. July 2008 |
| 131 |
; Added EXTNAME input keyword W.L. July 2008 |
| 132 |
;- |
| 133 |
On_error,2 ;Return to user |
| 134 |
compile_opt idl2 |
| 135 |
|
| 136 |
; Check for filename input |
| 137 |
|
| 138 |
if N_params() LT 1 then begin |
| 139 |
print,'Syntax - ' + $ |
| 140 |
'MODFITS, Filename, Data, [ Header, EXTEN_NO=, EXTNAME=, ERRMSG= ]' |
| 141 |
return |
| 142 |
endif |
| 143 |
|
| 144 |
if not keyword_set( EXTEN_NO ) then exten_no = 0 |
| 145 |
if N_params() LT 2 then Header = 0 |
| 146 |
nheader = N_elements(Header) |
| 147 |
|
| 148 |
;Make sure END statement is the last line in supplied FITS header |
| 149 |
|
| 150 |
if nheader GT 1 then begin |
| 151 |
endline = where( strmid(Header,0,8) EQ 'END ', Nend) |
| 152 |
if Nend EQ 0 then begin |
| 153 |
message,/INF, $ |
| 154 |
'WARNING - An END statement has been appended to the FITS header' |
| 155 |
Header = [ Header, 'END' + string( replicate(32b,77) ) ] |
| 156 |
endif else header = header[0:endline] |
| 157 |
endif |
| 158 |
|
| 159 |
ndata = N_elements(data) |
| 160 |
dtype = size(data,/TNAME) |
| 161 |
printerr = not arg_present(ERRMSG) |
| 162 |
fcbsupplied = size(filename,/TNAME) EQ 'STRUCT' |
| 163 |
|
| 164 |
if (nheader GT 1) and (ndata GT 1) then begin |
| 165 |
check_fits, data, header, /FITS, ERRMSG = MESSAGE |
| 166 |
if message NE '' then goto, BAD_EXIT |
| 167 |
endif |
| 168 |
|
| 169 |
; Open file and read header information |
| 170 |
|
| 171 |
if (exten_no EQ 0) and (not keyword_set(EXTNAME)) then begin |
| 172 |
if nheader GT 0 then $ |
| 173 |
if strmid( header[0], 0, 8) NE 'SIMPLE ' then begin |
| 174 |
message = $ |
| 175 |
'Input header does not contain required SIMPLE keyword' |
| 176 |
goto, BAD_EXIT |
| 177 |
endif |
| 178 |
endif else begin |
| 179 |
if nheader GT 0 then $ |
| 180 |
if strmid( header[0], 0, 8) NE 'XTENSION' then begin |
| 181 |
message = $ |
| 182 |
'ERROR - Input header does not contain required XTENSION keyword' |
| 183 |
goto, BAD_EXIT |
| 184 |
endif |
| 185 |
endelse |
| 186 |
|
| 187 |
; Was a file name or file control block supplied? |
| 188 |
|
| 189 |
if not fcbsupplied then begin |
| 190 |
fits_open, filename, io,/update,/No_Abort,message=message |
| 191 |
if message NE '' then GOTO, BAD_EXIT |
| 192 |
endif else begin |
| 193 |
if filename.open_for_write EQ 0 then begin |
| 194 |
message = 'FITS file is set for READONLY, cannot be updated' |
| 195 |
goto, BAD_EXIT |
| 196 |
endif |
| 197 |
io = filename |
| 198 |
endelse |
| 199 |
|
| 200 |
; Getting starting position of data and header |
| 201 |
|
| 202 |
if keyword_set(extname) then begin |
| 203 |
exten_no = where( strupcase(io.extname) EQ strupcase(extname), Nfound) |
| 204 |
if Nfound EQ 0 then begin |
| 205 |
message,'Extension name ' + extname + ' not found in FITS file' |
| 206 |
GOTO, BAD_EXIT |
| 207 |
endif |
| 208 |
endif |
| 209 |
unit = io.unit |
| 210 |
start_d = io.start_data[exten_no] |
| 211 |
if exten_no NE io.nextend then begin |
| 212 |
start_h = io.start_header[exten_no+1] |
| 213 |
nbytes = start_h - start_d |
| 214 |
endif else nbytes = N_BYTES(data) |
| 215 |
|
| 216 |
FITS_READ,Io,0,oldheader,/header_only, exten=exten_no, /No_PDU, $ |
| 217 |
message = message,/no_abort |
| 218 |
if message NE '' then goto, BAD_EXIT |
| 219 |
dochecksum = sxpar(oldheader,'CHECKSUM', Count = N_checksum) |
| 220 |
checksum = N_checksum GT 0 |
| 221 |
|
| 222 |
; Update header, including any CHECKSUM keywords if present |
| 223 |
|
| 224 |
if nheader GT 1 then begin |
| 225 |
noldheader = start_d - io.start_header[exten_no] |
| 226 |
|
| 227 |
if dtype EQ 'UINT' then $ |
| 228 |
sxaddpar,header,'BZERO',32768,'Data is unsigned integer' |
| 229 |
if dtype EQ 'ULONG' then $ |
| 230 |
sxaddpar,header,'BZERO',2147483648,'Data is unsigned long' |
| 231 |
if checksum then begin |
| 232 |
if Ndata GT 1 then FITS_ADD_CHECKSUM, header, data else $ |
| 233 |
FITS_ADD_CHECKSUM, header |
| 234 |
endif |
| 235 |
; Position of 'END' card may have changed - Bug fix July 2008 |
| 236 |
endline = where( strmid(Header,0,8) EQ 'END ', Nend) |
| 237 |
|
| 238 |
newbytes = N_elements(header)*80 |
| 239 |
block = (newbytes-1)/2880 - (Noldheader-1)/2880 |
| 240 |
if block NE 0 then begin |
| 241 |
BLKSHIFT, io.unit, start_d, block*2880L |
| 242 |
start_d = start_d + block*2880L |
| 243 |
io.start_data[exten_no:*] = io.start_data[exten_no:*] + block*2880L |
| 244 |
io.nbytes = io.nbytes + block*2880L |
| 245 |
if exten_no NE io.nextend then begin |
| 246 |
start_h = start_h + block*2880L |
| 247 |
io.start_header[exten_no+1:*] = block*2880L + $ |
| 248 |
io.start_header[exten_no+1:*] |
| 249 |
endif |
| 250 |
endif |
| 251 |
point_lun, unit, io.start_header[exten_no] ;Position header start |
| 252 |
bhdr = replicate(32b, newbytes) |
| 253 |
for n = 0l, endline[0] do bhdr[80*n] = byte( header[n] ) |
| 254 |
writeu, unit, bhdr |
| 255 |
remain = newbytes mod 2880 |
| 256 |
if remain GT 0 then writeu, unit, replicate( 32b, 2880 - remain) |
| 257 |
|
| 258 |
endif |
| 259 |
|
| 260 |
if ndata GT 1 then begin |
| 261 |
|
| 262 |
newbytes = N_BYTES(data) ;total number of bytes in supplied data |
| 263 |
block = (newbytes-1)/2880 - (nbytes-1)/2880 |
| 264 |
if block NE 0 and exten_no NE io.nextend then begin |
| 265 |
BLKSHIFT, io.unit, start_h, block*2880L |
| 266 |
io.nbytes = io.nbytes + block*2880L |
| 267 |
io.start_header[exten_no+1:*] = block*2880L + $ |
| 268 |
io.start_header[exten_no+1:*] |
| 269 |
io.start_data[exten_no+1:*] = block*2880L + $ |
| 270 |
io.start_data[exten_no+1:*] |
| 271 |
endif |
| 272 |
|
| 273 |
if nheader EQ 0 then begin |
| 274 |
check_fits,data,oldheader,/FITS,ERRMSG = message |
| 275 |
if message NE '' then goto, BAD_EXIT |
| 276 |
endif |
| 277 |
|
| 278 |
junk = fstat(unit) ;Need this before changing from READU to WRITEU |
| 279 |
point_lun, unit, start_d |
| 280 |
if dtype EQ 'UINT' then newdata = fix(data - 32768) |
| 281 |
if dtype EQ 'ULONG' then newdata = long(data - 2147483648) |
| 282 |
if N_elements(newdata) GT 0 then writeu, unit, newdata else $ |
| 283 |
writeu, unit ,data |
| 284 |
remain = newbytes mod 2880 |
| 285 |
if remain GT 0 then begin |
| 286 |
padnum = 0b |
| 287 |
if exten_no GT 0 then begin |
| 288 |
exten = sxpar( oldheader, 'XTENSION') |
| 289 |
if exten EQ 'TABLE ' then padnum = 32b |
| 290 |
endif |
| 291 |
writeu, unit, replicate( padnum, 2880 - remain) |
| 292 |
endif |
| 293 |
endif |
| 294 |
|
| 295 |
if not fcbsupplied then FITS_CLOSE,io else filename = io |
| 296 |
|
| 297 |
|
| 298 |
|
| 299 |
return |
| 300 |
|
| 301 |
BAD_EXIT: |
| 302 |
if N_elements(io) GT 0 then if not fcbsupplied then fits_close,io |
| 303 |
if printerr then message,'ERROR - ' + message,/CON else errmsg = message |
| 304 |
if fcbsupplied then fname = filename.filename else fname = filename |
| 305 |
message,'FITS file ' + fname + ' not modified',/INF |
| 306 |
return |
| 307 |
end |
