;**************************************************************
;+
;*NAME:
;
;	BARKER3
;
;*CLASS:
;
;	Spectral Data Reduction
;
;*CATEGORY:
;
;*PURPOSE:
;
;	Procedure to extract 3 spectral orders and plot result.
;
;*CALLING SEQUENCE:
;
;	BARKER3,IMAGET,M0,H,WAVE,FLUX,EPS,K1         
;
;*PARAMETERS:
;
;	IMAGET	(REQ) (I)
;		file name where eshi file is stored
;
;	M0	(REQ) (I)
;		starting (highest) order no  (60 to 120)
;             	or wavelength (in angstroms)
;
;	H	(REQ) (I)
;		header record
;
;	WAVE	(REQ) (O)
;		wavelength vector
;
;	FLUX	(REQ) (O)
;		flux vector
;
;	EPS	(REQ) (O)
;		epsilon (error) vector
;
;       K1	(REQ) (I)
;		echelle constant
;
;*EXAMPLES:
;
;*SYSTEM VARIABLES USED:
;
;	!x.range
;	!y.crange
;
;*INTERACTIVE INPUT:
;	
;*SUBROUTINES CALLED;
;
;	PARCHECK
;	PCHECK
;	FILETYPE
;	IUEGET
;	BARKER
;	RIPPLE
;	IUEMERGE
;	IUEPLOT
;
;*FILES USED:
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
;*NOTES:
;
;	tested with IDL Version 2.1.0 (sunos sparc)  	23 Jul 91
;	tested with IDL Version 2.1.0 (ultrix mispel)	N/A
;	tested with IDL Version 2.1.0 (vms vax)      	23 Jul 91
;
;PROCEDURE:
;
;*I_HELP NN:
;
;*MODIFICATION HISTORY:
;
;  VERSION 2 F.H. SCHIFFER 3RD  11-MARCH-1982
;           splice orders at overlap of ripple correction
;  VERSION 3 N. R. EVANS 7 DEC. 1983  NEW RIPPLE CONSTANTS: AKE, 1982, 
;           IUE NEWSLETTER #19,37.  URP #162                    
;           C. A. GRADY 20-NOV-1984 IMPLEMENT AKE'S LWP CNSTS. 
;           RWT 12-12-84 USE NEW IUEMERGE
;           RWT 12-19-84 LWP alpha value changed from .85 to .896
;  MODIFIED GSFC RDAF 19APR85 - TO BE COMPATIBLE WITH XIDL - /ERROR 
;  MODIFIED TO USE NEW IUEGET WITH INTRINSIC MEDIAN COMMAND 5-13-86 RWT
;  12-31-86 RWT VAX mods: use subscript notation, N_ELEMENTS, DECOMPOSE
;           for COMPOSE
;   4-15-87 RWT add PARCHECK and remove EXTRACTs
;  10-29-87 CAG modified code to check for file type based on the contents
;           of the H record, rather than the file name.
;  10-30-87 CAG added printing of the calling sequence when the procedure
;           is executed without parameters.
;  12-03-87 CAG replaced SIPS ripple by call to BARKER algorithm, and 
;           renamed the file. Error checking is now done by subprocedure
;           FILETYPE
;   1-09-91 PJL replaced previous version of BARKER with BARKER3;
;           incorporated BARKER3 into IUEHI3; modified for sun/unix idl
;   7-23-91 PJL cleaned up; tested on SUN and VAX; updated prolog
;  10- 1-91 PJL ncleaned up xyouts calls
;
;-
;***************************************************************************
 pro barker3,imaget,m0,h,wave,flux,eps,k1         
;
 npar = n_params(0)
 if npar eq 0 then begin
    print,'BARKER3,IMAGET,M0,H,W,F,E'
    return
 endif  ; npar
 parcheck,npar,6,'BARKER3'
 pcheck,imaget,1,100,1000
 pcheck,m0,2,100,0110
;
 filetype,imaget,disk,path,name,ext,vers,ncam,type,isn
