Viewing contents of file '../idllib/iuedac/iuelib/pro/comball.pro'
;***************************************************************************
;+
;*NAME:
;
;    	COMBALL          (RDAF General Production Library)          Sep, l986
; 
;*CLASS:
;
;    	Resampling
;
;*CATEGORY:    
;
;*PURPOSE:  
;
;    	Combines high disp orders into a single vector < 10000 points long.
;
;*CALLING SEQUENCE:
;
;    	COMBALL,IMT,WA1(I),WA2(I),DEL(I),H,W,FAB,E,SPLICE   
; 
;*PARAMETERS:
;	
;	IMT	(REQ) (I) (0) (S)
;		Camera and image identifier.
;
;       MINW	(REQ) (I) (0) (F D)
;		Minimum wavelength for resampling.
;
;       MAXW	(REQ) (I) (0) (F D)
;		Maximum wavelength for resampling.
;
;       DEL 	(REQ) (I) (0) (F D)
;		Increment in wavelength units for the resampling.
;
; 	H   	(REQ) (O) (1) (I)
;		Header vector.
;
;       WAVE	(REQ) (O) (1) (F)
;		Resampled wavelength vector.
;
;       FLUX	(REQ) (O) (1) (F)
;		Resampled flux vector.
;
;       EPS 	(REQ) (O) (1) (F)
;		Resampled data quality vector.  The weight (WGT) vector
;		obtained from the RDAF procedure BINS.
;
;       SPL	(REQ) (O) (1) (F)
;		Array of splice wavelengths for each order.
;
;*EXAMPLES:
;
;*SYSTEM VARIABLES USED:
;
;	!STIME 	-   system's time and date are printed
;
;*COMMON BLOCKS:
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
;	PARCHECK
;	COM_HIA
;    	BINS
;
;*FILES USED:
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
;*NOTES:
;
;	Used by BCOMP.PRO
;
;	tested with IDL Version 2.1.0 (sunos sparc)  	19 Jul 91
;	tested with IDL Version 2.1.0 (ultrix mispel)	N/A
;	tested with IDL Version 2.1.0 (vms vax)      	22 Jul 91
;
;*PROCEDURE:
;
;		The procedure first initializes variables and output vectors. 
;       Next, the procedure reads the header record and leaves the file open 
;       for IUEGET. The procedure then determines the K0 and ALPHA from the 
;	camera number and stores ALPHA in the header. Next, actual scrunching
;	begins, and continues until it runs out of 10 A chunks of spectrum. 
;       The scrunching will consist of extraction, reduction, and resampling 
;       onto the specified wavelength grid.  
;       	The procedure then reads in data, subtracts background from 
;       gross spectrum, performs ripple correction, and does an absolute 
;       calibration.  This is accomplished by calling COM_HIA.PRO. Next the 
;       procedure loads wavelengths of splice points into a splice array. 
;       The procedure then assigns weights; it ignores reseaux and saturated 
;       pixels, but retains extrapolated pixels. 
;	         Further, the program resamples onto a uniformly spaced 
;       wavelength scale with spacing = DEL.  Then it inserts the new 
;       resampled datapoints into the output data arrays.  Finally, the 
;       procedure will print the time after loading all the datapoints 
;       into output arrays and returning.
;
;*I_HELP nn:
;
;*MODIFICATION HISTORY:
;
;     Programmer: R. Panek, G. Sonneborn
;     5-24-85 CAG Overhaul to add linear interp. across reseaux,
;             better ripple correction & documentation
;     11-14-85 RWT combine COMBI1, COMBI2 & COMBI3 into COMBALL
;      3-01-91 PJL unix/sun modifications; added PARCHECK and 
;	       call print; removed !ERR
;      7-22-91 PJL cleaned up; tested on SUN and VAX; updated prolog
;      8-27-91 jg  corrected prolog
;     12-17-91 PJL changed number of points limit from 4000 to 10000
;      1-07-92 PJL added documentation
;      1-08-92 PJL changed clearing splice points range to include h(96)
;
;-	
;**********************************************************************
 pro comball,imt,minw,maxw,del,h,wave,flux,eps,splice        
