Viewing contents of file '../idllib/iuedac/iuelib/pro/com_hia.pro'
;************************************************************************
;+
;*NAME:
;
;	COM_HIA
;  
;*CLASS:
;
;	Spectral Data Reduction
;  
;*CATEGORY:
;  
;*PURPOSE:
;
; 	Procedure to get next order for COMBALL (from QIUEHI3 & IUEHI)
;  
;*CALLING SEQUENCE:
;
;  	COM_HIA,UNIT,K0,A,ER,CAM,M0,OFL,W1,W2,NET1,NET2,E1,E2,NP1,NP2,H,W,F,E
;
;*PARAMETERS:
;
;	UNIT	(REQ) (I) (0) (I)   
;		Unit number for input image file.
;
;       K0	(REQ) (I) (0) (F D) 
;		Ripple constant.
;
;	A	(REQ) (I) (0) (F D)   
;		Ripple constant.
;
;       ER	(REQ) (I) (0) (I L)     
;		Record size of image file.
;
;       CAM	(REQ) (I) (0) (I)    
;		Camera number.
;
;       M0	(REQ) (I) (0) (I)     
;		Central Order number.
;
;       OFL	(REQ) (I) (0) (I)    
;		Flag for 1st order.
;
;       W1	(REQ) (I/0) (1) (F D) 
;		Wavelength vector for M0 from last call.
;
;	W2	(REQ) (I/0) (1) (F D) 
;		Wavelength vector for M0-1 from last call.
;
;       NET1	(REQ) (I/O) (1) (F D)
;		Net flux from last call.
;
;	NET2	(REQ) (I/O) (1) (F D)
;		Net flux from last call.
;
;       E1	(REQ) (I/O) (1) (I L F D)
;		Epsilon vectors from last call.
;
;	E2	(REQ) (I/O) (1) (I L F D)
;		Epsilon vectors from last call.
;
;       NP1	(REQ) (I) (1) (I)
;		Number of points in vector.
;
;	NP2	(REQ) (I) (1) (I)
;		Number of points in vector.
;
;        H	(REQ) (I/O) (1) (I)     
;		Header record.  
;
;       W1,W2,H,NET1,NET2,E1,E2 are modified and passed to calling
;	procedure to save them for the next call to HIA.
;
;*EXAMPLES:
;
;*SYSTEM VARIABLES USED:
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;  
;	PARCHECK
;	IUEGET
;    	COM_SPL
;    	COM_ABCAL
;	RIPPLE
;
;*FILES USED:
;  
;*SIDE EFFECTS:
;  
;*RESTRICTIONS:
;  
;*NOTES:
;
;	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:
;
;	This procedure extracts three orders from a high dispersion file.
;	The orders are then ripple corrected and trimmed. They are then 
;	spliced together using COM_SPL.PRO. Finally, using COM_ABCAL.PRO,
;	the orders are spliced together.
;  
;*I_HELP nn:
;  
;*MODIFICATION HISTORY:
;
;	5-24-85 C. Grady modified for DIDL
;	3-01-91 PJL unix/sun modifications; removed !ERR; added
;		    PARCHECK and call print
;	7-22-91 PJL cleaned up; tested on SUN and VAX; updated prolog
;
;-
;************************************************************************
 pro com_hia,unit,k0,a,er,cam,m0,ofl,w1,w2,net1,net2,e1,e2,np1,np2,h,w,f,e
;
 npar = n_params(0)
 if npar eq 0 then begin
    print,   $
     'COM_HIA,UNIT,K0,A,ER,CAM,M0,OFL,W1,W2,NET1,NET2,E1,E2,NP1,NP2,H,W,F,E'
    retall
 endif  ; npar
 parcheck,npar,19,'COM_HIA'
;
 if ofl eq 0 then begin   ; if on first pass fetch three orders
    iueget,unit,m0+1,h,w0,net0,e0
    iueget,unit,m0,h,w1,net1,e1  ; fetching central order here
 endif else begin        ; if not on first order shift first two orders 
    w0=w1 &w1=w2
    net0=net1 &net1=net2
    e0=e1 &e1=e2
    np0=np1 &np1=np2
 endelse  ; end of shift loop
 iueget,unit,m0-1,h,w2,net2,e2  ; fetch third order
;
; determine the ripple constant appropriate for the orders and camera
;
 if cam eq 3 then  k = 138827. - (27.426 - 0.165883*m0) * m0
 if cam eq 2 then  k = 230036. + (15.3456 - 0.050638*m0) * m0
 if cam eq 1 then  k = 230648. + 5.391*m0
 h(97)=fix(k-k0)   ; update header record
;
; trim the individual orders
;
 if ofl eq 0 then begin
    np0=n_elements(w0)-20>1
    w0 = w0(10:np0+9)
    net0 = net0(10:np0+9)
    e0 = e0(10:np0+9)
    np1=n_elements(w1)-20>1
    w1 = w1(10:np1+9)
    net1 = net1(10:np1+9)
    e1 = e1(10:np1+9)
 endif  ; oflag loop   trimming for last order not up to snuff
 np2=n_elements(w2)-20>1           ; try lopping off more data points
 w2 = w2(10:np2+9)
 net2 = net2(10:np2+9)
 e2 = e2(10:np2+9)
;
; now apply ripple correction
;
 ripple,w0,net0,m0+1,k,a,f0    ; apply order dependent ripple correction
 ripple,w1,net1,m0,k,a,f1      ; following ake (1981,1982,1984)
 ripple,w2,net2,m0-1,k,a,f2    ; algorithms
;
; splice the orders together
;
 i1=(k/(m0+0.5))>w1(0)<w0(np0-1)        ; splice wavelength
 com_spl,w0,f0,e0,w1,f1,e1,i1,ww,ff,ee  ; splice returns i1 as 2 element vector
 i2=(k/(m0-0.5))>w2(0)<w1(np1-1)        ; second splice wavelength
 com_spl,ww,ff,ee,w2,f2,e2,i2,w,fnet,e
 h([93,94,95,96]) = [i1(1),i1(1),i2(1),i2(1)]     ; add splice points to header
;
; apply absolute calibration
;
 com_abcal,h,w,fnet,1.e-3*h(41)+h(40)+60.*h(39),f
 return
 end  ; com_hia