c============================================================
c  endsts
c   Program for calculating transition energy in F08E
c   Prests is an abbreviation of End-Slater-Transition-State.
c    1992.01.16  Version 1.0   written by G.Sakane
c    2004.10.16  Version 1.1 
c============================================================
      program endsts
      integer numorb(10000),numsym(10000),
     &num,choice,one,two,three
      character*5 sym(10000),updown(10000)
      character*19 key,see
      double precision enrry(10000),enrhr(10000),enrev(10000),
     &teev,tenm,tecm,ts,cmev,nmev,hc
      real elenum(10000),haf,hafnum(10000) 
      open (unit=20, form='formatted', status='old',
     &      access='sequential', file='F08E')
      open (unit=30, form='formatted', status='unknown',
     &      access='sequential', file='endsts.out')
      hc=1.239841857
      cmev=hc*1e-4
      nmev=hc*1e3
      one=1
      two=2
      three=3
      haf=0.5
      ts=200
      num=0
      key='*** M.O. EIGENVALUE'
   14 read(20,1006,err=11) see
      if(see.eq.key) go to 15
      go to 14
   15 read(20,1006,err=11) see
      read(20,1006,err=11) see
      read(20,1006,err=11) see
      do 10 i=1,10000
      num=num+1
      read(20,1001,err=11,end=13) numorb(i),numsym(i),sym(i),
     &updown(i),enrry(i),enrhr(i),enrev(i),elenum(i)
   10 continue
   11 write(*,1002)
   13 num=num-1
      write(30,3003) ts
      do 18 i=1,num
      do 19 j=1,num
      if(enrev(i).eq.enrev(j)) then
      go to 19
      else
      teev=abs(enrev(j)-enrev(i))
      tecm=teev/cmev
      tenm=nmev/teev
      if(tenm.ge.ts) then
      hafnum(i)=elenum(i)-int(elenum(i))
      if(hafnum(i).eq.haf) then
      if(elenum(j).eq.haf) then
      if(i.lt.j) then
      write(30,1003) numsym(i),sym(i),updown(i),numsym(j),sym(j),
     &updown(j),teev,tecm,tenm
      write(30,1004) numorb(i),numsym(i),sym(i),updown(i),enrry(i),
     &enrhr(i),enrev(i),elenum(i)
      write(30,1005) numorb(j),numsym(j),sym(j),updown(j),enrry(j),
     &enrhr(j),enrev(j),elenum(j)
      write(*,1004) numorb(i),numsym(i),sym(i),updown(i),enrry(i),
     &enrhr(i),enrev(i),elenum(i)
      write(*,1005) numorb(j),numsym(j),sym(j),updown(j),enrry(j),
     &enrhr(j),enrev(j),elenum(j)
      write(*,1007)
      write(*,3003) ts
      write(*,1003) numsym(i),sym(i),updown(i),numsym(j),sym(j),
     &updown(j),teev,tecm,tenm
      else
      go to 19
      end if
      else
      go to 19
      end if
      else
      go to 19
      end if
      else
      go to 19
      end if
      end if
   19 continue
   18 continue
      stop
 1001 format(2i5,1x,2a5,3f13.5,f10.5)
 1002 format('*** Read Error ***')
 1003 format(1x,i4,1x,a5,1x,a5,1x,'==>',i4,1x,a5,1x,a5,1x,f6.3,2x,
     &f7.1,1x,f6.1)
 1004 format(/,'*** Slater Transition State Calculation ***',//,
     &'*** from ***',/,2x,i3,2x,i3,1x,2a5,3f13.5,f10.5)
 1005 format(/,'***  to  ***',/,2x,i3,2x,i3,1x,2a5,3f13.5,f10.5)
 1006 format(10x,19a)
 1007 format(/)
 3003 format(3x,
     &'Transition Energy is greater than (or equal)',f9.3,'[nm]',
     &//,1x,' *** f r o m ***     ***   t o   *** ',1x,'[eV]',
     &3x,'[cm-1]',3x,'[nm]')
      end