;
 npar = n_params(0)
 if npar eq 0 then begin
    print,'COMBALL,IMT,MINW,MAXW,DEL,H,WAVE,FLUX,EPS,SPLICE'
    retall
 endif  ; npar
 parcheck,npar,9,'COMBALL'
;
; initialize variables & output vectors
;
 order = -1
 flag = 0
 ofl = 0
 npnts = 0
 nwave=fix( (maxw-minw)/del+0.5 )<10000 ; find # of data points 
 print,nwave,' points'                 ; must be < 10000
 wave=fltarr(nwave)
 flux=wave
 eps=wave
 splice=fltarr(70,2)  ; array containing start & stop wavelengths
;
; read in header record & leave file open for iueget
;
 openr,un,imt,ERROR=er,/get_lun
 rec = assoc(un,intarr(10))
 h = rec(0)
 cam = h(3)                       ; camera number
;
; determine k0 & alpha from camera number. store a in header
;
 a = 0.896
 k0 = 231150.
 if cam eq 3 then begin
    a = 0.856
    k0 = 137725.0
 endif  ; cam eq 3
 h([98,99]) = [0,fix(a*1000)]
;
; begin actual scrunching until run out of 10 a chunks of spectrum.
; the scrunching will consist of extraction, reduction, and 
; resampling onto the specified wavelength grid.
;
 print,!stime         ; display time before starting
 print,' order          splice points'
 wmin=minw > 0
 repeat begin         ; work with 10 angstrom sections
    wmax=(wmin+10.)<maxw
    ord=fix(k0/(wmin+wmax)*2.+0.5)
    if order ne ord then begin ; need to read in data
;
; read in data, subtract background from gross spectrum, ripple
; correct, and absolutely calibrate
;
       com_hia,un,k0,a,er,cam,ord,ofl,w1,w2,fn1,fn2,e1,e2,np1,np2,h,w,f,e
;
; load wavelengths of splice points into splice array
;
       print,"$(1x,i4,4f10.2)",ord,w(h(93)-1),w(h(93)),w(h(95)-1),w(h(95))
       splice(ord-61,0)=w(h(95)-1)
       splice(ord-61,1)=w(h(95))
       if order eq -1 then begin 
          splice(ord-60,0)=w(h(93)-1)
          splice(ord-60,1)=w(h(93))
       endif  ; order
    endif  ; read in data
;
; assign weights: ignore reseaux, sat. pixels, retain extrap. itf
; 
    weight=( e ge -300) + 0.001
;
; resample onto an uniformly spaced wavelength scale with spacing = del
;
    s=fix((wmax-wmin)/del)<10000  ; avoid array too big
    nw=wmin+del*findgen(s)
    ind=where((w ge wmin-del) and (w le wmax+del))  ; trim vectors
    sz=size(weight)
    if sz(0) ne 0 then weight=weight(ind)
    bins,w(ind),f(ind),weight,nw,1.*del,nf,wsigma,newe       ; bins
    s=n_elements(nw)
;
; insert the new resampled datapoints into the output data arrays
;
    if npnts+s le nwave then begin  ; add on the new points
       wave(npnts) = nw
       flux(npnts) = nf
       eps(npnts) = newe  ; modified to handle double points
       npnts=npnts+s
       order=ord  ; update the order
       ofl=1                 ; update the order flag for hi3
    endif else flag=1        ; add on the new points 
    wmin=wmin+10.
 end until ( (wmin ge maxw) or (flag eq 1))   ; 10 a pieces
;
 free_lun,un
 h(93:96) = 0          ; clear splice points
 wave = wave(0:npnts-1)
 flux = flux(0:npnts-1)
 eps = eps(0:npnts-1)
;
; print time after loading all the datapoints into output arrays
;
 print,!stime
 return
 end  ; comball