Viewing contents of file '../idllib/iuedac/iuelib/pro/exmelo.pro'
;******************************************************************************
;+
;*NAME:
;
; EXMELO (RDAF General Production Library ) DECEMBER 15, 1981
;
;*CLASS:
;
; Spectral Extraction
;
;*CATEGORY:
;
;*PURPOSE:
;
; Procedure to extract flux data from a line-by-line spatially
; resolved IUE image file.
;
;*CALLING SEQUENCE:
;
; EXMELO,IMAGET,PARAM,H,WAVE,GROSS,BACK,NET,ABSCAL,EPS
;
;*PARAMETERS:
;
; IMAGET (REQ) (I) (1) (S)
; The input file name (e.g. swp1234s). May include path.
;
; PARAM (REQ) (I) (0/1) (I)
; Scalar or vector:
; Scalar: Default parameters
; = 2 : Point source small aperture
; = 1 : Point source large aperture
; = 0 : Extended source
;
; Vector: Param(0) = center line number
; Param(1) = gross width
; Param(2) = background width
; Param(3) = distance between gross & background
; Param(4) = median filter width
; Param(5) = mean filter width
;
; H (REQ) (O) (1) (L)
; Vector containing the header scale factor record (0).
;
; WAVE (REQ) (O) (1) (R)
; Vector containing the wavelengths.
;
; GROSS (REQ) (O) (1) (R)
; Vector containing the gross flux data.
;
; BACK (REQ) (O) (1) (R)
; Vector containing the background flux data.
;
; NET (REQ) (O) (1) (R)
; Vector containing the derived net flux data.
;
; ABSCAL (REQ) (O) (1) (R)
; Vector containing the absolute calibrated net flux data.
;
; EPS (REQ) (O) (1) (R)
; Vector containing the quality flags.
;
;*EXAMPLES:
;
; To customize an extraction:
;
; P=FLTARR(6) ;DEFINE ARRAY
; READ,P ;ENTER VALUES
; ? 28 5 5 15 60 30
; EXMELO,'SWP11225S',P,H,WAVE,GROSS,BCKGRD,NET,ABS,EPS
;
;*SYSTEM VARIABLES USED:
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
; PARCHECK
; PCHECK
; CALIB
;
;*FILES USED:
;
; The data is extracted from an ELBL (LBLS) file with the name IMAGET.
;
;*SIDE EFFECTS:
;
;*NOTES:
;
; The defaults for an LBLS file (processed prior to 1 October
; 1985) for a scalar PARAM in lines are:
; Parameter 0 1 2
; gross center 28 28 28
; gross width 15 9 9
; bkg width 5 5 5
; bkg distance 11 11 8
;
; The default values of a scalar PARAM for ELBL (after 1 October
; 1985) are:
;
; Parameter 0 1 2
; gross center 56 56 56
; gross width 30 18 18
; bkg width 10 10 10
; bkg distance 22 22 16
;
; The default values for the median and mean filter widths are
; derived from the length of the vector. If the data vector
; is 600 or less samples long the defaults are median width
; of 31 and mean width of 15. Longer vectors give defaults
; of 63 for the median and 31 for the mean filter widths.
; The background vector has been extended by the first and last
; value by an amount equal to the largest filter width before
; either filtering is done.
;
; When widths are specified as even numbers, the extraction
; slit is centered half an order below the specified center.
;
; tested with IDL Version 2.2.0 (sunos sparc) 22 Nov 91
; tested with IDL Version 2.2.0 (ultrix mispel) N/A
; tested with IDL Version 2.2.0 (vms vax) 22 Nov 91
;
;*PROCEDURE:
;
; Extract the appropriate data from the
; ELBL file:
; Wavelength
; Gross Flux
; Background Flux
; Epsilon vector
;
; Calculate the NET flux by smoothing the background with both a
; MEDIAN and a BOX filter and subtracting the result from the
; gross flux.
; Calculate the ABSCAL flux using CALIB with an assumed exposure
; time of one second.
;
;*MODIFICATION HISTORY:
;
; Version 0 F.H. Schiffer 3rd 15-Dec-1981 derived from MAKEESLO
; Copied into IUER_PROD: BY RWT 1-16-84 (SEE SMR#5) version 3
; 12-March-1982 F.H. Schiffer 3rd ER#012 Correct default values
; 26-May-1982 F.H. Schiffer 3rd CR#035 Extend background
; ER#022 Exposure time
; Modified GSFC RDAF 19APR85 - to be compatible with XIDL -variable
; TIME changed to ITIME and reference to MEDIAN changed to GMEDIAN.
; 30-Oct-1985 C.A. Grady Modified default values to handle
; extended line by line data.
; 4-24-87 RWT add PARCHECK, remove INSERT and EXTRACTs, & use vector
; assignment statements.
; 1-20-88 RWT add procedure call listing and use GET_LUN
; 2-23-88 RWT remove subroutine ESPARAM
; 5-12-88 HAA add RDAF Prolog
; 1-24-89 RWT expand prolog info
; 8-16-89 RWT rename EXMELO
; 9-07-89 RWT Unix mods: replace GMEDIAN with intrinsic MEDIAN,
; remove LOOKUP commands, correct prolog info,
; 4-10-91 KBC modify filename structure based on operating system type
; for compatibility on SUN/DEC/VAX
; 7-24-91 PJL cleaned up; changed logical; tested on SUN and VAX;
; updated prolog
; 9-13-91 PJL corrected file equals statement for SUN; updated
; prolog; tested on SUN and VAX
; 22 Nov 91 GRA removed IUER_USERDATA logical; added decompose so
; imaget may include path; tested; updated prolog.
;
;-
;*******************************************************************
pro exmelo,imaget,param,h,wave,gross,back,net,abscal,eps
;
npar = n_params(0)
if npar eq 0 then begin
print,' EXMELO,IMAGET,PARAM,H,WAVE,GROSS,BACK,NET,ABSCAL,EPS'
retall
endif ; npar
parcheck,npar,9,'EXMELO'
pcheck,imaget,1,100,1000
pcheck,param,2,110,0011
;
; open input file and extract header
;
decompose,imaget,disk,path,name,extn,vers
file = disk + path + name + '.dat' + vers
;
openr,/GET_LUN,un,file
linein = assoc(un,intarr(10))
h = linein(0) ; header vector
ns = h(1) ; no. of samples
linein = assoc(un,intarr(ns)) ; redefine record
h = linein(0) ; new header
ngrp = h(5) ; no. records/group (line)
npnts = h(300) ; no. of points
;
; get parameters
;
s = size(param)
if s(0) eq 0 then begin ; scalar param use default values
n = h(2) / 55 ; scale for elbl-type files
h([57,86])= [500*n,28*n] ; bkg width & data location
h(400) = 900*n*(param ge 1) + 1500*n*(param lt 1) ; extract width
h(58) = 1100*n*(param le 1) + 800*n*(param gt 1) ; bkg distance
h(87) = 15 + 16*(h(1) gt 600) ; filter widths
h(88) = 2 * h(87) + 1
endif else begin ; vector input use user input values
p = fix(param)
h([57,58,86,87,88,400]) = [p(2)*100,p(3)*100,p(0),p(5),p(4),p(1)*100]
endelse ; s(0)
center=h(86) & gwidth=h(400)/100
bwidth=h(57)/100 & dist=h(58)/100
menwth=h(87) & medwth=h(88)
;
; wavelength vector
;
wave=linein(1)/5. ; assume low dispersion
wave = wave(0:npnts-1)
;
; gross flux - extract, total, scale to integer
;
gross=fltarr(ns)
factin=h(20)*2.^(-h(21))
beg=center-gwidth/2 & endd=beg+gwidth-1
for i=beg,endd do gross=gross+linein(i*ngrp)*factin
gross = gross(0:npnts-1)
;
; get epsilon : min epsilon for gross
;
eps=intarr(ns)+1000
for i=beg,endd do eps=eps<linein(i*ngrp-1)
eps = eps(0:npnts-1)
;
; background flux - extract & total good points
;
beg=center-dist-bwidth/2 & endd=beg+bwidth-1
back=fltarr(ns)
count=back
for i=beg,endd do begin ; get background
j=i+dist+dist
back=back+linein(i*ngrp)*(linein(i*ngrp-1) ge 0)
back=back+linein(j*ngrp)*(linein(j*ngrp-1) ge 0)
count=count+(linein(i*ngrp-1) ge 0) + (linein(j*ngrp-1) ge 0)
endfor ; i
back = back(0:npnts-1) * factin
;
; normalize to gross
;
back=back*gwidth/(count + (count eq 0)) ; normalize
;
; filter background - subtract from gross to get net
;
npad=medwth>menwth
intmed = back(indgen(npnts+npad+npad)-npad)
if medwth gt 1 then intmed = median(intmed,medwth)
if menwth gt 1 then intmed=smooth(smooth(intmed,menwth),menwth)
if menwth lt -1 then intmed=smooth(intmed,-menwth)
net = gross - intmed(npad:npnts+npad-1)
;
; compute absolute calibrated assume unity exposure time
;
tim = h(39:41) ; save exposure time
calib,h,wave,net,1.,abscal
h(39) = tim ; restore exposure time
;
; fix up the header record
;
h(100:399) = 0
h([2,5,100,200,300]) = [1,6,0,1,npnts]
;
; finish up
;
free_lun,un
return
end ; exmelo