program coheat 

        implicit double precision (o-z, a-h)
        include "parameters.dat"
        character fname*64

        dimension wav(200),str(200),wid(200),eng(200),tmp(21),ht(21)
c       ----------------------------------------------------------
c             Read in line listing for fundamentals
c       ----------------------------------------------------------
        open(unit=20, file='/home/asgard/yelle/lines/coa.dat')
           read(unit=20, fmt=*) nlines
           stot = 0.d0
           do n = 1, nlines
              read(unit=20, fmt='(f10.6,e10.3,f5.3,f10.3)') 
     &         wav(n), str(n), wid(n), eng(n)
              stot = stot + str(n)
           end do
        close(unit=20) 

c       --------------------------------------------------------
c                     Loop through temperatures
c       --------------------------------------------------------
        ndat = 31
        do n = 1, ndat
           tmp(n) = 30.d0 + 10.*(n-1) 
           hckt = hck*(one/tmp(n)-one/296.d0)
           qrot = 296.d0/tmp(n)

c          -----------------------------------------------------
c                     Loop through lines
c          -----------------------------------------------------
           sum = zero
           do lw = 1, nlines

c              write(unit=*,fmt='(i5,f10.6,1x,e10.3,1x,f11.6)') 
c     &         lw,wav(lw),str(lw),eng(lw)

              hckw = hck*wav(lw)
              hckwt0 = hckw/296.d0
              hckwt = hckw/tmp(n)
              strn = qrot*str(lw)*dexp(-hckt*eng(lw))
     &         *(one-dexp(-hckwt))/(one-dexp(-hckwt0))
              bp = bplanck(wav(lw),tmp(n))
              sum = sum + bp*strn

           end do
           ht(n) = four*pi*sum
        end do

c       ----------------------------------------------------------
c                        Write output to Disc
c       ----------------------------------------------------------
        write(unit=*, fmt=905) 
        read (unit=*, fmt=900) fname
        open (unit=30, file=fname, status='new') 

           do n = 1, ndat
              write(unit=30, fmt=906) tmp(n),ht(n)
           end do

        close(unit=30)

        stop

c       ----------------------------------------------------------
c                              Formats
c       ----------------------------------------------------------
  900   format(a)
  905   format(' Enter filename for output > ',$)
  906   format(1x,0pf7.1,1x,1p9e11.3)

        end


        function bplanck(wav, temp)
        implicit double precision (o-z, a-h)
        parameter (one = 1.d0, c1 = 1.192d-5, c2 = 1.439565d0)
        c3 = dexp(- ((c2 * wav) / temp))
        bplanck = ((c1 * (wav ** 3)) * c3) / (one - c3)
        return 
        end