function uly_spect_filefmt, hdr, FILE=file
if size(hdr,/TYPE) ne 7 or n_elements(hdr) le 1 then begin
fits_read, file, data, hdr, MESS=mess
if mess ne '' then begin
message, mess, /INFO
return, 0
endif
endif
if sxpar(hdr, 'NAXIS') gt 1 then begin
array = sxpar(hdr, 'ARRAY*', COUNT=cnt1)
naxis = sxpar(hdr, 'NAXIS*', COUNT=cnt2)
ns = sxpar(hdr, 'NAXIS'+strtrim(cnt2,2))
if cnt1 gt 0 and ns ge cnt1 then return, 1
endif
if strtrim(sxpar(hdr, 'XTENSION')) eq 'BINTABLE' then begin
return, 2
endif
if sxpar(hdr, 'NAXIS') le 3 then begin
return, 3
endif
return, 0
end
function uly_spect_read_sdss, data, h, ERR_SP=err_sp, SNR_SP=snr_sp, QUIET=quiet
if not keyword_set(quiet) then message, /INFO, 'SDSS style (< DR9)'
array = strtrim(sxpar(h, 'ARRAY*', COUNT=ca), 2)
if ca gt 0 then begin
n1 = where (array eq 'DATA' or array eq 'SPECTRUM')
n2 = where (array eq 'ERROR')
n3 = where (array eq 'MASK')
n4 = where (array eq 'WAVELEN')
endif else begin
naxi = sxpar(h, 'NAXIS')
naxl = sxpar(h, 'NAXIS'+strtrim(naxi,2))
if naxl gt 0 then n1 = 0 else n1 = -1
if naxl gt 1 then n2 = 0 else n2 = -1
n3 = -1
n4 = -1
if not keyword_set(quiet) then begin
message, /INFO, 'There is no ARRAYn keywords in the header, assume that the first line is DATA and second ERROR'
endif
endelse
sampling = -1
vacuum = 0
if n4 lt 0 then begin
ctype = sxpar(h,'CTYPE1')
if strmid(ctype,0,4) eq 'WAVE' then vacuum = 1
if sxpar(h, 'VACUUM') eq 1 then vacuum = 1
if strmid(ctype,0,4) eq 'WAVE' or strmid(ctype,0,4) eq 'AWAV' then begin
if strmid(ctype,5,3) eq 'WAV' or strmid(ctype,5,3) eq ' ' then begin
sampling = 0
endif else if strmid(ctype,5,3) eq 'LOG' then begin
sampling = 1
endif
endif
step = double(string(sxpar(h,'CD1_1',COUNT=count)))
if count eq 0 then begin
step = double(string(sxpar(h,'CDELT1',COUNT=count)))
endif
if count eq 0 then message, 'Cannot decode the WCS'
crpix = double(string(sxpar(h,'CRPIX1',COUNT=count))) - 1d
if count eq 0 then crpix = 0d
start = double(string(sxpar(h,'CRVAL1', COUNT=count))) - crpix*step
if count eq 0 then message, 'Cannot decode the WCS'
if sampling lt 0 then begin
if start le 4 then begin
sampling = 1
start *= alog(10d)
step *= alog(10d)
if not keyword_set(quiet) then $
message, /INFO, 'Assume that the sampling is in log10'
endif else if start le 9 then begin
sampling = 1
if not keyword_set(quiet) then $
message, /INFO, 'Assume that the sampling is in ln'
endif else begin
sampling = 0
if not keyword_set(quiet) then $
message, /INFO, 'Assume that the sampling is linear in wavelength'
endelse
endif
if vacuum eq 1 then begin
if not keyword_set(quiet) then $
message, /INFO, 'Wavelength in VACUUM ... approximately converted'
if sampling eq 0 then begin
start /= 1.00028d
step /= 1.00028d
endif else if sampling eq 1 then start -= 0.00028D
endif
endif else sampling = 2
ndim = size(data,/N_DIM)
dim = size(data, /DIM)
if ndim gt 1 then begin
narray = dim[ndim-1]
dim = dim[0:ndim-2]
tot = product(dim)
data = reform(data, tot, narray, /OVER)
endif
spect = uly_spect_alloc(START=start, STEP=step, SAMP=sampling, HEADER=h)
sxdelpar, *spect.hdr, ['VACUUM', 'CTYPE1', 'CRVAL1', 'CDELT1', 'CD1_1', 'CRPIX1', 'DC-FLAG', 'WAT0_*', 'WAT1_*', 'WFITTYPE', 'ARRAY'+strtrim(indgen(n_elements(array))+1,2), ['NAXIS', 'CTYPE', 'CUNIT'] + strtrim(ndim,2)]
if n1 ge 0 then *spect.data = reform(data[*,n1], dim)
if n2 ge 0 then *spect.err = reform(data[*,n2], dim)
if n3 ge 0 then begin
m = where(finite(data[*,n3]) eq 1, cnt)
if cnt gt 0 then begin
m = where(data[*,n3] ne 0 and data[*,n3] ne 1, cnt)
if cnt gt 0 then begin
message, /INFO, $
'The mask is not made of 0 and 1s ... it is ignored'
message, /INFO, ' (a standard mask has 0=bad, 1=good)'
endif else $
*spect.goodpix = where(data[*,n3] gt 0)
endif
endif
if n4 ge 0 then *spect.wavelen = reform(data[*,n4], dim)
if n_elements(*spect.err) gt 0 then begin
if n_elements(*spect.goodpix) eq 0 then $
m = where(*spect.err le 0, cnt, COMP=g) $
else m = where((*spect.err)[*spect.goodpix] le 0, cnt, COMP=g)
if cnt gt 0 then begin
if not keyword_set(quiet) then $
message, /INFO, 'Pixels with 0 or negative errors were masked'
if n_elements(*spect.goodpix) eq 0 then *spect.goodpix = g $
else *spect.goodpix = [*spect.goodpix, g]
endif
endif
dof_factor = double(string(sxpar(h, 'DOF_FACT', COUNT=count)))
if count eq 1 then spect.dof_factor = dof_factor
return, spect
end
function uly_spect_read_tbl, data, h, ERR_SP=err_sp, SNR_SP=snr_sp, QUIET=quiet
if tag_exist(data, 'SPEC') then flux = data.spec $
else if tag_exist(data, 'FLUX') then flux = data.flux
if tag_exist(data, 'IVAR') then begin
zeros = where(data.ivar eq 0, cnt, compl=goodpix)
if cnt gt 0 then data.ivar[zeros] = 1
err = 1d/sqrt(data.ivar)
endif $
else if tag_exist(data, 'error') then err = data.error
if tag_exist(data, 'ORMASK') then begin
m = where(finite(data.ormask) eq 1, cnt)
goodpix = where(data.ormask eq 0)
message, /INFO, $
'DEIMOS Mask 0=good, 1=bad'
endif
if tag_exist(data, 'LAMBDA') then wave = data.lambda
if tag_exist(data, 'WAVE') then wave = data.wave
if tag_exist(data, 'LOGLAM') then begin
if not keyword_set(quiet) then begin
message, /INFO, 'SDSS DR9: (1) Sampling is in log10, (2) Wavelength in VACUUM ... approximately converted'
endif
start = (data.loglam)[0] * alog(10d) - 0.00028D
step = ((data.loglam)[1] - (data.loglam)[0]) * alog(10d)
sampl = 1
return, uly_spect_alloc(DATA=flux, START=start, STEP=step, ERR=err, SAMP=1)
endif $
else return, uly_spect_alloc(DATA=flux, WAVELEN=wave, ERR=err, GOODPIX=goodpix, SAMP=2)
end
function uly_spect_read_lss, data, h, DISP_AXIS=disp_axis, QUIET=quiet
SignalLin = uly_spect_alloc(DATA=data, HEAD=h)
naxis = sxpar(h, 'NAXIS')
disp_type = -1
if n_elements(disp_axis) le 0 then disp_axis = 0
vacuum = 0
if disp_axis le 0 then begin
ctype = sxpar(h,'CTYPE*',COUNT=cnt)
if cnt gt 0 then begin
if ctype[0] eq 'WAVE-WAV' then begin
creator = sxpar(h,'CREATOR', COUNT=count)
if count gt 0 and creator eq 'Pleinpot 1' then ctype = 'AWAV'
endif
disp_axis = 1 + where(strtrim(ctype,2) eq 'WAVE' or strmid(ctype,0,5) eq 'WAVE-')
if disp_axis gt 0 then begin
if not keyword_set(quiet) then $
message, /INFO, 'Dispersion axis is '+strtrim(disp_axis[0],2)+' (Vacuum wavelength)'
vacuum = 1
endif
endif
endif
if disp_axis le 0 then begin
disp_axis = 1 + where((strmid(ctype,0,4) eq 'AWAV') eq 1)
if disp_axis gt 0 then begin
if not keyword_set(quiet) then $
message, /INFO, 'Dispersion axis is '+strtrim(disp_axis[0],2)+' (Air wavelength)'
if max(strmid(ctype[disp_axis-1],5,3) eq [' ', 'WAV']) then begin
disp_type = 0
if not keyword_set(quiet) then message, /INFO, 'Dispersion axis is linear'
endif else if strmid(ctype[disp_axis-1],5,3) eq 'LOG' then begin
disp_type = 1
if not keyword_set(quiet) then $
message, /INFO, 'Dispersion axis is logarithmic'
endif
endif
endif
if disp_axis eq 0 then begin
disp_axis = 1
if naxis gt 1 and not keyword_set(quiet) then $
message, 'Assume that the dispersion axis is 1 (X)'+$
'(use the keyword DISP_AXIS to set it differently)', /INFO
endif else $
if disp_axis eq 2 then *SignalLin.data = transpose(*SignalLin.data)
ax = strtrim(disp_axis[0],2)
crval = double(string(sxpar(h,'CRVAL'+ax)))
if disp_type lt 0 then begin
disp_type = 0
if crval lt 10 then begin
disp_type = 1
if crval lt 5 then begin
if not keyword_set(quiet) then $
print, 'Assume that the dispersion is in log10',crval,'CRVAL'+ax
endif else if not keyword_set(quiet) then $
message, /INFO, 'Assume that the dispersion is in log (air wavelength)'
endif else if not keyword_set(quiet) then $
message, /INFO, 'Assume that the dispersion is linear (air wavelength)'
endif
if disp_type ne 0 and disp_type ne 1 then $
message, 'Do not handle this sampling (yet)'
cdelt = double(string(sxpar(h,'CD'+ax+'_'+ax, COUNT=count)))
if count eq 0 then cdelt = double(string(sxpar(h,'CDELT'+ax)))
crpix = double(sxpar(h, 'CRPIX'+ax, COUNT=count))
if count eq 0 then crpix = 1d
crval = crval - (crpix - 1d) * cdelt
if (cdelt le 0.) or (crval le 0.) then $
message,'WCS of the observations not set correctly'
if disp_type eq 1 and crval lt 5 then begin
if not keyword_set(quiet) then $
print, 'Convert axis scale from log10 to log'
crval *= alog(10d)
cdelt *= alog(10d)
endif
if vacuum eq 1 then begin
if not keyword_set(quiet) then $
print, 'Wavelength in VACUUM ... approximately converted'
if disp_type eq 0 then begin
crval /= 1.00028d
cdelt /= 1.00028d
endif else if disp_type eq 1 then crval -= 0.00028D
endif
SignalLin.sampling = disp_type
SignalLin.start = crval
SignalLin.step = cdelt
dof_factor = double(string(sxpar(h, 'DOF_FACT', COUNT=count)))
if count eq 1 then SignalLin.dof_factor = dof_factor
*SignalLin.hdr = h[3:*]
sxdelpar, *SignalLin.hdr, $
['NAXIS1', 'CRVAL1', 'CRPIX1', 'CD1_1', 'CDELT1', 'CTYPE1', 'CROTA1', $
'CD2_1', 'CD1_2', 'DATAMIN', 'DATAMAX', 'CHECKSUM' $
]
return, SignalLin
end
function uly_spect_read, file_in, lmin, lmax, $
VELSCALE=velscale, SG=sg, $
ERR_SP=err_sp, SNR_SP=snr_sp, MSK_SP=msk_sp, $
DISP_AXIS=disp_axis, FORMAT=format, QUIET=quiet
if size(file_in, /TYPE) ne 3 and size(file_in, /TYPE) ne 7 then begin
print, 'usage: ULY_SPECT_READ <filename>, ...'
print, 'first argument must be a file name or unit number'
return, 0
endif
file_inl = file_in
if size(file_in, /TYPE) eq 7 then begin
if file_test(file_in) ne 1 then begin
file_inl += '.fits'
if file_test(file_inl) ne 1 then begin
print, 'usage: ULY_SPECT_READ <filename>, ...'
print, 'Error, file does not exist (' + file_in + ')'
return, 0
endif
endif
endif
if n_elements(sg) eq 1 then begin
if abs(sg) gt 10 then message, /INFO, $
'Note that the SG (redshift) has an odd value: '+strtrim(sg,2)+$
' is it correct? (it should be a "z", not a "cz")'
endif
naxis = 0
nhdu = 0
status = 0
while naxis eq 0 and status eq 0 do begin
data = mrdfits(file_inl, nhdu, h, /SILENT, STATUS=status)
if n_elements(h) eq 0 then begin
print, 'Cannot access to the data in the file (invalid format?)'
return, 0
endif
naxis = sxpar(h,'NAXIS')
nhdu++
endwhile
if status ne 0 then begin
print, 'Could not find a valid HDU in ', file_inl
return, 0
endif
if n_elements(format) eq 0 then fmt = uly_spect_filefmt(h) $
else fmt = format
case fmt of
1 : spect = uly_spect_read_sdss(data, h, ERR_SP=err_sp, SNR_SP=snr_sp, QUIET=quiet)
2 : spect = uly_spect_read_tbl(data, h, ERR_SP=err_sp, SNR_SP=snr_sp, QUIET=quiet)
3 : spect = uly_spect_read_lss(data, h, DISP_AXIS=disp_axis, QUIET=quiet)
else : begin
print,'Could not recognize the format of FITS file'
return, uly_spect_alloc(TITLE=file_in)
end
endcase
ntot = n_elements(*spect.data)
if ntot eq 0 then begin
print, 'No data read from FITS file'
return, spect
endif
spect.title = file_in
if n_elements(err_sp) gt 0 then begin
testfile = FILE_INFO(err_sp)
if testfile.exists eq 1 then begin
fits_read, err_sp, *spect.err, h_err
if disp_axis eq 2 then err = transpose(err)
endif else $
message, 'File:' + err_sp + ' does not exsists...'
for i=0,n_elements((*spect.err)[0,*])-1 do begin
nans = where(finite((*spect.err)[*,i]) eq 0, cnt, COMP=fin)
if cnt ne 0 then $
if n_elements(fin) ne 1 then $
(*spect.err)[nans,i] = max((*spect.err)[fin,i]) else $
(*spect.err)[nans,i] = max((*spect.err)[*,i-1])
endfor
endif else if keyword_set(snr_sp) then begin
testfile = FILE_INFO(snr_sp)
if testfile.exists eq 1 then begin
fits_read, snr_sp, err
if disp_axis eq 2 then err = transpose(err)
*spect.err = *spect.data / err
endif else $
message, 'SNR spectrum file not valid'
for i=0,n_elements((err)[0,*])-1 do begin
neg = where(err[*,i] le 0, c, COMPLEM=pos)
if c gt 0 then begin
err[neg] = 1
em = 10 * max((*spect.err)[pos,i])
(*spect.err)[neg,i] = em
message, 'The SNR spectrum '+strtrim(string(i),2)+ ' has '+strtrim(string(c),2)+$
' negative or null values. Their error is set to '+$
strtrim(string(em),2), /INFO
endif
nans = where(finite((*spect.err)[*,i]) eq 0, cnt, COMP=fin)
if cnt ne 0 then (*spect.err)[nans,i] = max((*spect.err)[fin,i])
endfor
endif
if n_elements(msk_sp) gt 0 then begin
message, 'Read MASK spectrum ... NOT YET IMPLEMENTED'
endif
if n_elements(sg) gt 0 then begin
z1 = 1d + sg
case spect.sampling of
0 : begin
spect.start /= z1
spect.step /= z1
end
1 : spect.start -= alog(z1)
2 : *spect.wavelen /= z1
endcase
endif
if n_elements(lmin) gt 0 or n_elements(lmax) gt 0 then begin
wr = uly_spect_get(spect, /WAVERANGE)
if n_elements(lmin) gt 0 then wr[0] = min(lmin)
if n_elements(lmax) gt 0 then wr[1] = max(lmax)
if n_elements(velscale) eq 1 then begin
wr[0] *= 1D - velscale/299792.458D/2D
wr[1] *= 1D + velscale/299792.458D/2D
endif
spect = uly_spect_extract(spect, WAVERANGE=wr, /OVERWRITE)
endif
ntot = n_elements(*spect.data)
good = where(finite(*spect.data), cnt, COMPLEM=nans, NCOMPLEM=nnans)
if nnans gt 0 then begin
if not keyword_set(quiet) then $
print, 'The input spectrum contains'+string(n_elements(nans))+' NaNs ...'
if n_elements(*spect.goodpix) eq 0 then *spect.goodpix = good $
else begin
maskI = bytarr(ntot)
maskI[*spect.goodpix] = 1
maskI[nans] = 0
*spect.goodpix = where(maskI eq 1)
endelse
next = nans+1
if next[n_elements(next)-1] eq n_elements(*spect.data) then $
next[n_elements(next)-1] = nans[n_elements(next)-1]
(*spect.data)[nans] = (*spect.data)[next]
nans = where(finite(*spect.data) eq 0, cnt)
if cnt gt 0 then begin
prev = nans - 1
if prev[0] lt 0 then prev[0] = nans[1]
(*spect.data)[nans] = (*spect.data)[prev]
endif
nans = where(finite(*spect.data) eq 0, cnt)
if cnt gt 0 then (*spect.data)[nans] = 0
endif
if n_elements(*spect.err) gt 0 then begin
good = where(finite(*spect.err), cnt, COMPLEM=nans)
if cnt eq 0 then begin
if not keyword_set(quiet) then begin
message, /INFO, 'The error spectrum does not contain finite values'+$
'... ignore it (ie. do as if no errors were given)'
endif
undefine, *spect.err
endif else if cnt lt n_elements(*spect.err) then begin
if not keyword_set(quiet) then $
message, /INFO, 'The input spectrum contains'+string(n_elements(nans))+' NaNs ...'
if n_elements(*spect.goodpix) eq 0 then *spect.goodpix = good $
else begin
maskI = bytarr(ntot)
maskI[*spect.goodpix] = 1
maskI[nans] = 0
*spect.goodpix = where(maskI eq 1, cnt)
if cnt eq 0 then begin
if not keyword_set(quiet) then message, /INFO, $
'No good pixels would be left after applying the MASK ... ignore the mask'
undefine, *spect.goodpix
endif
endelse
next = nans + 1
if next[n_elements(next)-1] eq n_elements(*spect.err) then begin
if n_elements(nans) gt 1 then begin
nans = nans[0:n_elements(nans)-2]
next = next[0:n_elements(nans)-1]
endif else next = nans
endif
(*spect.err)[nans] = (*spect.err)[next]
nans = where(finite(*spect.err) eq 0, cnt)
if cnt gt 0 then begin
prev = nans - 1
if prev[0] lt 0 then begin
nans = nans[1:*]
prev = prev[1:*]
endif
(*spect.err)[nans] = (*spect.err)[prev]
endif
nans = where(finite(*spect.err) eq 0, cnt)
if cnt gt 0 then (*spect.err)[nans] = 0
endif
endif
if n_elements(velscale) ne 0 then begin
if n_elements(lmin) eq 0 then $
spect = uly_spect_logrebin(spect, velscale, /OVER) $
else $
spect = uly_spect_logrebin(spect, velscale, WAVERANGE=lmin[0], /OVER)
endif
ntot = n_elements(*spect.data)
dim = size(*spect.data, /DIM)
npix = (size(*spect.data))[1]
Pix_gal = spect.start + lindgen(npix) * spect.step
if n_elements(lmin) eq 0 then lmn = [spect.start] else begin
lmn = lmin
if spect.sampling eq 1 then lmn = alog(lmn)
endelse
if n_elements(lmax) eq 0 then lmx = [spect.start+spect.step*(npix-1)] else begin
lmx = lmax
if spect.sampling eq 1 then lmx = alog(lmx)
endelse
good = 0L
for i = 0, n_elements(lmn) - 1 do begin
good = [good, $
where((Pix_gal gt lmn[i]) and (Pix_gal lt lmx[i]))]
endfor
if (n_elements(*spect.goodpix) eq 0) and (n_elements(good) gt 1) then begin
maskI = bytarr(ntot)
maskI = reform(maskI, dim)
maskI[good[1:*], *] = 1
*spect.goodpix = where(maskI eq 1)
endif else begin
maskI = bytarr(ntot)
maskI[*spect.goodpix] = 1
maskI = reform(maskI, dim)
maskI[good[1:*],*] += 1
*spect.goodpix = where(maskI eq 2)
endelse
sxaddpar, *spect.hdr, 'HISTORY', 'uly_spect_read, '''+strtrim(file_in,2)+'''
return, spect
end
Part of