;
; check file type
;
 if strlowcase(type) ne 'h' then begin
    print,'File ',imaget,' is not a high dispersion spectrum'
    print,'ACTION: Returning to calling procedure'
    return
 endif  ; type
;
; check camera
;
 if (ncam gt 3) or (ncam le 0) then begin
    print,'Valid spectrographs are 1=LWP, 2=LWR, and 3=SWP'
    print,'Wrong spectrograph requested'
    print,'ACTION: Returning'
    retall
 endif ; error exit wrong camera (SWR or non-existent)
;
; open the g.o. file and fetch the 3 spectral orders
;
 openr,unit,/get_lun,disk + path + name + '.dat' + vers, error=err
 if m0 gt 1000 then m = fix(k1/m0 + 0.5) else m = m0
 iueget,unit,m,h,w0,net0,e0
 iueget,unit,m-1,h,w1,net1,e1
 iueget,unit,m-2,h,w2,net2,e2
 close,unit
 free_lun,unit
;
; perform barker ripple correction using sips wavelengths
; 
 barker,imaget,1,0,m-2,m,alpha,k1,k,dk,er,ncam,isn
;
; update the header with the echelle constants
;
 if ncam eq 3 then k0=137750. else k0=231150.
 h([97,98,99])=[fix(k1-k0),0,fix(alpha*1000)]
;
; apply the echelle corrections
;
 ripple,w0,net0,m,k1,alpha,f0
 ripple,w1,net1,m-1,k1,alpha,f1
 ripple,w2,net2,m-2,k1,alpha,f2
;
; trim the ends of the data vectors
;
 np0=n_elements(w0)-20>1
 w0 = w0(10:np0+9)
 f0 = f0(10:np0+9)
 e0 = e0(10:np0+9)
 np1=n_elements(w1)-20>1
 w1 = w1(10:np1+9)
 f1 = f1(10:np1+9)
 e1 = e1(10:np1+9)
 np2=n_elements(w2)-20>1
 w2 = w2(10:np2+9)
 f2 = f2(10:np2+9)
 e2 = e2(10:np2+9)
;
; merge the three orders
;
 i1=(k1/(m-0.5))>w1(0)<w0(np0-1)  ; splice wavelength
 iuemerge,w0,f0,e0,w1,f1,e1,i1,ww,ff,ee
 i2=(k1/(m-1.5))>w2(0)<w1(np1-1)  ; splice wavelength
 iuemerge,ww,ff,ee,w2,f2,e2,i2,wave,flux,eps
;
; trim off the first and last 50 points of the vectors
;
 npts  = n_elements(wave)
 swave = wave(50:npts-51)
 sflux = flux(50:npts-51)
 eps   = eps(50:npts-51)
;
 !x.range = [swave(0),max(swave)]
 iueplot,h,swave,smooth(sflux,3),eps
 i1=(k1/(m-0.5))>w1(0)<w0(np0-1)
 splice = fltarr(2) + i1
 oplot,splice,!y.crange
 i2=(k1/(m-1.5))>w2(0)<w1(np1-1)
 splice = fltarr(2) + i2
 oplot,splice,!y.crange
;
 ms0 = strtrim(m,1)
 ms1 = strtrim(m-1,1)
 ms2 = strtrim(m-2,1)
;
 fsplice = fltarr(2) + 0.95 * max(f1)
 s0 = ms0 + ' ' + ms1
; xyouts,i1,fsplice(0),s0,font=0,alignment=0.5
 xyouts,i1,1.05*!y.crange(1),s0,font=0,alignment=0.5
 s0 = ms1 + ' ' + ms2
; xyouts,i2,fsplice(1),s0,font=0,alignment=0.5
 xyouts,i2,1.05*!y.crange(1),s0,font=0,alignment=0.5
;
; update header record with splice points
;
; h([93,94,95,96]) = [i1,i1,i2,i2]
;
 return
 end  ; barker3