c
c This program will create a spectra from a standard star
c which can be used to flux an IR spectra
c By Richard Elston, 4/11/89
c
c Multiply a spectra in ADU/SEC by the output spectra to produce
c a spectra in Jansky
c
c  Inname=Name of the input image
c  outname=Name of flux spectra
c  tau=exposure time of standard
c  band=band in which photometry of star is known
c  Mag=Magnitude of standard star
c
c
c Modified for New formation linearily dispersion corrected 
c data, also take exposure time from OTIME for OSIRIS 8/28/93 by Elston
c
c	Implicit none
	Character*80 Inname, outname
	Character*80 errmsg
	Integer ier, npar, inim, otim, npix, i
	Integer axlen(7), naxis, dtype, band
	Real  Spec(256), W0, WPC, mag, flux, f0, Lam0, tau, lam, teff
c
c read in the CL information
c
	ier=0
	Call clnarg(npar)
	if(npar.eq.5) then
		Call Clargc(1, inname, ier)
		if(ier.ne.0) goto 666
		Call Clargc(2, outname, ier)
		if(ier.ne.0) goto 666
		Call Clargi(3, band, ier)
		if(ier.ne.0) goto 666
		Call Clargr(4, Mag, ier)
		if(ier.ne.0) goto 666
		Call Clargr(5, Teff, ier)
	Else
		Write(*, '('' input spectra : '',$)')
		Read(*,10) inname
10		format(1a80)
		Write(*, '('' output name : '',$)')
		Read(*,10)  outname
		Write(*, '('' Standard Band 1-4=J-L : '',$)')
		Read(*,*) band
		Write(*, '('' Star Magnitude in Band : '',$)')
		Read(*,*) mag
		Write(*, '('' Effective Temperature of Star : '',$)')
		Read(*,*) teff
	Endif
c
c open the input spectra
c
	Call imopen(inname, 1, inim, ier)
	if (ier.ne.0) goto 666
	Call imgl1r(inim, spec, ier)
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 imgkwr (inim, 'CRVAL1' , W0, ier)
	if (ier.ne.0) goto 666
	Call imgkwr (inim, 'CD1_1', WPC, ier)
	if (ier.ne.0) goto 666
	Call imgkwr (inim, 'INT_S', tau, ier)
	if (ier.ne.0) goto 666
	Call imgsiz (inim, axlen, naxis, dtype, ier)
	if (ier.ne.0) goto 666
	npix=axlen(1)
c
c close the input image
c
	Call imclos (inim, ier)
c
c compute the flux zero point information for the standard
c
	If(band.eq.1) then
		Lam0=1.25
		F0=1560
	endif
	If(band.eq.2) then
		Lam0=1.65
		F0=1010
	endif
	if(band.eq.3) then
		Lam0=2.20
		F0=616
	endif
	If(band.eq.4) then
		Lam0=3.45
		F0=283
	endif
	If(lam0.eq.0) then
		Write(*,*) 'Not a valid band'
		stop
	endif
	F0=F0*10.0**(Mag/(-2.5))
	Write(*,30) F0, Lam0
30	Format(' Standard flux is : ',F7.3,' at ', F4.2, 'microns')
c
c Normalize input spectrum by flux
c
	Do I=1,npix
	   Lam=w0+Real(i)*wpc
	   Flux=F0*(Lam0**3.0*(exp(1.44e4/(Teff*lam0))-1.0))
	   Flux=Flux/(lam**3.0*(exp(1.44e4/(teff*lam))-1.0))
	   Spec(I)=Flux/Spec(I)*tau
	enddo
c
c write out the flux calibration spectra
c
	Call Impl1r(otim, Spec, ier)
	if (ier.ne.0) goto 666
c
c close the output image
c
	Call Imclos (otim, ier)
	if (ier.ne.0) goto 666
	stop
c
c Error routine
c
666	Call imemsg (ier, errmsg)
	Write(*, '(''Error: '',a80)') errmsg
	stop
	End