program specav2d
      real,allocatable::yt(:)
      character*80  fn
      logical lex

      write(6,*)'Boltzmann averaging of generated spectra 300K'
      write(6,*)'   Input: ENERGIES.LST (au)'
      write(6,*)'          NAMES.LST'
      emin=0.
      inquire(file='ENERGIES.LST',exist=lex)
      if(lex)then
       open(8,file='ENERGIES.LST')
       i=0
       q=0.
1      read(8,*,end=99,err=99)e
       i=i+1
       if(i.eq.1.or.e.lt.emin)emin=e
       goto 1
99     write(6,*)'emin: ',emin
       rewind 8
       do 2 j=1,i
       read(8,*)e
       ef=627.5*(e-emin)/0.6
2      if(ef.lt.20.)q=q+exp(-ef)
       write(6,*)'Q: ',q
       close(8)
       inquire(file='NAMES.LST',exist=lex)
       if(lex)then
        open(10,file='S.PRN')
        open(9,file='NAMES.LST')
        open(8,file='ENERGIES.LST')
        do 3 j=1,i
        read(8,*)e
        ef=627.5*(e-emin)/0.6
        p=0.
        if(ef.lt.20.)p=exp(-ef)/q
        read(9,90)FN
90      format(a80)
        write(6,600)j,FN(1:40),p*100.
600     format(i5,1x,a40,1x,f10.4,' %')
        open(99,file=FN)
        if(j.eq.1)then
         np=0
4        read(99,*,err=88,end=88)x,y
         np=np+1
         goto 4
88       rewind(99)
         allocate(yt(np))
        endif
        do 5 k=1,np
        read(99,*)x,y
        yt(k)=yt(k)+p*y
5       if(j.eq.i)write(10,100)x,yt(k)
100     format(f12.4,1x,g16.6)
        close(99)
3       continue
        close(8)
        close(9)
        close(10)
        write(6,*)'S.PRN written, ',np,' points'
       else
        write(6,*)'NAMES.LST does not exist'
       endif
      else
       write(6,*)'ENERGIES.LST does not exist'
      endif
      end