c======================================================================
c  hlgaps (HOMO-LUMO Gaps)
c  2006.02.16 Version 1.0 Sakane, Genta
c     ( Department of Chemistry, Okayama University of Science, Japan )
c  2006.03.20 Version 1.1 sym i5->i6 Sakane, Genta
c======================================================================
      program hlgaps
      integer numorb(10000),numsym(10000),lmf,lmn,hmn,lmn1,hmn1,hmn2
      character*6 sym(10000)
      character*5 updown(10000)
      character*19 key,see
      double precision enrry(10000),enrhr(10000),
     &enrev(10000),elenum(10000),teev(3,2),tenm(3,2),tecm(3,2),
     &hc,cmev,nmev,zero
      open (unit=20, form='formatted', status='old',
     &      access='sequential', file='F08E')
      open (unit=30, form='formatted', status='unknown',
     &      access='sequential', file='HLGAPS.OUT')
      hc=1.239841857
      cmev=hc*1e-4
      nmev=hc*1e3
      lmf=0
      zero=0.0
      key='*** M.O. EIGENVALUE'
   14 read(20,1010,err=11) see
      if(see.eq.key) go to 15
      go to 14
   15 read(20,1010,err=11) see
      read(20,1010,err=11) see
      read(20,1010,err=11) see
      do 10 i=1,10000
      read(20,1020,err=11,end=13) numorb(i),numsym(i),sym(i),
     &updown(i),enrry(i),enrhr(i),enrev(i),elenum(i)
      if(lmf.eq.0) then
      if(elenum(i).eq.zero) then
      lmn=i
      lmn1=i+1
      hmn=i-1
      hmn1=i-2
      hmn2=i-3
      lmf=1
      end if
      end if
   10 continue
   11 write(*,1030)
   13 continue
c---------------------------------------------------------------
      write(30,1040) 
     &numsym(lmn1),sym(lmn1),updown(lmn1),enrev(lmn1),elenum(lmn1),
     &numsym(lmn),sym(lmn),updown(lmn),enrev(lmn),elenum(lmn),
     &numsym(hmn),sym(hmn),updown(hmn),enrev(hmn),elenum(hmn),
     &numsym(hmn1),sym(hmn1),updown(hmn1),enrev(hmn1),elenum(hmn1),
     &numsym(hmn2),sym(hmn2),updown(hmn2),enrev(hmn2),elenum(hmn2)
      teev(1,1)=abs(enrev(lmn)-enrev(hmn))
      teev(1,2)=abs(enrev(lmn1)-enrev(hmn))
      teev(2,1)=abs(enrev(lmn)-enrev(hmn1))
      teev(2,2)=abs(enrev(lmn1)-enrev(hmn1))
      teev(3,1)=abs(enrev(lmn)-enrev(hmn2))
      teev(3,2)=abs(enrev(lmn1)-enrev(hmn2))
      do 20 i=1,3
      do 30 j=1,2
      tecm(i,j)=teev(i,j)/cmev
      tenm(i,j)=nmev/teev(i,j)
   30 continue
   20 continue
      write(30,1050) numsym(hmn),sym(hmn),updown(hmn),numsym(lmn),
     &sym(lmn),updown(lmn),teev(1,1),tecm(1,1),tenm(1,1)
      write(30,1050) numsym(hmn),sym(hmn),updown(hmn),numsym(lmn1),
     &sym(lmn1),updown(lmn1),teev(1,2),tecm(1,2),tenm(1,2)
      write(30,1050) numsym(hmn1),sym(hmn1),updown(hmn1),numsym(lmn),
     &sym(lmn),updown(lmn),teev(2,1),tecm(2,1),tenm(2,1)
      write(30,1050) numsym(hmn1),sym(hmn1),updown(hmn1),numsym(lmn1),
     &sym(lmn1),updown(lmn1),teev(2,2),tecm(2,2),tenm(2,2)
      write(30,1050) numsym(hmn2),sym(hmn2),updown(hmn2),numsym(lmn),
     &sym(lmn),updown(lmn),teev(3,1),tecm(3,1),tenm(3,1)
      write(30,1050) numsym(hmn2),sym(hmn2),updown(hmn2),numsym(lmn1),
     &sym(lmn1),updown(lmn1),teev(3,2),tecm(3,2),tenm(3,2)
      stop
 1010 format(10x,19a)
 1020 format(2i5,a6,a5,3f13.5,f10.5)
 1030 format('*** Read Error ***')
 1040 format(/,3x,'**************************',/,
     &3x,'***  HOMO - LUMO GAPS  ***',/,
     &3x,'**************************         [eV]    No.Electron',/,
     &3x,'*** LUMO+1',1x,i4,a6,1x,a5,1x,f13.5,5x,f4.1,/,
     &3x,'*** LUMO  ',1x,i4,a6,1x,a5,1x,f13.5,5x,f4.1,/,
     &3x,'*** HOMO  ',1x,i4,a6,1x,a5,1x,f13.5,5x,f4.1,/,
     &3x,'*** HOMO-1',1x,i4,a6,1x,a5,1x,f13.5,5x,f4.1,/,
     &3x,'*** HOMO-2',1x,i4,a6,1x,a5,1x,f13.5,5x,f4.1,//,
     &1x,' *** f r o m *** ==> ***   t o   *** ',2x,'[eV]',
     &5x,'[cm-1]',6x,'[nm]')
 1050 format(1x,i4,a6,1x,a5,1x,'==>',i4,a6,1x,a5,1x,f6.3,2x,f8.1,1
     &x,f8.1)
      end
