c tabulate reddening for E(B-V) = 1 mag
      parameter (NWAV=146, WMIN=1000., WMAX=8300.)
c
      open(unit=10,file='extinct.dat',status='new',
     &   carriagecontrol='list')
      write(10,*) 'Wavelength (Angstrom)  Extinction (mag, E(B-V)=1)'
      do iwav = 0, NWAV
           wav = iwav*(WMAX-WMIN)/NWAV + WMIN
           write(10,*) wav,getmag(wav)
      end do
      print *, 'Output in extinct.dat'
      call exit
      end
c
c
c------------------------------------------------------------------------------
      function GETMAG (w)
c------------------------------------------------------------------------------
c
c     this function calculates the effect of interstellar extinction
c     on wavelengths in the range 1000 to 8330 angstroms using
c     seaton's polynomial fit to an average galactic interstellar
c     extinction curve.  wavelengths outside of this range are not
c     correctable for interstellar extinction using seaton's fit.
c
      wv=1.0e4/w
      getmag=0.
      if (wv.gt.10.0) then
         return
      elseif (wv.ge.7.14) then
         getmag=16.17+wv*(wv*0.2975-3.20)
      elseif (wv.ge.3.65) then
         getmag=2.29+0.848*wv+1.01/((wv-4.60)**2+0.280)
      elseif (wv.ge.2.70) then
         getmag=1.56+1.048*wv+1.01/((wv-4.60)**2+0.280)
      elseif (wv.ge.1.80) then
         getmag=47.8395+wv*(-88.1616+wv*(62.2219+wv*
     1    (-18.77136+wv*2.0833326)))
      else
         getmag=-3.22714+wv*(7.99365+wv*(1.1111*wv-4.47619))
      endif
      return
      end