function SXPAR, hdr, name, abort, COUNT=matches, COMMENT = comments, $
NoContinue = NoContinue, SILENT = silent
;+
; NAME:
; SXPAR
; PURPOSE:
; Obtain the value of a parameter in a FITS header
;
; CALLING SEQUENCE:
; result = SXPAR( Hdr, Name, [ Abort, COUNT=, COMMENT =, /NoCONTINUE,
; /SILENT ])
;
; INPUTS:
; Hdr = FITS header array, (e.g. as returned by READFITS)
; string array, each element should have a length of 80 characters
;
; Name = String name of the parameter to return. If Name is of the
; form 'keyword*' then an array is returned containing values of
; keywordN where N is a positive (non-zero) integer. The value of
; keywordN will be placed in RESULT[N-1]. The data type of RESULT
; will be the type of the first valid match of keywordN found.
;
; OPTIONAL INPUTS:
; ABORT - string specifying that SXPAR should do a RETALL
; if a parameter is not found. ABORT should contain
; a string to be printed if the keyword parameter is not found.
; If not supplied, SXPAR will return quietly with COUNT = 0
; (and !ERR = -1) if a keyword is not found.
;
; OPTIONAL INPUT KEYWORDS:
; /NOCONTINUE = If set, then continuation lines will not be read, even
; if present in the header
; /SILENT - Set this keyword to suppress warning messages about duplicate
; keywords in the FITS header.
;
; OPTIONAL OUTPUT KEYWORDS:
; COUNT - Optional keyword to return a value equal to the number of
; parameters found by SXPAR, integer scalar
;
; COMMENT - Array of comments associated with the returned values
;
; OUTPUTS:
; Function value = value of parameter in header.
; If parameter is double precision, floating, long or string,
; the result is of that type. Apostrophes are stripped
; from strings. If the parameter is logical, 1b is
; returned for T, and 0b is returned for F.
; If Name was of form 'keyword*' then a vector of values
; are returned.
;
; SIDE EFFECTS:
; !ERR is set to -1 if parameter not found, 0 for a scalar
; value returned. If a vector is returned it is set to the
; number of keyword matches found. The use of !ERR is deprecated, and
; instead the COUNT keyword is preferred
;
; If a keyword (except HISTORY or COMMENT) occurs more than once in a
; header, a warning is given, and the *last* occurence is used.
;
; EXAMPLES:
; Given a FITS header, h, return the values of all the NAXISi values
; into a vector. Then place the history records into a string vector.
;
; IDL> naxisi = sxpar( h ,'NAXIS*') ; Extract NAXISi value
; IDL> history = sxpar( h, 'HISTORY' ) ; Extract HISTORY records
;
; PROCEDURE:
; The first 8 chacters of each element of Hdr are searched for a
; match to Name. The value from the last 20 characters is returned.
; An error occurs if there is no parameter with the given name.
;
; If a numeric value has no decimal point it is returned as type
; LONG. If it contains more than 8 numerals, or contains the
; characters 'D' or 'E', then it is returned as type DOUBLE. Otherwise
; it is returned as type FLOAT. Very large integer values, outside
; the range of valid LONG, are returned as DOUBLE.
;
; If the value is too long for one line, it may be continued on to the
; the next input card, using the OGIP CONTINUE convention. For more info,
; see http://fits.gsfc.nasa.gov/registry/continue_keyword.html
;
; Complex numbers are recognized as two numbers separated by one or more
; space characters.
;
; If a numeric value has no decimal point (or E or D) it is returned as
; type LONG. If it contains more than 8 numerals, or contains the
; character 'D', then it is returned as type DOUBLE. Otherwise it is
; returned as type FLOAT. If an integer is too large to be stored as
; type LONG, then it is returned as DOUBLE.
;
; NOTES:
; The functions SXPAR() and FXPAR() are nearly identical, although
; FXPAR() has slightly more sophisticated parsing, and additional keywords
; to specify positions in the header to search (for speed), and to force
; the output to a specified data type.. There is no
; particular reason for having two nearly identical procedures, but
; both are too widely used to drop either one.
;
; PROCEDURES CALLED:
; GETTOK(), VALID_NUM()
; MODIFICATION HISTORY:
; DMS, May, 1983, STPAR Written.
; D. Lindler Jan 90 added ABORT input parameter
; J. Isensee Jul,90 added COUNT keyword
; W. Thompson, Feb. 1992, added support for FITS complex values.
; W. Thompson, May 1992, corrected problem with HISTORY/COMMENT/blank
; keywords, and complex value error correction.
; W. Landsman, November 1994, fix case where NAME is an empty string
; W. Landsman, March 1995, Added COMMENT keyword, ability to read
; values longer than 20 character
; W. Landsman, July 1995, Removed /NOZERO from MAKE_ARRAY call
; T. Beck May 1998, Return logical as type BYTE
; W. Landsman May 1998, Make sure integer values are within range of LONG
; W. Landsman Feb 1998, Recognize CONTINUE convention
; W. Landsman Oct 1999, Recognize numbers such as 1E-10 as floating point
; W. Landsman Jan 2000, Only accept integer N values when name = keywordN
; W. Landsman Dec 2001, Optional /SILENT keyword to suppress warnings
; W. Landsman/D. Finkbeiner Mar 2002 Make sure extracted vectors
; of mixed data type are returned with the highest type.
; W.Landsman Aug 2008 Use vector form of VALID_NUM()
; W. Landsman Jul 2009 Eliminate internal recursive call
; W. Landsman Apr 2012 Require vector numbers be greater than 0
;-
;----------------------------------------------------------------------
On_error,2
compile_opt idl2
if N_params() LT 2 then begin
print,'Syntax - result = sxpar( hdr, name, [abort])'
print,' Input Keywords: /NOCONTINUE, /SILENT'
print,' Output Keywords: COUNT=, COMMENT= '
return, -1
endif
VALUE = 0
if N_params() LE 2 then begin
abort_return = 0
abort = 'FITS Header'
end else abort_return = 1
if abort_return then On_error,1 else On_error,2
; Check for valid header
;Check header for proper attributes.
if ( size(hdr,/N_dimen) NE 1 ) || ( size(hdr,/type) NE 7 ) then $
message,'FITS Header (first parameter) must be a string array'
nam = strtrim( strupcase(name) ) ;Copy name, make upper case
; Determine if NAME is of form 'keyword*'. If so, then strip off the '*', and
; set the VECTOR flag. One must consider the possibility that NAM is an empty
; string.
namelength1 = (strlen(nam) - 1 ) > 1
if strpos( nam, '*' ) EQ namelength1 then begin
nam = strmid( nam, 0, namelength1)
vector = 1 ;Flag for vector output
name_length = strlen(nam) ;Length of name
num_length = 8 - name_length ;Max length of number portion
if num_length LE 0 then $
message, 'Keyword length must be 8 characters or less'
; Otherwise, extend NAME with blanks to eight characters.
endif else begin
while strlen(nam) LT 8 do nam = nam + ' ' ;Make 8 chars long
vector = 0
endelse
; If of the form 'keyword*', then find all instances of 'keyword' followed by
; a number. Store the positions of the located keywords in NFOUND, and the
; value of the number field in NUMBER.
histnam = (nam eq 'HISTORY ') || (nam eq 'COMMENT ') || (nam eq '')
keyword = strmid( hdr, 0, 8)
if vector then begin
nfound = where(strpos(keyword,nam) GE 0, matches)
if matches GT 0 then begin
numst= strmid( hdr[nfound], name_length, num_length)
igood = where(VALID_NUM(numst,/INTEGER), matches)
if matches GT 0 then begin
nfound = nfound[igood]
number = long(numst[igood])
g = where(number GT 0, matches)
if matches GT 0 then number = number[g]
endif
endif
; Otherwise, find all the instances of the requested keyword. If more than
; one is found, and NAME is not one of the special cases, then print an error
; message.
endif else begin
nfound = where(keyword EQ nam, matches)
if (matches GT 1) && ~histnam then $
if ~keyword_set(silent) then $
message,/informational, 'Warning - keyword ' + $
nam + ' located more than once in ' + abort
endelse
; Process string parameter
if matches GT 0 then begin
line = hdr[nfound]
svalue = strtrim( strmid(line,9,71),2)
if histnam then $
value = strtrim(strmid(line,8,71),2) else for i = 0,matches-1 do begin
if ( strmid(svalue[i],0,1) EQ "'" ) then begin ;Is it a string?
test = strmid( svalue[i],1,strlen( svalue[i] )-1)
next_char = 0
off = 0
value = ''
NEXT_APOST:
endap = strpos(test, "'", next_char) ;Ending apostrophe
if endap LT 0 then $
MESSAGE,'Value of '+name+' invalid in '+abort
value = value + strmid( test, next_char, endap-next_char )
; Test to see if the next character is also an apostrophe. If so, then the
; string isn't completed yet. Apostrophes in the text string are signalled as
; two apostrophes in a row.
if strmid( test, endap+1, 1) EQ "'" then begin
value = value + "'"
next_char = endap+2
goto, NEXT_APOST
endif
; Extract the comment, if any
slash = strpos( test, "/", endap )
if slash LT 0 then comment = '' else $
comment = strmid( test, slash+1, strlen(test)-slash-1 )
; This is a string that could be continued on the next line. Check this
; possibility with the following four criteria: *1) Ends with '&'
; (2) Next line is CONTINUE (3) LONGSTRN keyword is present (recursive call to
; SXPAR) 4. /NOCONTINE is not set
if ~keyword_set(nocontinue) then begin
off++
val = strtrim(value,2)
if (strlen(val) gt 0) && $
(strmid(val, strlen(val)-1, 1) EQ '&') && $
(strmid(hdr[nfound[i]+off],0,8) EQ 'CONTINUE') then $
if ~array_equal(keyword EQ 'LONGSTRN',0b) then begin
value = strmid(val, 0, strlen(val)-1)
test = hdr[nfound[i]+off]
test = strmid(test, 8, strlen(test)-8)
test = strtrim(test, 2)
if strmid(test, 0, 1) NE "'" then message, $
'ERROR: Invalidly CONTINUEd string in '+ abort
next_char = 1
GOTO, NEXT_APOST
ENDIF
ENDIF
; Process non-string value
endif else begin
test = svalue[i]
slash = strpos( test, "/" )
if slash GT 0 then begin
comment = strmid( test, slash+1, strlen(test)-slash-1 )
test = strmid( test, 0, slash )
end else comment = ''
; Find the first word in TEST. Is it a logical value ('T' or 'F')
test2 = test
value = gettok(test2,' ')
if ( value EQ 'T' ) then value = 1b else $
if ( value EQ 'F' ) then value = 0b else begin
; Test to see if a complex number. It's a complex number if the value and
; the next word, if any, are both valid values.
if strlen(test2) EQ 0 then goto, NOT_COMPLEX
value2 = gettok( test2, ' ')
if value2 EQ '' then goto, NOT_COMPLEX
On_ioerror, NOT_COMPLEX
value2 = float(value2)
value = complex(value,value2)
goto, GOT_VALUE
; Not a complex number. Decide if it is a floating point, double precision,
; or integer number.
NOT_COMPLEX:
On_IOerror, GOT_VALUE
if (strpos(value,'.') GE 0) || (strpos(value,'E') GT 0) $
|| (strpos(value,'D') GE 0) then begin ;Floating or double?
if ( strpos(value,'D') GT 0 ) || $ ;Double?
( strlen(value) GE 8 ) then value = double(value) $
else value = float(value)
endif else begin ;Long integer
lmax = 2.0d^31 - 1.0d
lmin = -2.0d^31 ;Typo fixed Feb 2010
value = double(value)
if (value GE lmin) && (value LE lmax) then $
value = long(value)
endelse
GOT_VALUE:
On_IOerror, NULL
endelse
endelse; if c eq apost
; Add to vector if required
if vector then begin
if ( i EQ 0 ) then begin
maxnum = max(number)
dtype = size(value,/type)
result = make_array( maxnum, TYPE = dtype )
comments = strarr( maxnum )
endif
if size(value,/type) GT dtype then begin ;Do we need to recast?
result = result + 0*value
dtype = size(value,/type)
endif
result[ number[i]-1 ] = value
comments[ number[i]-1 ] = comment
endif else $
comments = comment
endfor
if vector then begin
!ERR = matches
return, result
endif else !ERR = 0
endif else begin
if abort_return then message,'Keyword '+nam+' not found in '+abort
!ERR = -1
endelse
return, value
END