PROGRAM ANALYZEOLD
      IMPLICIT REAL*8 (A-H,O-Z)                                       
      CHARACTER*80 K80
      CHARACTER*1 OK
      DIMENSION MODE(100),W(100),Q(100),E(100)
c
      WRITE(*,8000)
8000  FORMAT(' Extract Gaussian files, complementary program ',/,
     1' to stretch.f; q1.out- input.file',/,
     2'              ft5.inp- output file',/)
      OPEN(17,FILE='q1.out',STATUS='OLD')                       
1     READ(17,'(a)',END=999,ERR=999)K80
1717  FORMAT(A80)
      IF(K80(2:5).NE.'Mode'.AND.K80(2:5).NE.'zero')GOTO 1
      WRITE(*,*)K80
      IF(K80(2:5).EQ.'zero')THEN
2      READ(17,'(a)',END=999,ERR=999)K80
       IF(K80(2:10).EQ.'SCF Done:')THEN
        E0=STRTON(K80,1)
        IF(ABS(E0-91).LT.0.1)E0=STRTON(K80,2)
        GOTO 1
       ELSE
        GOTO 2
       ENDIF
      ELSE
       IM=IM+1
       MODE(IM)=INT(STRTON(K80,1))
       W(IM)=STRTON(K80,2)
       Q(IM)=STRTON(K80,4)
3      READ(17,'(a)',END=999,ERR=999)K80
       IF(K80(2:10).EQ.'SCF Done:')THEN
        E(IM)=STRTON(K80,1)
        IF(ABS(E(IM)-91).LT.0.1)E(IM)=STRTON(K80,2)
        GOTO 1
       ELSE
        GOTO 3
       ENDIF
       GOTO 1
      ENDIF
C
999   CLOSE(17)
      OPEN(3,FILE='ft5.inp')
      H=219470.0D0
      WRITE(3,3000)0.0D0,E0*H
3000  FORMAT(F15.8,F20.9)
      ML=0
      DO 4 I=1,IM
      M=MODE(I)
      IF(M.NE.ML)THEN
       ML=M
       WRITE(3,3001)M,W(I)
3001   FORMAT(I4,' mode; ',F10.2,' cm-1:')
       WRITE(3,3000)0.0D0,E0*H
      ENDIF
      DEL=Q(I)/0.02342179*SQRT(W(I)/219470.0)
4     WRITE(3,3000)DEL,E(I)*H
      CLOSE(3)  
      STOP
      END

      FUNCTION STRTON(K80,COUNT)
      REAL*8 STRTON
      CHARACTER*80 K80,KTEM
      INTEGER COUNT,I,IT,IC
      CHARACTER*1 LET,LT,OK
      INTEGER II(80)
c
      STRTON=0.0D0
      I=0
      IT=0
      IC=0  
1     I=I+1
      IF(I.GT.79)RETURN
      LET=K80(I:I)
      IF(LET.EQ.'1'.OR.LET.EQ.'2'.OR.LET.EQ.'3'.OR.
     1   LET.EQ.'4'.OR.LET.EQ.'5'.OR.LET.EQ.'6'.OR.
     1   LET.EQ.'7'.OR.LET.EQ.'8'.OR.LET.EQ.'9'.OR.
     1   LET.EQ.'0'.OR.LET.EQ.'-'.OR.LET.EQ.'.')THEN
       IT=IT+1
       II(IT)=I
       KTEM(IT:IT)=LET
       GOTO 1
      ELSE
       IF(IT.GT.0)THEN
        DO 2 J=1,IT
        LT=KTEM(J:J)
        LET=K80(II(J)+1:II(J)+1)
        IF(LT.EQ.'-')THEN
         IF(
     1    LET.NE.'1'.AND.LET.NE.'2'.AND.LET.NE.'3'.AND.
     1    LET.NE.'4'.AND.LET.NE.'5'.AND.LET.NE.'6'.AND.
     1    LET.NE.'7'.AND.LET.NE.'8'.AND.LET.NE.'9'.AND.
     1    LET.NE.'0'.AND.LET.NE.'.')THEN
          IT=0
          GOTO 1
         ENDIF
        ENDIF
        IF(LT.EQ.'.')THEN
         IF(
     1    LET.NE.'1'.AND.LET.NE.'2'.AND.LET.NE.'3'.AND.
     1    LET.NE.'4'.AND.LET.NE.'5'.AND.LET.NE.'6'.AND.
     1    LET.NE.'7'.AND.LET.NE.'8'.AND.LET.NE.'9'.AND.
     1    LET.NE.'0')THEN
          IT=0
          GOTO 1
         ENDIF
        ENDIF
2       CONTINUE
        IC=IC+1
        IF(IC.EQ.COUNT)THEN
         OPEN(13)
         WRITE(13,*)KTEM(1:IT)
         CLOSE(13)
         OPEN(13)
         READ(13,*)ASTRTON
         CLOSE(13)
         STRTON=ASTRTON
         RETURN
        ENDIF
       ENDIF 
       IT=0
       GOTO 1
      ENDIF
      END
         

cDefault route: MaxDisk=250000000
c------------------------------------------------------------
c#BPW91/6-31G** SP SCF=TIGHT NOSYMM GEOM=(NODISTANCE,NOANGLE)
c------------------------------------------------------------
czero geometry
c-------------
cSCF Done:  E(RB-PW91) =  -390.612184515     A.U. after   15 cycles
c            Convg  =    0.6279D-08             -V/T =  2.0109
c-----------------------------------------
cMode 1( 3096.9cm-1), stretched 0.100 Bohr