Commit d3ac6c28 authored by Carl Schaffer's avatar Carl Schaffer
Browse files

Updating FITS_WRITE to NASA version

parent 621310dd
...@@ -110,7 +110,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -110,7 +110,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
; Removed obsolete !ERR system variable W. Landsman Feb 2004 ; Removed obsolete !ERR system variable W. Landsman Feb 2004
; Check that byte array supplied with table extension W. Landsman Mar 2004 ; Check that byte array supplied with table extension W. Landsman Mar 2004
; Make number of bytes 64bit to avoid possible overflow W.L Apr 2006 ; Make number of bytes 64bit to avoid possible overflow W.L Apr 2006
; Asuume FITS_OPEN has opened the file with /SWAP_IF_LITTLE_ENDIAN ; Assume FITS_OPEN has opened the file with /SWAP_IF_LITTLE_ENDIAN
; W. Landsman September 2006 ; W. Landsman September 2006
; Removes BZERO and BSCALE for floating point output, D. Lindler, Sep 2008 ; Removes BZERO and BSCALE for floating point output, D. Lindler, Sep 2008
;- ;-
...@@ -131,7 +131,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -131,7 +131,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
message = '' message = ''
s = size(file_or_fcb) & fcbtype = s[s[0]+1] s = size(file_or_fcb) & fcbtype = s[s[0]+1]
fcbsize = n_elements(file_or_fcb) fcbsize = n_elements(file_or_fcb)
if (fcbsize ne 1) or ((fcbtype ne 7) and (fcbtype ne 8)) then begin if (fcbsize ne 1) || ((fcbtype ne 7) && (fcbtype ne 8)) then begin
message = 'Invalid Filename or FCB supplied' message = 'Invalid Filename or FCB supplied'
goto,error_exit goto,error_exit
end end
...@@ -186,7 +186,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -186,7 +186,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
if naxis gt 0 then axis = s[1:naxis] if naxis gt 0 then axis = s[1:naxis]
idltype = s[naxis+1] idltype = s[naxis+1]
if (idltype gt 5) and (idltype NE 12) and (idltype NE 13) then begin if (idltype gt 5) && (idltype NE 12) && (idltype NE 13) then begin
message='Data array is an invalid type' message='Data array is an invalid type'
goto,error_exit goto,error_exit
endif endif
...@@ -233,7 +233,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -233,7 +233,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
hpos2 = where(keywords eq 'BEGIN EX') & hpos2 = hpos2[0] ;begin ext. hpos2 = where(keywords eq 'BEGIN EX') & hpos2 = hpos2[0] ;begin ext.
hpos3 = where(keywords eq 'END ') & hpos3 = hpos3[0] ;end of header hpos3 = where(keywords eq 'END ') & hpos3 = hpos3[0] ;end of header
if (hpos1 gt 0) and (hpos2 lt hpos1) then begin if (hpos1 gt 0) && (hpos2 lt hpos1) then begin
message,'Invalid header BEGIN EXTENSION HEADER ... out of place' message,'Invalid header BEGIN EXTENSION HEADER ... out of place'
goto,error_exit goto,error_exit
endif endif
...@@ -242,19 +242,18 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -242,19 +242,18 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
print,'FITS_WRITE: END missing from input header and was added' print,'FITS_WRITE: END missing from input header and was added'
header = [header,'END '] header = [header,'END ']
hpos2 = n_elements(header)-1 hpos2 = n_elements(header)-1
hpos2 = where(keywords eq 'BEGIN EX') & hpos2 = hpos2[0] ;begin ext.
end end
; ;
; determine if a extension was supplied and no primary data unit (PDU) ; determine if a extension was supplied and no primary data unit (PDU)
; was written ; was written
; ;
if (fcb.nextend eq -1) then begin ;no pdu written yet? if (fcb.nextend eq -1) then begin ;no pdu written yet?
if (hpos2 gt 0) or (Axtension ne '') or (Aextname ne '') or $ if (hpos2 gt 0) || (Axtension ne '') || (Aextname ne '') || $
(Aextver ne 0) or (Aextlevel ne 0) then begin (Aextver ne 0) || (Aextlevel ne 0) then begin
; ;
; write null image PDU ; write null image PDU
; ;
if (hpos1 gt 0) and (hpos2 gt (hpos1+1)) then $ if (hpos1 gt 0) && (hpos2 gt (hpos1+1)) then $
hmain = [header[hpos1+1:hpos2-1],'END '] hmain = [header[hpos1+1:hpos2-1],'END ']
fits_write,fcb,0,hmain,/no_abort,message=message fits_write,fcb,0,hmain,/no_abort,message=message
if message NE '' then goto,error_exit if message NE '' then goto,error_exit
...@@ -285,7 +284,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -285,7 +284,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
end else begin ;PCOUNT, GCOUNT are mandatory for extensions end else begin ;PCOUNT, GCOUNT are mandatory for extensions
sxaddpar,h,'PCOUNT',0 sxaddpar,h,'PCOUNT',0
sxaddpar,h,'GCOUNT',1 sxaddpar,h,'GCOUNT',1
if (Axtension eq 'BINTABLE') or $ if (Axtension eq 'BINTABLE') || $
(Axtension eq 'TABLE ') then begin (Axtension eq 'TABLE ') then begin
tfields = sxpar(header,'TFIELDS') > 0 tfields = sxpar(header,'TFIELDS') > 0
sxaddpar,h,'TFIELDS',tfields sxaddpar,h,'TFIELDS',tfields
...@@ -299,7 +298,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $ ...@@ -299,7 +298,7 @@ pro fits_write,file_or_fcb,data,header_in,extname=extname,extver=extver, $
if idltype EQ 13 then $ if idltype EQ 13 then $
sxaddpar,header,'BZERO',2147483648,'Data is unsigned long' sxaddpar,header,'BZERO',2147483648,'Data is unsigned long'
if idltype GE 12 then sxdelpar,header,'BSCALE' if idltype GE 12 then sxdelpar,header,'BSCALE'
if (idltype EQ 4) or (idltype EQ 5) then $ if (idltype EQ 4) || (idltype EQ 5) then $
sxdelpar,header,['BSCALE','BZERO'] sxdelpar,header,['BSCALE','BZERO']
; ;
; delete special keywords from user supplied header ; delete special keywords from user supplied header
...@@ -341,7 +340,7 @@ write_header: ...@@ -341,7 +340,7 @@ write_header:
; ;
; convert to IEEE ; convert to IEEE
; ;
unsigned = (idltype EQ 12) or (idltype EQ 13) unsigned = (idltype EQ 12) || (idltype EQ 13)
if idltype EQ 12 then newdata = fix(data - 32768) if idltype EQ 12 then newdata = fix(data - 32768)
if idltype EQ 13 then newdata = long(data - 2147483648) if idltype EQ 13 then newdata = long(data - 2147483648)
; ;
...@@ -378,3 +377,4 @@ error_exit: ...@@ -378,3 +377,4 @@ error_exit:
message,' ERROR: '+message,/CON message,' ERROR: '+message,/CON
retall retall
end end
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment