SUBROUTINE ARCRD(KHANEL,NATOMS,NN,A,NA,NB,NC,
     1                 LA,LB,LC,ISYM,IOERR)
      IMPLICIT REAL (A-H,O-Z)
      CHARACTER*3 FTYPE
      CHARACTER*80 DUMMY,KEYWRD,KOMENT,TITLE
      LOGICAL VERROR
      DIMENSION A(3,*),ISYM(10,*)
      DIMENSION LA(*),LB(*),LC(*),NA(*),NB(*),NC(*),NN(*)
      COMMON /KEYS  / KEYWRD,KOMENT,TITLE
      COMMON /FINFO / DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE,ICHARG
      COMMON /FINFOC/ FTYPE
C
C     DELTAH = HEAT OF FORMATION
C     RC     = REACTION COORDINATE VALUE
C     GRAD   = GRADIENT
C     RCGRAD = GRADIENT OF REACTION COORDINATE
C     VIP    = VERTICAL IONIZATION VALUE (KOOPMANS THEOREM)
C     DIPOLE = DIPOLE
C     ICHARG = CHARGE
C
C     INITIALIZE VARIABLES
      IOERR=0
      ICHARG=0
      DELTAH=0.D0
      RC=0.D0
      GRAD=0.D0
      RCGRAD=0.D0
      VIP=0.D0
      DIPOLE=0.D0
C
   10 READ(KHANEL,'(A)',END=110,ERR=120)DUMMY
      IF(INDEX(DUMMY,'CARTESIAN COORDINATES').NE.0)GOTO 90
      IF(INDEX(DUMMY,'FINAL GEOMETRY OBTAINED').NE.0)GOTO 100
      CALL PHRASE(DUMMY,'HEAT OF FORMATION',DELTAH,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'GRADIENT NORM',GRAD,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'FOR REACTION COORDINATE',RC,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'REACTION GRADIENT',RCGRAD,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'IONISATION POTENTIAL',VIP,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'DIPOLE',DIPOLE,NXTLIN)
      IF(NXTLIN.GE.0)GOTO 10
      CALL PHRASE(DUMMY,'CHARGE ON SYSTEM',ZCHARG,NXTLIN)
      IF(NXTLIN.EQ.1)ICHARG=ZCHARG
      GOTO 10
   90 READ(KHANEL,'(A)',END=110,ERR=120)DUMMY
      IF(INDEX(DUMMY,'FINAL GEOMETRY OBTAINED').EQ.0)GOTO 90
  100 CALL GEORD(KHANEL,NATOMS,NN,A,NA,NB,NC,
     1           LA,LB,LC,ISYM,IOERR)
C
C     CHECK FOR CHARGE
      IF(ICHARG.EQ.0)THEN
        I=INDEX(KEYWRD,'CHARGE=')
        IF(I.NE.0)ICHARG=READA(KEYWRD,I+7,VERROR)
        IF(VERROR)THEN
          IOERR=1
          WRITE(*,'(1X,A)')
     1    'ARCRD: UNABLE TO DETERMINE CHARGE FROM KEYWORD LINE'
        ENDIF
      ENDIF
      RETURN
  110 IOERR=1
      WRITE(*,'('' ARCRD: UNABLE TO USE OLD ARCHIVE FILE'')')
      RETURN
  120 IOERR=1
      WRITE(*,'('' ARCRD: UNABLE TO READ ARCHIVE FILE'')')
      RETURN
      END
C     *************************************************
      SUBROUTINE PHRASE(STRING,SUBSTR,DBLNUM,NXTLIN)
C     FORTRAN SUBROUTINE TO EXTRACT DBLNUM FROM STRING IF
C     DESIRED PHRASE (SUBSTR) FOLLOWED BY AN EQUAL SIGN IS FOUND
C
      CHARACTER*(*) STRING,SUBSTR
      REAL DBLNUM,ZDUMMY, READA
      LOGICAL DEFALT
C
      NXTLIN=-1
      I=INDEX(STRING,SUBSTR)
      IF(I.EQ.0)RETURN
      J=0
      NXTLIN=0
      LSTR=LEN(STRING)
      LSUB=LEN(SUBSTR)
C
C     SKIP CHECK FOR EQUAL SIGN IF EITHER END OF STRING AND SUBSTRING
C     COINCIDE OR, EVEN IF PRESENT, THE EQUAL SIGN MUST THE ONLY
C     CHARACTER IN STRING AFTER SUBSTR
      IF(I+LSUB.LT.LSTR)THEN
        J=INDEX(STRING(I+LSUB:),'=')
      ENDIF
      IF(J.EQ.0)RETURN
      J=I+LSUB+J
      IF(J.GT.LSTR)RETURN
      ZDUMMY=READA(STRING,J,DEFALT)
      IF(.NOT.DEFALT)THEN
        NXTLIN=1
        DBLNUM=ZDUMMY
      ENDIF
      RETURN
      END