pro check_FITS, im, hdr, dimen, idltype, UPDATE = update, NOTYPE = notype, $ SDAS = sdas, FITS = fits, SILENT = silent, ERRMSG = errmsg, $ ALLOW_DEGEN=ALLOW_DEGEN compile_opt idl2 On_error,2 if N_params() LT 2 then begin print,'Syntax - CHECK_FITS, im, hdr, dimen, idltype, ' print,' [ /UPDATE, /NOTYPE, ERRMSG=, /SILENT ]' return endif if arg_present(errmsg) then errmsg = '' if size(hdr,/TNAME) NE 'STRING' then begin ;Is hdr of string type? message= 'FITS header is not a string array' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message, 'ERROR - ' + message, /CON return endif im_info = size(im,/struc) ndimen = im_info.n_dimensions if ndimen GT 0 then dimen = im_info.dimensions[0:ndimen-1] idltype = im_info.type nax = fxpar( hdr, 'NAXIS', Count = N_naxis ) if N_naxis EQ 0 then begin message = 'FITS header missing NAXIS keyword' if N_elements(errmsg) GT 0 then errmsg = message else $ message,'ERROR - ' + message,/CON return endif if ndimen EQ 0 then $ ;Null primary array if nax EQ 0 then return else begin message = 'FITS array is not defined' if N_elements(errmsg) GT 0 then errmsg = message else $ message,'ERROR - ' +message,/con return endelse naxis = fxpar( hdr, 'NAXIS*') naxi = N_elements( naxis ) if nax GT naxi then begin ;Does NAXIS agree with # of NAXISi? if keyword_set( UPDATE) then begin fxaddpar, hdr, 'NAXIS', naxi if ~keyword_set(SILENT) then message, /INF, $ 'NAXIS changed from ' + strtrim(nax,2) + ' to ' + strtrim(naxi,2) endif else begin message = 'FITS header has NAXIS = ' + strtrim(nax,2) + $ ', but only ' + strtrim(naxi, 2) + ' axes defined' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message, 'ERROR - ' + message return endelse endif last = naxi-1 ;Remove degenerate dimensions if ~keyword_set(allow_degen) then begin while ( (naxis[last] EQ 1) && (last GE 1) ) do last-- if last NE nax-1 then begin naxis = naxis[ 0:last] endif endif if ( ndimen NE last + 1 ) then begin if ~keyword_set( UPDATE) THEN begin message = $ '# of NAXISi keywords does not match # of array dimensions' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message,'ERROR - ' + message,/CON return endif else goto, DIMEN_ERROR endif for i = 0,last do begin if naxis[i] NE dimen[i] then begin if ~keyword_set( UPDATE ) then begin message = 'Invalid NAXIS' + strtrim( i+1,2 ) + $ ' keyword value in header' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message,'ERROR - ' + message,/CON return endif else goto, DIMEN_ERROR endif endfor BITPIX: if ~keyword_set( NOTYPE ) then begin bitpix = fxpar( hdr, 'BITPIX') case idltype of 1: if bitpix NE 8 then goto, BITPIX_ERROR 2: if bitpix NE 16 then goto, BITPIX_ERROR 4: if bitpix NE -32 then goto, BITPIX_ERROR 3: if bitpix NE 32 then goto, BITPIX_ERROR 5: if bitpix NE -64 then goto, BITPIX_ERROR 12:if bitpix NE 16 then goto, BITPIX_ERROR 13: if bitpix NE 32 then goto, BITPIX_ERROR else: begin message = 'Data array is not a valid FITS datatype' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message,'ERROR - ' + message,/CON return end endcase endif return BITPIX_ERROR: if keyword_set( UPDATE ) then begin bpix = [0, 8, 16, 32, -32, -64, 32, 0, 0, 0, 0, 0, 16,32 ] comm = ['',' Character or unsigned binary integer', $ ' 16-bit twos complement binary integer', $ ' 32-bit twos complement binary integer', $ ' IEEE single precision floating point', $ ' IEEE double precision floating point', $ ' 32-bit twos complement binary integer','','','','','', $ ' 16-bit unsigned binary integer', $ ' 32-bit unsigned binary integer' ] bitpix = bpix[idltype] comment = comm[idltype] if ~keyword_set(SILENT) then message, /INF, $ 'BITPIX value of ' + strtrim(bitpix,2) + ' added to FITS header' fxaddpar, hdr, 'BITPIX', bitpix, comment return endif else begin message = 'BITPIX value of ' + strtrim(bitpix,2) + $ ' in FITS header does not match array' if N_elements(ERRMSG) GT 0 then errmsg = message else $ message,'ERROR - ' + message,/CON return endelse DIMEN_ERROR: if keyword_set( UPDATE ) then begin fxaddpar, hdr, 'NAXIS', ndimen, before = 'NAXIS1' naxis = 'NAXIS' + strtrim(indgen(ndimen)+1,2) for i = 1, ndimen do fxaddpar, hdr, naxis[i-1], dimen[i-1], $ 'Number of positions along axis ' + strtrim(i,2), $ after = 'NAXIS' + strtrim(i-1,2) if naxi GT ndimen then begin for i = ndimen+1, naxi do sxdelpar, hdr, 'NAXIS'+strtrim(i,2) endif if ~keyword_set(SILENT) then message, /INF, $ 'NAXIS keywords in FITS header have been updated' goto, BITPIX endif end