program jointabe
      implicit none
      integer*4 io0,nn0,n1,n2,i,nf,ne,nnum ,io,ii,it,n
      parameter (io0=2000,nn0=20)
      character*80 fn
      character*160 a,aa(io0)
      real*8 x,an(nn0),p(io0),q,emin,e(io0),t,en
c
      write(6,*)'Joins several .tab files listed in TAB.LST'
      write(6,*)'      weighed by energies in EN.LST'
     
      open(45,file='TAB.LST')
      n1=0
1001  read(45,*,end=1002,err=1002)
      n1=n1+1
      goto 1001
1002  rewind 45
      write(6,*)n1,' lines in TAB.LST'

      open(46,file='EN.LST')
      n2=0
1003  read(46,*,end=1004,err=1004)x
      n2=n2+1
      if(n2.gt.io0)call report('too many energies')
      e(n2)=x
      goto 1003
1004  close(46)
      write(6,*)n2,' lines in EN.LST'
      if(n1.ne.n2)call report('inconsistent numbers')

      write(6,*)'Temperature (K):'
      read(5,*)t
      emin=e(1)
      do 1005 i=2,n2
1005  if(e(i).lt.emin)emin=e(i)
      q=0.0d0
      do 1006 i=1,n2
1006  q=q+exp(-(e(i)-emin)*627.5d0/t/8.314d-3*4.184d0)
      write(6,*)'Probabilities:'
      do 1007 i=1,n2
      p(i)=exp(-(e(i)-emin)*627.5d0/t/8.314d-3*4.184d0)/q
1007  write(6,6001)i,p(i)
6001  format(i3,f10.4)

      open(46,file='ALL.TAB')
      write(46,101)
101   format(' PES ',/,/,'---------------')
      n=0
      nf=0
      ne=0
      nnum=0
1     read(45,4500,end=999,err=999)fn
4500  format(a80)
      n=n+1
c
      open(48,file=fn)
      read(48,*)
      read(48,*)
      read(48,*)
      io=0
3     read(48,480,end=900,err=900)a
480   format(a160)
      if(a(1:1).eq.'-')goto 900
      io=io+1
      nf=nf+1
      if(io.gt.io0)then
       write(6,*)fn
       write(6,*)io,io0
       write(6,*)'too many vibrations'
       goto 900
      endif
c
c     determine how many numbers there are in the line
      if(nnum.eq.0)then
1009   read(a,*,end=1008,err=1008)(x,i=1,nnum)
       nnum=nnum+1
       if(nnum.gt.NN0)call report('too many numbers')
       goto 1009
1008   write(6,*)nnum-1,' numbers in line'
       nnum=nnum-1
      endif
      read(a,*)it,en,(an(i),i=1,nnum-2)
      write(a,4009)it,en,(an(i)*p(n),i=1,nnum-2)
4009  format(i6,20G15.5)
      aa(io)=a
      goto 3
900   close(48)
c
      do 4 ii=1,io
      ne=ne+1
4     write(46,480)aa(ii)
c
      goto 1
999   close(45)
      write(46,104)
104   format('-----------------------------------')
      close(46)
      write(6,*)n,' tabs, ',nf,' frequencies, ',ne,' in ALL.TAB'
      stop
      end

      subroutine report(s)
      character*(*) s
      write(6,'(a)')s
      stop
      end