c
c This program will Straighten Cross Dispersed Spectra 
c Pixals are removed utill a series of zero pixals are incountered
c By Richard Elston, 8/17/93
c
c  Inname=Name of the input image
c  outname=Name of flux spectra
c
c	Implicit none
	Character*80 Inname, outname,band,errmsg
	Character*20 dummy
	Integer ier, npar, inim, otim
	Integer axlen(7), naxis, dtype,order
	Integer ncol, nline, line0, line, outline, col, line
	Real  temp(256),inspec(256,256), outspec(256,256)
	real x0,y0,low,high,junk,c0,c1,c2,c3,c4,xmin,xmax
	real f1,f2,f3,f4,f5
c
c read in the CL information
c
	ier=0
	Call clnarg(npar)
	if(npar.eq.3) then
		Call Clargc(1, inname, ier)
		if(ier.ne.0) goto 666
		Call Clargc(2, outname, ier)
		if(ier.ne.0) goto 666
		Call Clargc(3, band, ier)
		if(ier.ne.0) goto 666

	Else
		Write(*, '('' input spectra : '',$)')
		Read(*,10) inname
10		format(1a80)
		Write(*, '('' output name : '',$)')
		Read(*,10)  outname
		Write(*, '('' ref image database : '',$)')
		Read(*,10)  band   

	Endif
c
c open the input spectra
c
	Call imopen(inname, 1, inim, ier)
	if (ier.ne.0) goto 666
c
c open the output spectra
c
	Call Imopnc ( outname, inim, otim, ier)
	if (ier.ne.0) goto 666
c
c read the header 
c
	Call imgsiz (inim, axlen, naxis, dtype, ier)
	if (ier.ne.0) goto 666
	ncol=axlen(1)
	nline=axlen(2)
c
c Read in the input image                   
c
	Do line=1,nline
		Call imgl2r (inim, temp, line, ier)
		if (ier.ne.0) goto 666
		Do col=1,ncol  
			inspec(col,line)=temp(col)
		enddo
	enddo
c
c read in the ref trace
c
	band="database/apref."//band
	open(unit=15,file=band,status="old")
	do i=1,5
		read(15,30) dummy
30		format(A14)
	enddo
	read(15,*) dummy,x0,y0
	read(15,*) dummy,junk,low
	read(15,*) dummy,junk,high
	do i=1,14
		read(15,30) dummy
	enddo	
	read (15,*) order
	read(15,*) xmin 
	read(15,*) xmax  
	read(15,*) c0
	read(15,*) c1
	if(order.ge.3) then
		read(15,*) c2
	    else
		c2=0
	endif
	if(order.ge.4) then
		read(15,*) c3
	    else
		c3=0
	endif
	if(order.ge.5) then
		read(15,*) c4
	    else
		c4=0
	endif
	close (unit=15)

c
c Loop in the image striping the junk pixals
c
	Do col=1,ncol
		outline=1
		x=(2.0*real(col)-xmax-xmin)/(xmax-xmin)
c
c y=y0+c0*(x-x0)+c1*((x-x0)/x0)**2.0+c2*((x-x0)/x0)**3.0 
c y=y+c3*((x-x0)/x0)**4.0+c4*((x-x0)/x0)**5.0
c
		f1=1
		f2=x
		f3=(3.0*x*f2-f1)/2.0
		f4=(5.0*x*f3-2.0*f2)/3.0
		f5=(7.0*x*f4-3.0*f3)/4.0
		y=y0+c0*f1+c1*f2+c2*f3+c3*f4+c4*f5
		line0=y+low
		nline=y+high
		Do line=line0,nline
			outspec(col,outline)=inspec(col,line)
			outline=outline+1
		enddo
	enddo
c
c save the output specta
c
	Do line=1,nline
		Do col=1,ncol  
			temp(col)=outspec(col,line)
		enddo
		Call impl2r (otim, temp, line, ier)
		if (ier.ne.0) goto 666
	enddo
c
c Close the spectra
c
	Call imclos (otim, ier) 
	if (ier.ne.0) goto 666
	Call imclos (inim, ier) 
	if (ier.ne.0) goto 666
	stop
c
c Error routine
c
666	Call imemsg (ier, errmsg)
	Write(*, '(''Error: '',a80)') errmsg
	stop
	End