IMFORT Script "magfl"


c MAGFL -- Convert a spectrum in units of magnitudes to
c         units of watt/cm**2-um  (logarithmic scaling).
c         (revised for V2.10)
c
c     usage:  magfl oldimage newimage
c ----------------------------------------------------------------------------

	program magfl

      real              rpix(2048), w0, wpc, w, y
	character*80	oimage, nimage, errmsg
	integer		ncols, nlines, nbands,  oim, nim
	integer		ier, axlen(7), naxis, pixtype, nargs

c --- Get command line arguments.
	call clnarg (nargs)
	if (nargs .eq. 2) then
	    call clargc (1, oimage, ier)
	    if (ier .ne. 0) goto 91
	    call clargc (2, nimage, ier)
	    if (ier .ne. 0) goto 91
	else
	    write (*, '('' input image: '',$)')
	    read (*,*) oimage
	    write (*, '('' output image: '',$)')
	    read (*,*) nimage
	endif

c --- Open the input image.
	call imopen (oimage, 1, oim, ier)
	if (ier .ne. 0) goto 91

c --- Set the pixel directory explicitly
      call imsdir ('/data0/pixels/')

c --- Create a new output image with the same header and size as the
c	input image.

	call imopnc (nimage, oim, nim, ier)
	if (ier .ne. 0) goto 91

c --- Determine the size and pixel type of the image being copied.
	call imgsiz (oim, axlen, naxis, pixtype, ier)
	if (ier .ne. 0) goto 91
	ncols  = axlen(1)
	nlines = axlen(2)
	nbands = axlen(3)

c --- Get wavelength scale from image header
      call imgkwr (oim, "CRVAL1", w0, ier)
      if (ier .ne. 0) goto 91
      call imgkwr (oim, "CDELT1", wpc, ier)
      if (ier .ne. 0) goto 91
      w = w0 - wpc

c --- Modify the image.
        call imgl1r (oim, rpix, ier)
      do 10 i = 1, ncols
      w = w + wpc
      y = 0.0001 * w
      rpix(i) = alog10(
     C  (1.945E-12)*(10**(-0.4*rpix(i)))/((y**5)*(exp(1.4605/y)-1)))
   10 continue
      call impl1r (nim, rpix, ier)

c --- Clean up.
	call imclos (oim, ier)
	if (ier .ne. 0) goto 91
	call imclos (nim, ier)
	if (ier .ne. 0) goto 91

	stop

c -- Error actions.
 91	call imemsg (ier, errmsg)
	write (*, '('' Error: '', a80)') errmsg

	stop
	end

rjoyce@noao.edu
18 August 1998