c============================================================
c  prestsL
c   Program for calculating transition energy in F08E
c   Prests is an abbreviation of Pre-Slater-Transition-State.
c    1992.01.16  Version 1.0   written by G.Sakane
c    2004.10.16  Version 1.1 
c============================================================
      program prestsl
      integer numorb(10000),numsym(10000),num,nts
      character*5 sym(10000),updown(10000)
      character*19 key,see
      double precision enrry(10000),enrhr(10000),
     &enrev(10000),elenum(10000),teev,tenm,tecm,ts,
     &hc,cmev,nmev
      open (unit=20, form='formatted', status='old',
     &      access='sequential', file='F08E')
      open (unit=30, form='formatted', status='unknown',
     &      access='sequential', file='prests.out')
      open (unit=28, form='formatted', status='unknown',
     &      access='sequential', file='prests.srt')
      open (unit=29, form='formatted', status='unknown',
     &      access='sequential', file='prests.tit')
      hc=1.239841857
      cmev=hc*1e-4
      nmev=hc*1e3
      nts=0
      ts=180
      num=0
      key='*** M.O. EIGENVALUE'
   14 read(20,1004,err=11) see
      if(see.eq.key) go to 15
      go to 14
   15 read(20,1004,err=11) see
      read(20,1004,err=11) see
      read(20,1004,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
c---------------------------------------------------------------
      write(30,3003) ts
      write(29,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
      if(elenum(i).ge.1) then
      if(elenum(j).lt.1) then
      write(30,1003) numsym(i),sym(i),updown(i),numsym(j),sym(j),
     &updown(j),teev,tecm,tenm
      write(28,1005) tenm,numsym(i),sym(i),updown(i),numsym(j),
     &sym(j),updown(j),teev,tecm,tenm
      nts=nts+1
      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)
 4001 format(2x,i3,2x,i3,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,f8.1)
 1004 format(10x,19a)
 1005 format(f8.1,1x,i4,1x,a5,1x,a5,1x,'==>',i4,1x,a5,1x,a5,1x,
     &f6.3,2x,f7.1,1x,f8.1)
 3003 format(3x,
     &'Transition Energy is greater than (or equal)',f9.3,'[nm]',
     &//,1x,' *** f r o m *** ==> ***   t o   *** ',1x,'[eV]',
     &4x,'[cm-1]',5x,'[nm]')
      end
