Viewing contents of file '../idllib/iuedac/iuelib/pro/boxcar.pro'
;+*****************************************************************************
;
;*NAME:
;
;      boxcar
;
;*CATEGORY:
;
;      NEWSIPS, IUESIPS
;
;*CALLING SEQUENCE:
;
;      BOXCAR,IMAGET,object,bckgd,h,w,g,b,n,f,q,/extended,/small,$
;             medianw=medianw,meanw=meanw,expt=expt,/melo,/fits,/chebyshev
;
;*PURPOSE:
;
;      To extract a calibrated single spectrum from a line-by-line file.
;
;*PARAMETERS:
;
;      IMAGET  (req) (i) (0) (s)
;              Name of SILO, ELBL, LBLS, or ESSR file to be processed.
;
;      object  (opt) (i) (0,1) (ifldb)
;              This should be a two-element vector giving the starting and
;              ending line numbers, INCLUSIVE, of the object slit.  To use
;              defaults it can be left out, but if you want to use defaults
;              and specify the background slit explicitly, you can enter zero.
;              You may, if you wish, specify more than two elements, in which
;              case they are considered to be the EXACT lines to include in 
;              the boxcar (this allows you to exclude lines).  You can also
;              specify one non-zero number which will be considered the central
;              line of the slit, with a default width depending on the image.
;
;          NOTE:  Line numbers start with ONE!
;
;       bckgd  (opt) (i) (0,1) (ifldb)
;              This is normally a four element vector giving the starting and
;              ending line numbers, INCLUSIVE, for two background regions.  If
;              there are more than four elements, they are considered to be the
;              EXACT lines to include.
;
;           h  (opt) (o) (1) (si)
;              This will either be a FITS header (SILO file) or the scale
;              factor record (IUESIPS files).  If the FITS keyword is set,
;              the IUESIPS scale factor record will be converted to a FITS
;              header.
;
;           w  (opt) (o) (1) (f)
;              Wavelengths.
;
;           g  (opt) (o) (1) (f)
;              Gross fluxes in object slit.
;
;           b  (opt) (o) (1) (f)
;              Background fluxes.
;
;           n  (opt) (o) (1) (f)
;              Net fluxes.
;
;           f  (opt) (o) (1) (f)
;              Calibrated fluxes.
;
;           q  (opt) (o) (1) (i)
;              Quality flags.  If the input file was IUESIPS, these will be 
;              the minimum epsilon values in the object slit.  If the input 
;              file was NEWSIPS, these will be coalesced nu flags (from the
;              object slit).
;
;    extended  (key) (i) (0) (i)
;              If set, the object is assumed to be an extended source.  Default
;              is point source. This only matters if you are using default
;              values for object slit for IUESIPS data.
;
;       small  (key) (i) (0) (i)
;              If set, small aperture is assumed.  Default is large aperture.
;              This only matters if you are using defaults for object and/or
;              background slits for NEWSIPS data.
;
;     medianw  (key) (i) (0) 
;              Median filter width.  Default is 63 for ELBL file, 31 for 
;              ESSR files, and 1 for SILO files
;              
;
;       meanw  (key) (i) (0)
;              Mean filter width.  Default is 31 for ELBL files, 15 for 
;              ESSR files, and 1 for SILO files.
;
;   chebyshev  (key) (i) (0)
;              If set, no median and mean filtering will be done.  Instead,
;              a sixth order Chebyshev polynomial will be fit to the background.
;
;        expt  (key) (i) (0)
;              Exposure time in seconds (IUESIPS).  If not given, h(39:41)
;              will be used.  Ignored for NEWSIPS (since newcalib uses
;              the effective exposure from the input FITS header).
;
;        melo  (key) (i) (0) 
;              If input file was IUESIPS, "melo" format output files will
;              be written (.DAT and .LAB).  Ignored for NEWSIPS.
;
;        fits  (key) (i) (0)
;              Regardless of input file type, a FITS file will be written, with
;              filename cam+image.B+ap+F (e.g., swp12345.b1f) where ap will be
;              1 for the large aperture and 2 for the small aperture.  The H
;              parameter returned will be the FITS header.  Note that, for 
;              IUESIPS data, if there are entries missing from the scale factor
;              record, the user may be prompted for such things as exposure 
;              times, THDA values, etc, since the full range of corrections
;              (as done by IUESPEC) will be done.
;
;
;*EXAMPLES:
;
;      Extract a SILO file with default slit dimensions (but without background 
;      smoothing):
;               boxcar,'swp1234.silo',0,0,h,w,g,b,n,f,q
;
;      Same as above but use a 6th-order chebyshev fit to background and
;      write results to a FITS file:
;               boxcar,'swp1234.silo',0,0,h,w,g,b,n,f,q,/chebyshev,/fits
;
;      Change object (i.e., gross) slit length to extract lines 41 to 53 
;      (instead of default lines 45 to 57):
;               boxcar,'swp1234.silo',[41,53,0,h,w,g,b,n,f,q
;
;      extract an iuesips file and output a melo-like file using an exposure
;      time of 28,400 seconds:
;               boxcar,'swp1234llg',0,0,h,w,g,b,n,f,q,/melo,expt=28400
;  
;
;*FILES USED:
;
;      IMAGET:  SILO, ELBL, LBLS, or ESSR file to extract data from.  SILO
;               files are the NEWSIPS line-by-line files; the others are from
;               various incarnations of IUESIPS.  Generally, ELBL files have
;               110 lines and LBLS/ESSR have 55.  ESSR files have half as
;               many samples as the others in addition to only having 55 lines.
;               IUESIPS files are expected to be in RDAF (.dat and .lab) format.
;
;*SUBROUTINES CALLED:
;
;      parcheck   (checks for proper number of parameters in calling sequence)
;      decompose  (separate file name into components)
;      chkfits    (tests to see if input file is in FITS format)
;      within     (tests to see if values are in range)
;      readfile   (reads IUESIPS data files)
;      readsi     (reads NEWSIPS data files)
;      calib      (Absolute calibration---IUESIPS data)
;      newcalib   (Absolute calibration---NEWSIPS data)
;      stpar      (get FITS keyword---NEWSIPS data)
;      addpar     (add keyword to FITS header)
;      iuedaf     (create "iuedac" section in FITS header)
;      copuf      (copies input .lab file to output .lab file without spawning)
;
;    The following is used if the CHEBYSHEV keyword is set:
;
;      bfit       (fits background with sixth order Chebyshev polynomial)
;
;    The following are used if the FITS keyword is set:
;
;      ifitswrt   (write output file)
;      intime     (get exposure time---IUESIPS data)
;      lti        (set THDA correction flag---IUESIPS data)
;      tempcor    (THDA correction---IUESIPS data)
;      sdc        (set LWR sensitivity degradation flag---IUESIPS data)
;      keygen     (convert scale factor record to FITS keywords---IUESIPS data)
;      fitslab    (convert VICAR label to FITS keywords---IUESIPS data)
;
;    The following are used if the MELO keyword is set (IUESIPS data):
;
;      labmod     (add line to bottom of .lab file)
;      scaling    (get j,k,r scaling factors)
;
;*NOTES:
;
;               Default centers, slits, widths, and filters:
;
;                                  SLITS            WIDTHS DISTANCE*
; File  Aperture Source   Cen Object   Background   Ob  Bk  c-c c-e  Median Mean
; 
; SILO   Small             25 [19,31] [11,17,33,39] 13   7        8
; SILO   Large   point     51 [45,57] [32,38,64,70] 13   7       13     1   1 ?
; SILO   Large   extended  51 [40,63] [32,38,64,70] 23   7       13
;
; ELBL   Small             55 [47,64] [35,44,67,76] 18  10   16         63   31
; ELBL   Large   point     54 [47,64] [29,38,73,82] 18  10   22         63   31
; ELBL   Large   extended  54 [41,70] [29,38,73,82] 30  10   22         63   31
;
; LBLS   Small             28 [24,32] [18,22,34,38]  9   5    8         63   31
; LBLS   Large   point     28 [24,32] [15,19,37,41]  9   5   11         63   31
; LBLS   Large   extended  28 [21,35] [15,19,37,41] 15   5   11         63   31
;
; ESSR   Small             28 [24,32] [18,22,34,38]  9   5    8         31   15
; ESSR   Large   point     28 [24,32] [15,19,37,41]  9   5   11         31   15
; ESSR   Large   extended  28 [21,35] [15,19,37,41] 15   5   11         31   15
;     
;     NOTE:   Line numbers start with ONE!!!!
;
;    *Distances:  Center-to-center (center of object to center of background)
;                 is given for IUESIPS files.  Center-to-edge (center of object
;                 to edge of background) is given for SILO files.
;
;     Slits for SILO files are based on the assumed regions that SWET 
;     (Signal Weighted Extraction Technique) uses when the MXLO file is
;     created.  Slits for ELBL/LBLS/ESSR files are based on the defaults
;     used in the older program EXMELO.  Median and Mean filters are based
;     on those used by EXMELO (note that ESSR files have fewer 
;     samples and therefore they have smaller filter values).
;
;          File Types:
;                                       Goddard               VILSPA
;     File  SIPS   #Lines #Samples   Start      End       Start     End
;
;     SILO NEWSIPS    80    <640      
;     ELBL IUESIPS   110   <1022    01-Oct-85  present
;     LBLS IUESIPS    55   <1022    04-Nov-80 01-Oct-85 
;     ESSR IUESIPS    55    <600    22-May-78 04-Nov-80 14-Jun-78 10-Mar-81
;          IUESIPS    32    <600    03-Apr-78 22-May-78 17-Apr-78 14-Jun-78
;     
;     Dates for ESSR files (and before) taken from Turnrose, Thompson, & Gass,
;     IUE NASA Newsletter #25.
;
;*PROCEDURE:
;
;     First some preliminary checking is done on the file.  If no extension
;     was given, the default is assumed to be .DAT (i.e., IUESIPS data file).
;     But nevertheless the file will be checked to see whether it is in FITS
;     format or not; if so, it is assumed to be a NEWSIPS SILO file.  The file
;     is then read.
;
;     If the OBJECT parameter has two elements, they are considered to be the
;     starting and ending lines (inclusive) and an array containing the line
;     numbers is created.  If OBJECT has more than two elements, OBJECT will
;     be used directly as the array containing the line numbers to use.  If
;     OBJECT has one parameter, it is considered to be a central line number,
;     and a slit is assigned based on the width given in the table given in the
;     NOTES section of this prolog.  If OBJECT is zero, then the center line in
;     the table and the slit are used.
;
;     The resulting array of line numbers is checked to make sure it is in
;     range (based on the number of lines in the file).  Then, the gross flux
;     and quality flag vectors are computed.  Lines given by the line number
;     array are added up (fluxes) to generate the gross flux.  For IUESIPS,
;     the worst quality flags are kept.  For NEWSIPS, all quality flags at a
;     given sample are coalesced with logical OR.
;
;     If bckgd has one element, defaults based on the center lines and the
;     values given in the table are used.  If bckgd has two elements, they
;     are considered to be the central lines of two regions with widths given
;     in the table.  If bckgd has four elements, they are considered to be the
;     starting and ending line numbers, inclusive, of two background regions.
;
;     An array of line numbers will be generated, and this will be tested to 
;     see if all lines are in range, and do not overlap with the object slit.
;     If all is well, all specified lines will be added (where their quality
;     flags are non-negative) and the resulting array divided by an array which
;     contains the number of samples (non-negative flags) which were included.
;
;     If the filter keywords were not set, defaults (as given in the table) are
;     used.  A copy of the background array is padded on both ends so that the
;     number of elements is increased by twice the value of the largest filter.
;     (This is from EXMELO.)  This is smoothed first with a median filter and
;     then twice more with a mean filter and subtracted from the gross fluxes
;     to get the net fluxes.
;
;     If the CHEBYSHEV keyword is set, no median or mean filtering is done---
;     instead, subroutine BFIT is used to fit the background with a Chebyshev
;     polynomial (sixth order).  Background lines on either side of the object
;     region (defined by the first and last object lines) constitute the two
;     background swaths (whether or not the actual background lines in each
;     swath are contiguous).
;
;     For NEWSIPS, the FITS header is updated and NEWCALIB is run on a copy of
;     the net fluxes to produce calibrated fluxes.
;
;*MODIFICATION HISTORY:
;
;       Written by LLT summer 1994.
;        2 Dec 94 LLT fix error in center index (NEWSIPS large aperture)
;        6 Mar 95 RWT define center if nob = 2 or > 2, fix aperture test,
;                     use string(ap) in file name, add spaces in keyword
;                     comments, list median and mean filter widths for
;                     SILO files as 1, output filtered (not unsmoothed)
;                     background fluxes, and replace spawns with call to
;                     copuf
;
;-***************************************************************************
pro BOXCAR,IMAGET,object,bckgd,h,w,g,b,n,f,q,extended=extended,small=small,$
   chebyshev=chebyshev,medianw=medianw,meanw=meanw,expt=expt,melo=melo,fits=fits

npar=n_params(0)
if npar eq 0 then begin
   print,'BOXCAR,IMAGET,object,bckgd,h,w,g,b,n,f,q,/extended,/small,$'
   print,' medianw=medianw,meanw=meanw,expt=expt,/melo,/fits,/chebyshev'
   print,'(Line numbers start with 1)'
   retall
endif; npar eq 0

parcheck,npar,[1,2,3,4,5,6,7,8,9,10],'BOXCAR'

if npar gt 1 then object=(object-1)>0         ;Convert line numbers to indices
if npar gt 2 then bckgd=(bckgd-1)>0

decompose,imaget,disk,path,filename,extn,vers
if extn eq '' then extn='.dat'
chkfits,disk+path+filename+extn+vers,newsips,/silent

if newsips eq 2 then begin                     ;imaget not found
   print,imaget+' not found.  Returning.'
   return
endif ;newsips eq 2

if newsips then begin
   readsi,imaget,h,w,flux,qual
   w=float(w) 
   nlines=80
   stpar,h,'aperture',aperture
   if keyword_set(small) then ap=2 else case strtrim(aperture,2) of
         'BOTH': ap=1
        'LARGE': ap=1
        'SMALL': ap=2
           else: ap=0
   endcase
endif else begin 
   readfile,imaget,lab,h,w,flux,qual
   nlines=h(2)
   if keyword_set(small) then ap=2 else ap=h(14) 
endelse ;newsips

if not keyword_set(extended) then extended=0
small=ap eq 2

g=flux(*,0)*0
q=qual(*,0)*0+100*(newsips eq 0)

if npar lt 3 then bckgd=0
if npar lt 2 then object=0

nob=n_elements(object)
nbk=n_elements(bckgd)

if nob eq 2 then begin
    line=indgen(max(object)-min(object)+1)+min(object)
    center = fix(total(line)/n_elements(line) + 0.5 )
endif
if nob gt 2 then begin
    line=object
    center = fix(total(line)/n_elements(line) + 0.5 )
endif
if nob eq 1 then begin
   if not newsips then begin              ;IUESIPS
      if h(2) eq 110 then begin
         center=object+54*(object le 0)     ;#54 is the 55th line
         if extended then line=indgen(30)+center-14 else $ 
            line=indgen(18)+center-8 
      endif else if h(2) eq 55 then begin
         center=object+27*(object le 0)     ;#27 is the 28th line
         if extended then line=indgen(15)+center-7 else $
            line=indgen(9)+center-4
      endif ;h(2) 55 or 110
   endif else begin                       ;NEWSIPS
      if small then center=object+24*(object eq 0) else $
         center=object+50*(object le 0)
      if extended then line=indgen(23)+center-11 else $
         line=indgen(13)+center-6
   endelse  ;newsips
endif ;nob eq 1

within,[0,nlines-1],line,result
if total(abs(result)) ne 0 then begin
   print,'Line numbers must be between 1 and '+strtrim(string(nlines),2)
   print,'The following lines are out of range for the object slit: '
   print,line(where(result ne 0))+1
   print,'Returning.'
   return
endif ;total(abs(result)) ne 0

if nob le 2 then ocom='Object:  lines '+strtrim(string(line(0)+1),2)+' - '+ $
   strtrim(string(max(line)+1),2)+', inclusive.' else $
   ocom='Object:  lines '+strtrim(string(line+1),2)

print,ocom

for i=0,n_elements(line)-1 do begin
    g=g+flux(*,line(i))
    if newsips then q=-(abs(q) or abs(qual(*,line(i)))) else $
       q=q<qual(*,line(i))
endfor ;i=0,n_elements(line)-1

if (nbk eq 1) then begin
   bckgd=intarr(4)
   if not newsips then begin
      if small or extended then begin     ;small aperture
         bckgd(1)=line(0)-2-(nlines eq 110)                   ;or extended
         bckgd(2)=max(line)+2+(nlines eq 110)                 ;source
      endif else begin
         bckgd(1)=line(0)-5-4*(nlines eq 110)                 ;point source in
         bckgd(2)=max(line)+5+4*(nlines eq 110)               ;large aperture
      endelse  ;point source in lg ap
      bckgd(0)=bckgd(1)-5*(nlines/55)+1
      bckgd(3)=bckgd(2)+5*(nlines/55)-1
   endif else begin                                      ;NEWSIPS
      if small then begin
         bckgd(1)=center-8                               ;small aperture
         bckgd(2)=center+8
      endif else begin
         bckgd(1)=center-13                              ;large aperture
         bckgd(2)=center+13
      endelse
      bckgd(0)=bckgd(1)-6                                ;always 7 pixels wide
      bckgd(3)=bckgd(2)+6
   endelse ;newsips
   nbk=4
endif ;nbk eq 1

if nbk eq 2 then begin
   bckgd=bckgd(sort(bckgd))
   if newsips then begin                                ;NEWSIPS
      back=intarr(14)
      back(0)=indgen(7)+bckgd(0)-3
      back(7)=indgen(7)+bckgd(1)-3
      dw='7'
   endif else begin                                     ;IUESIPS
      eleventy=nlines eq 110                            ;1 or 0
      back=intarr(10+10*eleventy)
      back(0)=indgen(5+5*eleventy)+bckgd(0)-2-3*eleventy
      back(5+5*eleventy)=indgen(5+5*eleventy)+bckgd(1)-2-3*eleventy
      dw=strtrim(string(5+5*eleventy),2)
   endelse 
   within,line,back,r1
   temp=where(r1 eq 0,ntemp)
   if ntemp gt 0 then begin
      print,'If the default width ('+dw+') is used with the background center'
      print,'lines you chose, the background and object slits overlap.'
      print,'Your background center lines: ',bckgd+1
      print,"I don't know what to do, so I'm returning."
      return
   endif ;ntemp gt 0
endif; nbk eq 2

if nbk eq 4 then begin
   bckgd=bckgd(sort(bckgd))
   back=indgen(nlines)
   within,bckgd,back,r1
   within,[bckgd(1)+1,bckgd(2)-1],back,r2
   back=back(where((abs(r1)+abs(r2)) eq 1))
   bcom='Background:  lines '+strtrim(string(bckgd(0)+1),2)+' - '+ $
        strtrim(string(bckgd(1)+1),2)+' and '+strtrim(string(bckgd(2)+1),2)+ $
        ' - '+strtrim(string(bckgd(3)+1),2)+', inclusive.'
endif else bcom='Background:  lines '+ strtrim(string(back+1),2) ;nbk eq 4
print,bcom
within,line,back,res
temp=where(res eq 0,ntemp)
if ntemp gt 0 then begin
   print,'Some of your background lines overlap with your object slit.'
   print,'Background: ',back+1
   print,'Object: ',line+1
   print,"I don't know what to do, so I'm returning."
   return
endif ;ntemp gt 0

within,[0,nlines-1],back,result
if total(abs(result)) ne 0 then begin
   print,'Line numbers must be between 1 and '+strtrim(string(nlines),2)
   print,'The following lines are out of range for the background: '
   print,back(where(result ne 0))+1
   print,'Returning.'
   return
endif ;total(abs(result)) ne 0

;
; calculate gross (g) and filtered background (b) vectors
;

if not keyword_set(chebyshev) then begin
   b=g*0
   c=fix(b)
   for i=0,n_elements(back)-1 do begin
    c=c+(qual(*,back(i)) ge 0)
    b=b+flux(*,back(i))*(qual(*,back(i)) ge 0)
   endfor ;i=0,n_elements(back)-1
   b=b*n_elements(line)/(c+(c eq 0))    ;normalize background to gross
   nsamp=n_elements(g)
   if not newsips then begin
      if not keyword_set(medianw) then begin
         if nsamp le 600 then medianw=31 else medianw=63
      endif ;not keyword_set(medianw)
      if not keyword_set(meanw) then begin
         if nsamp le 600 then meanw=15 else meanw=31
      endif ;not keyword_set(meanw)
   endif else begin
      if not keyword_set(medianw) then medianw=1
      if not keyword_set(meanw) then meanw=1
   endelse ;not newsips
   npad=medianw<meanw
   filback=b(indgen(nsamp+npad+npad)-npad)
   if medianw gt 1 then filback=median(filback,medianw)
   if meanw gt 1 then filback=smooth(smooth(filback,meanw),meanw)
   if meanw lt -1 then filback=smooth(filback,-meanw)
   b = filback(npad:nsamp+npad-1)
   n=g - b
   f=n
endif else  begin           ;Chebyshev
   within,object,back,res
   temp=where(res lt 0,nfirst)
   bfit,w,flux,qual,b,lines=back,nfirst=nfirst
   b=b*n_elements(line)
   n=g-b
   f=n
endelse

;
; calculate absolute flux vectors
;

if newsips then begin
   wtemp=w
   newcalib,h,w,f
   within,w,wtemp,wres
   g=g(where(wres eq 0))
   b=b(where(wres eq 0))
   n=n(where(wres eq 0))
   q=q(where(wres eq 0))
   delpar,h,'CRPIX1'
   delpar,h,'CRPIX2'
   delpar,h,'CRVAL1'
   delpar,h,'CRVAL2'
   delpar,h,'CDELT1'
   delpar,h,'CDELT2'
   delpar,h,'CTYPE1'
   delpar,h,'CTYPE2'
   delpar,h,'BUNIT'
   delpar,h,'BSCALE'
   delpar,h,'BZERO'
   delpar,h,'DATAMIN'
   delpar,h,'DATAMAX'
   addpar,h,'FILENAME',filename+extn+vers,' Original input file'
   iuedaf,h,flag,/silent,/date,/override
   addpar,h,'SIPS','NEWSIPS',' Spectral Image Processing System used','IUEDAC'
   addpar,h,'COMMENT','NU Flags were coalesced with logical OR.','','IUEDAC'
   addpar,h,'COMMENT',ocom,'','IUEDAC'
   addpar,h,'COMMENT',bcom,'','IUEDAC'
   addpar,h,'COMMENT','Line numbers begin with one.','','IUEDAC'
   addpar,hd,'HISTORY','BOXCAR: '+!stime,'','IUEDAC'
   if not keyword_set(chebyshev) then begin
      addpar,h,'MEDIAN',medianw,' Median Filter Width for Background','IUEDAC'
      addpar,h,'MEAN',meanw,' Mean Filter Width for Background','IUEDAC'
   endif ;not chebyshev
endif else begin
   if not keyword_set(expt) then $
      expt=h(39)/60.+h(40)+h(41)/1000. $
   else begin
      h(39)=fix(expt/60.)
      h(40)=fix(expt-h(39)*60.)
      h(41)=1000*(expt-fix(expt))
   endelse ;keyword_set(expt)
   h(100:399)=0
   h([2,5,100,200,300])=[1,6,0,1,nsamp]
   h(400)=n_elements(line)                             ;Signal width
   h(86)=total(line+1)/n_elements(line)+.5             ;Signal center
   h(57)=n_elements(back)/2                            ;Background width
   h(58)=h(86)-back(0)-2+h(57)/2                       ;Background center dist.
   h([57,58,400])=h([57,58,400])*100
   h(87)=meanw
   h(88)=medianw
   if keyword_set(melo) then begin
      outfile=strmid(filename,0,3)+strtrim(strmid(lab(0),51,5),2)+'l'
      case h(14) of
          1: outfile=outfile+'lg'
          2: outfile=outfile+'sm'
       else: print,'Unknown aperture: ',h(14)
      endcase
      tmp=h([39,40,41])
      calib,h,w,n,1,f
      h(39)=tmp
      copuf,disk+path+filename+'.lab'+vers,outfile+'.lab'     ; copy .lab file
      openu,/GET_LUN,luni,outfile+'.lab'
      label=assoc(luni,bytarr(74))
      one=label(1)
      one([33,34,35,36])=[240b,240b,240b,247b]  ;0007
      label(1)=one
      free_lun,luni
      if not keyword_set(chebyshev) then begin
         strin='*BOXCAR PARAMETERS: GROSS CENTER ='+string(h(86))+'  WIDTH ='+ $
            string(h(400)/100)
         labmod,outfile+'.lab',strin
         strin='BACKGROUND DISTANCE ='+string(h(58)/100)+'  WIDTH ='+ $
            string(h(57)/100)
         labmod,outfile+'.lab',strin
         strin='FILTER WIDTHS MEAN ='+string(h(87))+' MEDIAN ='+string(h(88))
         labmod,outfile+'.lab',strin
      endif else begin
         strin='SIXTH ORDER CHEBYSHEV FIT TO BACKGROUND'
         labmod,outfile+'.lab',strin
      endelse ;chebyshev
      ns=h(1)
      openw,/get_lun,luni,outfile+'.dat',ns
      data=assoc(luni,intarr(ns))
      h(56)=5
      data(1)=fix(w*5)
      scaling,min(g),max(g),j,k,r
      h([18,19,20,21])=[min(g)*r,max(g)*r,j,k]
      data(2)=q
      data(3)=fix(g*r)
      scaling,min(b),max(b),j,k,r
      h([22,23,24,25])=[min(b)*r,max(b)*r,j,k]
      data(4)=fix(b*r)
      scaling,min(n),max(n),j,k,r
      h([26,27,28,29])=[min(n)*r,max(n)*r,j,k]
      data(5)=fix(n*r)
      scaling,min(f),max(f),j,k,r
      h([30,31,32,33])=[min(f)*r,max(f)*r,j,k]
      data(6)=fix(f*r)
      data(0)=h
      free_lun,luni
      print,outfile+'.dat and '+outfile+'.lab have been written.'
   endif else begin
      calib,h,w,n,expt+(expt eq 0),f  
      if expt eq 0 then h(39)=[0,0,0]
   endelse ;if keyword_set(melo)
endelse ;newsips

if keyword_set(fits) then begin
   if not newsips then begin
    case h(3) of
         1: outname='LWP'+strtrim(strmid(lab(0),51,5),2)+'.b'
         2: outname='LWR'+strtrim(strmid(lab(0),51,5),2)+'.b'
         3: outname='SWP'+strtrim(strmid(lab(0),51,5),2)+'.b'
         4: outname='SWR'+strtrim(strmid(lab(0),51,5),2)+'.b'
      else: begin & print,'Unknown camera: ',h(3) & return & end
    endcase ; camera number
    outname=outname+strtrim(string(h(14)),2)+'f'
    if h(580) eq 0 then begin                   ;make sure ITF flag is set
      pcf=lab(where(strpos(lab,'1PC',70) ge 0))
      pcf=pcf(1)
      itfexp=strmid(pcf,26,4)
      case itfexp of
           '2023': h(580)=0   ;LWP
           '2300': h(580)=1   ;LWP
           '2723': h(580)=2   ;LWP
           '1800': h(580)=0   ;LWR/SWP
           '2303': h(580)=1   ;LWR
           '1753': h(580)=1   ;SWP
           '1684': h(580)=2   ;SWP
             else: print,'Unrecognized ITF Exposure Time: '+itfexp
      endcase ;itfexp
    endif ;h(580) eq 0
    if expt eq 0 then begin
       print,lab(0:10)
       intime,h
       expt=h(39)*60.+h(40)+h(41)/1000.+(total(h(39:41)) eq 0) 
    endif ;expt eq 0
    if expt gt 0 then begin
       if ( (h(3) eq 2) and (h(2) eq 1) and (h(69) eq 0) ) then sdc,h
       calib,h,w,n,expt,f  ; perform absolute calibration
       print,' '
       if (h(68) eq 0) then lti,h,disk+path+filename+vers  ; check for thda correction
       if (h(68) lt 0) then begin
          tempcor,h,f,fc
          f=fc
       endif; h(68) lt 0
    endif 
    keygen,h,sfr                                ;Keywords from scale factor rec
    fitslab,disk+path+filename+'.lab'+vers,lab,sih  ;Keywords from VICAR header
    nsfr=n_elements(sfr)                        
    nsih=n_elements(sih)
    header=strarr(nsfr+nsih)                    ;Create header array
    header(0)=sfr                               ;Insert scale factor keywords
    header(nsfr-1)=sih                          ;Insert VICAR label
    header(nsfr+nsih-1)=sfr(nsfr-1)             ;Put END at the end
    iuedaf,header,flag,/silent,/date,/override
    addpar,header,'FILENAME',filename+extn+vers,' Original input file'
    addpar,header,'SIPS','IUESIPS ',' Spectral Image Processing System used','IUEDAC'
    addpar,header,'HISTORY','BOXCAR: '+!stime,'','IUEDAC'
    addpar,header,'COMMENT',ocom,'','IUEDAC'
    addpar,header,'COMMENT',bcom,'','IUEDAC'
    addpar,header,'COMMENT','Line numbers begin with One!','','IUEDAC'
    addpar,header,'COMMENT','Worst EPSILON Flags in Object Slit Kept.','','IUEDAC'
    if keyword_set(chebyshev) then $
       addpar,header,'COMMENT',' Sixth order Chebyshev fit to Background.','IUEDAC' $
    else begin
       addpar,header,'MEDIAN',medianw,' Median Filter Width for Background','IUEDAC'
       addpar,header,'MEAN',meanw,' Mean Filter Width for Background','IUEDAC'
    endelse ;chebyshev
    qualtype='EPSILON Flags'
    if expt gt 0 then units='Ergs/cm^2/s/A' else units='Ergs/cm^2/A'
    h=header
   endif else begin
    stpar,h,'camera',camera
    stpar,h,'image',image
    outname=strcompress(camera+string(image)+'.b'+string(ap)+'f',/remove_all)
;   outname=camera+strtrim(string(image),2)+'.b'+strtrim(string(ap),2)+'f'
    qualtype='NU Flags'
    units='Ergs/cm^2/s/A'
   endelse ;newsips
   ifitswrt,h,w,f,q,g,b,n,/silent,p1t='Wavelengths',p2t='Calibrated Fluxes',$
            p3t=qualtype,p4t='Gross Fluxes',p5t='Background Fluxes',$
            p6t='Net Fluxes',p1u='Angstroms',p2u=units,p4u='Flux Numbers',$
            p5u='Flux Numbers',p6u='Flux Numbers',ofn=outname
   print,outname+' has been written.'
endif ;keyword_set(fits)
return
end ;boxcar