pro check_FITS, im, hdr, dimen, idltype, UPDATE = update, NOTYPE = notype, $ SDAS = sdas, FITS = fits ;+ ; NAME: ; CHECK_FITS ; PURPOSE: ; Given a FITS array IM, and a associated FITS or SDAS header HDR, this ; procedure will check that ; (1) HDR is a string array, and IM is defined and numeric ; (2) The NAXISi values in HDR are appropiate to the dimensions of IM ; (3) The BITPIX value in HDR is appropiate to the datatype of IM. ; If HDR contain a DATATYPE keyword (as in SDAS files), then this is ; also checked against the datatype of of IM ; If the UPDATE keyword is present, then FITS header will be modified, if ; necesary, to force agreement with the image array ; CALLING SEQUENCE: ; check_FITS, im, hdr, [ dimen, idltype, /UPDATE, /NOTYPE, /SDAS ] ; INPUTS: ; IM - FITS or STSDAS array, (e.g. as read by SXREAD or READFITS ) ; HDR - FITS or STSDAS header (string array) associated with IM ; ; OPTIONAL OUTPUTS: ; dimen - vector containing actual array dimensions ; idltype- data type of the FITS array as specified in the IDL SIZE function ; (1 for BYTE, 2 for INTEGER*2, 3 for INTEGER*4, etc.) ; OPTIONAL KEYWORD INPUTS: ; /NOTYPE - If this keyword is set, then only agreement of the array ; dimensions with the FITS header are checked, and not the ; data type. ; /UPDATE - If this keyword is set then the BITPIX, NAXIS and DATATYPE ; FITS keywords will be updated to agree with the arra ; /SDAS - If this keyword is set then the header is assumed to be from ; an SDAS (.hhh) file. CHECK_FITS will then ensure that (1) ; a DATATYPE keyword is included in the header and (2) BITPIX ; is always written with positive values. ; /FITS - If this keyword is present then CHECK_FITS assumes that it is ; dealing with a FITS header and not an SDAS header, see notes ; below. ; SYSTEM VARIBLE: ; If there is a fatal problem with the FITS array or header then !ERR is ; set to -1. ( If the UPDATE keyword was supplied, and the header could ; be fixed then !ERR = 0.) ; PROCEDURE: ; Program checks the NAXIS1 and NAXIS2 parameters in the header to ; see if they match the image array dimensions. ; NOTES: ; An important distinction between an STSDAS header and a FITS header ; is that the BITPIX value in an STSDAS is always positive, e.g. BITPIX=32 ; for REAL*4 data. Users should use either the /SDAS or the /FITS keyword ; if it is important whether the STSDAS or FITS convention for REAL*4 data ; is used. Otherwise, CHECK_FITS assumes that if a DATATYPE keyword is ; present then it is dealing with an STSDAS header. ; MODIFICATION HISTORY: ; Written, December 1991 W. Landsman Hughes/STX to replace CHKIMHD ;- On_error,2 if N_params() LT 2 then begin print,'Syntax - CHECK_FITS, im, hdr, dimen, idltype, ' print,' [ /UPDATE, /NOTYPE, /SDAS, /FITS] return endif hinfo = size(hdr) if (hinfo(0) NE 1) then begin ;Is hd of string type? message,'ERROR - FITS header must be a string array', /CON !ERR = -1 & return endif im_info = size(im) ndim = im_info(0) if N_elements( im ) EQ 0 then message, 'ERROR - FITS array is undefined ' ; dimen = im_info( indgen( im_info(0) ) + 1) ndimen = N_elements( dimen) ; nax = sxpar( hdr, 'NAXIS' ) if !ERR EQ -1 then $ message,'ERROR - FITS header missing NAXIS keyword' naxis = sxpar( hdr, 'NAXIS*') nax = N_elements( naxis ) last = nax-1 ;Remove degenerate dimensions while ( (naxis(last) EQ 1) and (last GE 1) ) do last = last -1 if last NE nax-1 then begin naxis = naxis( 0:last) endif if ( ndimen NE last + 1 ) then goto, DIMEN_ERROR for i=0,last do begin if naxis(i) NE im_info(i+1) then begin if not keyword_set( UPDATE ) then begin message, /CON, $ 'ERROR - Invalid NAXIS' + strn( i+1 ) + ' keyword value in header' !ERR = -1 & return endif else goto, DIMEN_ERROR endif endfor DATATYPE: if not keyword_set( NOTYPE ) then begin idltype = im_info(im_info(0)+1) datatype = strtrim( sxpar( hdr,'DATATYPE' )) if !ERR NE -1 then begin case idltype of 1: if ( datatype NE 'INTEGER*1' ) then goto, DATATYPE_ERROR 2: if ( datatype NE 'INTEGER*2' ) and $ ( datatype NE 'UNSIGNED*2') then goto, DATATYPE_ERROR 4: if ( datatype NE 'REAL*4' ) then goto, DATATYPE_ERROR 3: if ( datatype NE 'INTEGER*4') and $ ( datatype NE 'UNSIGNED*4') then goto, DATATYPE_ERROR 5: if ( datatype NE 'REAL*8' ) then goto, DATATYPE_ERROR 6: if ( datatype NE 'COMPLEX*8' ) then goto, DATATYPE_ERROR else: begin message,'Image array is non-numeric datatype',/CON !ERR = -1 & return end endcase endif else begin if keyword_set(SDAS) then goto, DATATYPE_ERROR datatype = '' endelse BITPIX: bitpix = sxpar( hdr, 'BITPIX') case idltype of 1: if ( bitpix NE 8) then goto, BITPIX_ERROR 2: if ( bitpix NE 16 ) then goto, BITPIX_ERROR 4: begin if keyword_set(FITS) and (bitpix NE -32) then goto, BITPIX_ERROR $ else begin if ( abs( bitpix) NE 32 ) then goto, BITPIX_ERROR if bitpix EQ 32 then if datatype NE 'REAL*4' then goto, BITPIX_ERROR endelse end 3: if bitpix NE 32 then goto, BITPIX_ERROR 5: begin if keyword_set(FITS) and (bitpix NE -64) then goto, BITPIX_ERROR $ else begin if ( abs( bitpix) NE 64 ) then goto, BITPIX_ERROR if bitpix EQ 64 then if datatype NE 'REAL*4' then goto, BITPIX_ERROR endelse end else: begin if not ( (idltype EQ 6) and (datatype EQ 'COMPLEX*8') ) then $ message,'Data array is a non-numeric datatype',/CON !ERR = -1 & return end endcase endif ; !ERR = 0 return DATATYPE_ERROR: if keyword_set( UPDATE ) then begin dtype = ['', 'INTEGER*1', 'INTEGER*2', 'INTEGER*4', 'REAL*4', $ 'REAL*8', 'COMPLEX*16' ] datatype = dtype( idltype) message,'DATATYPE keyword of '+ datatype + ' added to FITS header',/INF sxaddpar, hdr, 'DATATYPE', datatype, $ ' FITS/SDAS version of BITPIX', 'HISTORY' goto, BITPIX endif else begin message, 'ERROR - Incorrect DATATYPE keyword of ' + datatype, /CON !ERR = -1 & return endelse BITPIX_ERROR: if keyword_set( UPDATE ) then begin bpix = [0, 8, 16, 32, -32, -64, 32 ] if keyword_set(SDAS) then bpix = abs(bpix) 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' ] bitpix = bpix(idltype) comment = comm(idltype) message, 'BITPIX value of ' + strn(bitpix) + ' added to FITS header', /INF sxaddpar, hdr, 'BITPIX', bitpix, comment !ERR = 0 & return endif else message, 'ERROR - BITPIX value of ' + strn(bitpix) + $ ' does not match array' DIMEN_ERROR: if keyword_set( UPDATE ) then begin for i = 1, ndimen do sxaddpar, hdr, 'NAXIS' + strn(i), dimen(i-1), $ 'Number of positions along axis ' + strn(i) if nax GT ndimen then $ for i = ndimen+1, nax do sxdelpar, hdr, 'NAXIS'+strn(i) message,'NAXIS keywords in FITS header have been updated', /INF goto, DATATYPE endif end