      SUBROUTINE READER(GEO, NAT, NA, NB, NC, IOPT,
     +                  LR,FVECT,LF,VIBVEC,LV,CVECT, LC,
     +                  CBETA,LCB,BONDS,LB, IR, IOERR)
C
C         Notice of Public Domain nature of this Program
C
C      'This computer program is a work of the United States 
C       Government and as such is not subject to protection by 
C       copyright (17 U.S.C. # 105.)  Any person who fraudulently 
C       places a copyright notice or does any other act contrary 
C       to the provisions of 17 U.S. Code 506(c) shall be subject 
C       to the penalties provided therein.  This notice shall not 
C       be altered or removed from this software and is to be on 
C       all reproductions.'
C
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      REAL FVECT, VIBVEC, CVECT, CBETA
      INTEGER OFFSET
      DIMENSION RIJ(3,NUMATM), FVECT(3*NUMATM, 3*NUMATM), NAT( NUMATM),
     .          NA( NUMATM) , NB( NUMATM), NC( NUMATM), GEO( 3, NUMATM),
     .          VIBVEC(3*NUMATM, 3*NUMATM), CVECT(1000), CBETA(1000), 
     .          BONDS( MPACK ), IA( NUMATM), IB( NUMATM), IC(NUMATM)
      CHARACTER*3 FTYPE
      CHARACTER*80 KEYWRD, KOMENT, TITLE
      LOGICAL LR,LF,LV,LC,LCB,LB, ERROR, FIRST, NEWDAT, FINGEO
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /FINFO/ DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE, ICHARG
      COMMON /FINFOC/ FTYPE
*
* DELTAH := HEAT OF FORMATION
* RC     := REACTION COORDINATE VALUE
* GRAD   := GRADIENT
* RCGRAD := GRADIENT OF REACTION COORDINATE
* VIP    := VERTICAL IONISATION VALUE (KOOPMAN'S THEOREM)
* ICHARG := CHARGE ON SYSTEM
      COMMON /SYMTRY/ ISYM( 10, NUMATM)
      COMMON /DATUMS/ NVAR, NUMAT, NORBS, NELECS, NALPHA, NBETA, NCLOSE,
     +        NOPEN, NATOMS
      COMMON /KEYS/ KEYWRD, KOMENT, TITLE
      COMMON /FILEST/ FIRST
      COMMON /ARRAYS/ EIGS(MAXORB), EIGB(MAXORB), LOC(2,MAXPAR), 
     +        NFIRST(MAXORB), NLAST(MAXORB), 
     +        EVIBS(MAXPAR*3),
     +        COORD(3,NUMATM), FEIGS(3*MAXPAR), Q(NUMATM), AMS(NUMATM)
************************************************************************
*  GENERAL PURPOSE READER. THE ORDER OF PHARSING IS
* 1:  SINGLE WORDS, E.G. MNDO, UHF, NLLSQ, ETC
* 2:  SINGLE DATA, E.G. <SZ>, HEAT OF FORMATION, CORE-CORE REPULSION.
* 3:  SMALL DATA, E.G. COORDINATES, SPIN POPULATIONS.
* 4:  *
************************************************************************
      CHARACTER WORDS*7, DATUM*7, SMALL*7, LARGE*14, DUMC*1,
     +     ELEM*2, CHARAC*1, SOPT(3)*3, LINE*80, LINE2*80
      DIMENSION WORDS(30), DATUM(30), SMALL(30), LARGE(30)
      DIMENSION GOTW(30), GOTD(30), GOTS(30), GOTL(30)
      LOGICAL GOTW,GOTD,GOTS,GOTL
      DIMENSION VALD(30)
      DIMENSION IOPT(3, NUMATM)
      CHARACTER ATSYMB*6
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /FORGEO/ FORORE( 3, NUMATM), IEFOR( NUMATM)
      DATA GOTW,GOTD,GOTS,GOTL/120*.FALSE./
      DATA WORDS/ '  MNDO ', '  UHF  ', ' NLLSQ ', '  AM1  ','MINDO/3',
     +            ' 1SCF  ', 'SIGMA  ', 'BIRADIC', ' C.I.  ','EXCITED',
     +            ' FORCE ', 'PRECISE', 'SADDLE ', ' SIGMA ','SYMMETR',
     +            ' THERMO', 'TRIPLET', 13*'XXXXXXX'/
      DATA DATUM/'PHA ELE','TA  ELE','RADIENT','HEAT:  ','VERSION',
     +           'NAL HEA','NIC ENE','ORE REP','ION POT','ION TIM',
     +           'SCF CAL',' <SZ>  ',' <S**2>',' OF SIN','AT OF F',
     +           'BLY OCC', 'LED LEV', 'LAR WEI', 'ERO POI',
     +           11*'XXXXXXX'/
      DATA SMALL/'IST ANG','IAN COO','NAL GEO','0DIPOLE','RON POP',
     +           'GENVALU','OLE CON','TER DEP', 22*'XXXXXXX'/
      DATA LARGE/'NTERATOMIC DIS','ALPHA EIGENVEC',
     .           'BETA EIGENVECT','L COORDINATE A',
     .           'D COORDINATE A','BOND ORDERS AN',
     .           'PTION OF VIBRA','QUENCIES, REDU',
     .           ' FORCE MATRIX ','DINATE DERIVAT',
     .           'ATION OF MOLEC','DYNES/ANGSTROM',
     .           'LATED THERMODY','NCIPAL MOMENTS',
     .           'STIMATED TIME ','RATIONS, SHOUL','ARE THE TRANSLA',
     .           'ALISATION VALU','  EIGENVECTORS',
     +           11*'XXXXXXX'/
*
*  LET'S CLEAR THE VARIABLES INCASE WE ARE RE-ENTERING
*
      NVAR = 0
      NUMAT = 0
      NORBS = 0
      NELECS = 0
      NALPHA = 0
      NBETA = 0
      NCLOSE = 0
      NOPEN = 0
      NATOMS = 0
      RIJ( 1, 1) = 0
      FVECT(1,1) = 0
      VIBVEC(1,1) = 0
      CVECT(1) = 0
      CBETA(1) = 0
      BONDS(1) = 0
      EIGS(1)=0
      EIGB(1) = 0
      LOC(1,1) = 0
      NAT(1) = 0
      NFIRST(1) = 0
      NLAST(1) = 0
      EVIBS(1) = 0
      FEIGS(1) = 0
      Q(1) = 0
      AMS(1) = 0
      MODVIB = 0
*
*  CLEAR VARIABLES FOR RE-ENTRY CASE
*
      DELTAH = 0.0D0
      RC = 0.0D0
      GRAD = 0.0D0
      RCGRAD = 0.0D0
      VIP = 0.0D0
      DIPOLE = 0.0D0
C?    ICHARG = 0
*      
      LR=.FALSE.
      LF=.FALSE.
      LV=.FALSE.
      LC=.FALSE.
      LCB=.FALSE.
      LB=.FALSE.
      NEWDAT = .FALSE.
      ISP1 = NUMELE('-')
      ISP2 = NUMELE('--')
      ISP3 = NUMELE('+')
      ISP4 = NUMELE('++')
      DO 10 NWORDS=1,29
  10      IF(WORDS(NWORDS+1).EQ.'XXXXXXX') GOTO 11
  11  DO 12 NDATUM=1,29
  12      IF(DATUM(NDATUM+1).EQ.'XXXXXXX') GOTO 13
  13  DO 14 NSMALL=1,29
  14      IF(SMALL(NSMALL+1).EQ.'XXXXXXX') GOTO 15
  15  DO 16 NLARGE=1,29
  16      IF(LARGE(NLARGE+1).EQ.'XXXXXXX') GOTO 17
  17  CONTINUE
      KEYWRD = ' '

*
* FIRST, READ IN A LINE OF TEXT.
*
      IF (DEBUGI) THEN
         CALL DEBUGR(' LINES NOT UNDERSTOOD')
      ENDIF
      NKEY=2
 1000 READ( IR,'(A)',END=999,ERR=999)LINE
      IF ( INDEX( LINE, '**********') .GT. 0) THEN
        IF(DEBUGI) CALL DEBUGR('READER:  START BANNER')
 1001    READ( IR,'(A)',END=999,ERR=999)LINE
         IF ( INDEX( LINE, '**********') .GT. 0) THEN
           IF(DEBUGI) CALL DEBUGR('READER:  END BANNER')
* HERE IS BOTTOM OF THE BANNER SECTION
            GOTO 1000
         ELSEIF ( INDEX( LINE, ' REACTION COORDINATE = ') .GT. 0) THEN
            FIRST = .FALSE.
            RETURN
         ELSEIF ( INDEX( LINE, 'CHARGE ON SYSTEM') .GT. 0) THEN
            CALL LCLEAN( LINE, LINE, .TRUE.)
            CALL POPARG( LINE, LINE)
            CALL POPARG( LINE, LINE)
            CALL POPARG( LINE, LINE)
            CALL POPARG( LINE, LINE)
            ICHARG = READA( LINE, 1, ERROR)
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'TRIX TO BE PRINTED') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'DISTANCES NOT TO BE P') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'COORDINATES NOT TO BE') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'OVERRIDE INTERATOMIC ') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'DUMP=N') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'DAMPING FACT') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'ITERATIONS FOR SCF') .GT. 0) THEN
            GOTO 1001
         ELSEIF ( INDEX( LINE, 'CALCULATION RESULTS') .GT. 0) THEN
            FIRST = .TRUE.
            IF (DEBUGI) CALL DEBUGR( 'IN READER: FIRST BEING SET TRUE.')
            GOTO 1001
         ELSEIF ( INDEX( LINE, ' VERSION ') .GT. 0) THEN
            VERMOP = READA( LINE, INDEX( LINE, 'VERSION')+7, ERROR)
            IF (DEBUGI) THEN
              WRITE (*,'('' READER: VERSION OF MOPAC IS '',F4.2)')VERMOP
            ENDIF
            GOTO 1001
         ELSE
            GOTO 1001
         ENDIF
      ELSEIF ( INDEX( LINE, ' REACTION COORDINATE ') .GT. 0) THEN
         CALL LCLEAN( LINE, LINE, .TRUE.)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         IF ( INDEX( LINE, '=') .GT. 0) CALL POPARG( LINE, LINE)
         RC = READA( LINE, 1, ERROR)
      ELSEIF ( INDEX( LINE, ' REACTION GRADIENT ') .GT. 0) THEN
         CALL LCLEAN( LINE, LINE, .TRUE.)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         RCGRAD = READA( LINE, 1, ERROR)
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'TIME FOR DERIVATIVES') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'SYMMETRY WAS SPECIFIED, B') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'DEFAULT TIME OF') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX(LINE, 'CYCLE:') .GT. 0) THEN
         CALL LCLEAN( LINE, LINE, .TRUE.)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         GRAD = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         DELTAH = READA( LINE, 1, ERROR)
         GOTO 1000
      ELSEIF ( INDEX(LINE, 'STEP:') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX(LINE, '- CALCULATION RES') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX(LINE, '- A TIME OF') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX(LINE, 'THE SYSTEM IS A ') .GT. 0) THEN
         IF ( INDEX( LINE, ' POLYMER') .GT. 0) THEN
            MODVIB = 3
         ENDIF
         GOTO 1000
      ELSEIF ( INDEX(LINE, 'UNIT CELL TRAN') .GT. 0) THEN
         READ( IR,'(A)',END=999,ERR=999)LINE
         READ( IR,'(A)',END=999,ERR=999)LINE
         READ( IR,'(A)',END=999,ERR=999)LINE
         GOTO 1000
      ELSEIF ( INDEX( LINE, ' A TIME OF ') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, ' FIRST DERIVATIVES') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'HERBERTS TEST') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'ST ON X SATISFI') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, ' TIME DEFINED FOR ') .GT. 0) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, ' TIME UP ') .GT. 0) THEN
         CALL DEBUGR( 'YOUR CALCULATION DID NOT FINISH.')
         CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '//
     .        'PARTIALLY OPTIMIZED GEOMETRY...')
         READ (*, '(A)') LINE
 8000    READ( IR,'(A)',END=999,ERR=999)LINE
         IF ( INDEX( LINE, 'CURRENT VALUE OF HEAT OF F')
     .         .NE. 0) THEN
            LINE2 = LINE( INDEX( LINE, '=')+1: )
            CALL LCLEAN( LINE2, LINE, .TRUE.)
            DELTAH = READA( LINE, 1, ERROR)
            IF ( ERROR ) DELTAH = 0.0D0
         ELSEIF( INDEX( LINE, 'CURRENT VALUES OF GEOMETRIC V')
     .         .NE. 0) THEN
            READ (*, '(A)') LINE
            READ (*, '(A)') LINE
         ELSE
            GOTO 8000
         ENDIF
         CALL GEORD( IR, NATOMS, NAT, GEO, NA, NB, NC, IA, IB, IC,
     .              ISYM, IOERR)
         IF ( IOERR .NE. 0 ) GOTO 999
         DO 8100 I=1, NATOMS
C?            WRITE (*,*) NAT(I),GEO(1,I),IA(I),GEO(2,I),IB(I),
C?     .                  GEO(3,I),IC(I),NA(I),NB(I),NC(I)
            IOPT( 1, I) = IA( I)
            IOPT( 2, I) = IB( I)
            IOPT( 3, I) = IC( I)
 8100    CONTINUE
         NEWDAT = .TRUE.
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'CYCLES EXCEEDED, G') .GT. 0) THEN
**
*   CYCLES EXCEEDED, GRADIENT NOT FULLY MINIMIZED IN NLLSQ   
**
         CALL DEBUGR( 'YOUR CALCULATION EXCEEDED THE NLLSQ CYCLES.')
         CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '//
     .        'PARTIALLY OPTIMIZED GEOMETRY...')
         READ (*, '(A)') LINE
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'CALCULATION ABANDON') .GT. 0) THEN
         CALL DEBUGR( 'YOUR CALCULATION WAS ABANDONED...')
         CALL UPROMP( 'PRESS RETURN TO CONTINUE WITH '//
     .        'WHATEVER GEOMETRY RESULTED ...')
         READ (*, '(A)') LINE
 8020    READ( IR,'(A)',END=999,ERR=999)LINE
         IF ( INDEX( LINE, 'NC:NB:NA:I') .NE. 0 ) GOTO 8020
         READ( IR,'(A)',END=999,ERR=999)LINE
         CALL GETGEO( IR, NAT, GEO,IOPT,NA,NB,NC,AMS,NATOMS)
         NEWDAT = .TRUE.
C?         GOTO 1000
         RETURN
      ELSEIF ( INDEX( LINE, 'ALL CONVERGERS ARE NOW FORCED ON')
     .          .GT. 0 ) THEN
         READ( IR,'(A)',END=999,ERR=999)LINE
         READ( IR,'(A)',END=999,ERR=999)LINE
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'FINAL  POINT  AND  DERIV') .GT. 0) THEN
         READ( IR,'(A)',END=999,ERR=999)LINE
         READ( IR,'(A)',END=999,ERR=999)LINE
 3       READ( IR,'(A)',END=999,ERR=999)LINE
         CALL LCLEAN( LINE, LINE, .TRUE. )
         IF ( LINE(1:1) .NE. ' ') GOTO 3
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'NO POINT LOWER IN ENERGY THAN ')
     .           .GT. 0 ) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'SINCE COS WAS JUST RESET,')
     .           .GT. 0 ) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'NUMBER OF ITERATIONS =')
     .           .GT. 0 ) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'ABOUT TO ENTER FLEPO FROM PATH')
     .           .GT. 0 ) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'SCF FIELD WAS ACHIEVED')
     .           .GT. 0 ) THEN
         GOTO 1000
      ELSEIF ( INDEX( LINE, 'THE LINE MINIMISATION FAILED TWICE')
     .           .GT. 0 ) THEN
         CALL DEBUGR( LINE( 1: 78 ) )
         GOTO 1000
      ENDIF
*
* NOW TO SEE IF IT IS BLANK
*      
      DO 19 I=1,80
  19      IF(LINE( I: I ).NE.' ') GOTO 20
      GOTO 1000
  20  CONTINUE
*
* CHECK FOR SINGLE WORDS
*
      DO 100 I=1,NWORDS
  100     IF(INDEX(LINE, WORDS(I)).NE.0) GOTO 110
*
* CHECK FOR SINGLE DATA
*
  105 CONTINUE
      DO 200 I=1,NDATUM
          ILOC=INDEX(LINE, DATUM(I))
  200     IF(ILOC.NE.0) GOTO 210
*
* CHECK FOR SMALL BLOCKS OF DATA
*
  205 CONTINUE
      DO 300 I=1,NSMALL
  300     IF(INDEX(LINE, SMALL(I)).NE.0) GOTO 310
*
* CHECK FOR LARGE BLOCKS OF DATA
*
      DO 400 I=1,NLARGE
  400     IF(INDEX(LINE, LARGE(I)).NE.0) GOTO 410
*
* LINE WAS NOT FOUND, ECHO IT BACK AS ADVICE
*
C?      IF ( DEBUGI ) THEN
         IIII = LLENG( LINE )
         IF ( IIII .GT. 1 ) CALL DEBUGR( LINE(1: IIII) )
C?      ENDIF
      GOTO 1000
*
*   HANDLE WORDS.
*
  110 CONTINUE
      IF(.NOT. GOTW(I)) THEN
          KEYWRD(NKEY:NKEY+6)=WORDS(I)
          NKEY=NKEY+8
          GOTW(I)=.TRUE.
          GOTO 1000      
      ELSE
          GOTO 105
      ENDIF
*
*   HANDLE A SINGLE DATUM
*
  210 CONTINUE
      LINE2 = LINE( ILOC:)
      LINE = LINE2( INDEX( LINE2, ' ')+1: )
      CALL LCLEAN( LINE, LINE, .FALSE.)
      VALD(I) = READA( LINE, 1, ERROR)
      GOTD(I)=.TRUE.
      IF(I.EQ.1)NALPHA=VALD(1)
      IF(I.EQ.2)NBETA =VALD(2)
      IF(I.EQ.3)GRAD =VALD(3)
      IF(I.EQ.4)DELTAH  =VALD(4)
      IF(DELTAH.EQ.0 .AND. I.EQ.6)DELTAH = VALD(6)
      IF(I.EQ.7)EE    =VALD(7)
      IF(I.EQ.8)ENUCLR=VALD(8)
      IF(I.EQ.9)VIP =VALD(9)
      IF(I.EQ.10)TIME  =VALD(10)
      IF(I.EQ.11)NSCF  =VALD(11)
      IF(I.EQ.12)SZ    =VALD(12)
      IF(I.EQ.13)S2    =VALD(13)
      IF(DELTAH.EQ.0 .AND. I.EQ.15)DELTAH = VALD(15)
      NCLOSE= MAX(VALD(17),VALD(16))
      IF(I.EQ.14)NOPEN =VALD(14)
      NELECS=NCLOSE*2+NOPEN+NALPHA+NBETA
      IF(I.EQ.18)WEIGHT = VALD( 18)
      IF(I.EQ.19)ZPE = VALD( 19)
      NEWDAT = .TRUE.
      GOTO 1000
  310 CONTINUE
*
*  HANDLE SMALL BLOCKS OF DATA
*
      NEWDAT = .TRUE.
      GOTO (320,330,340,350,360,370,380,390),I
*
  320 CONTINUE
      GOTS(1)=.TRUE.
*
*  READ IN INTERNAL COORDINATES
*
      IF (DEBUGI) CALL DEBUGR( 'READER: READING INTERNAL COORDINATES.')
      NEWDAT = .TRUE.
      FINGEO = .FALSE.
      READ ( IR,'(A)',END=999,ERR=999)DUMC,DUMC,DUMC
      NVAR=0      
      IF ( .NOT. GOTS(2)) THEN
         NUMAT=0
         NORBS=0
      ENDIF

      DO 321 I= 1, NUMATM
         READ ( IR, '( A )',END=999,ERR=1000) LINE
         CALL LCLEAN( LINE, LINE, .TRUE.)
         CALL POPARG( LINE, LINE)
         ELEM = LINE(1:2)
         ITEMP = NUMELE( ELEM)
         IF( ITEMP .LT. 1) GOTO 322
         CALL POPARG( LINE, LINE)
      IF ( I .LT. 2) GOTO 326
         GEO( 1, I) = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR.
     .       LINE(1:1) .EQ. '+' ) THEN
            SOPT( 1) = ' '//LINE(1:1)//' '
            CALL POPARG( LINE, LINE)
         ELSE
            SOPT( 1) = ' '
         ENDIF
         NA(I) = 1
         NB(I) = 0
         NC(I) = 0
      IF ( I .LT. 3) GOTO 326
         GEO( 2, I) = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR.
     .       LINE(1:1) .EQ. '+' ) THEN
            SOPT( 2) = ' '//LINE(1:1)//' '
            CALL POPARG( LINE, LINE)
         ELSE
            SOPT( 2) = ' '
         ENDIF
         IF ( I .EQ. 3) THEN
            NA( I) = READA( LINE, 1, ERROR)
            CALL POPARG( LINE, LINE)
            NB( I) = READA( LINE, 1, ERROR)
         ENDIF
      IF ( I .LT. 4 ) GOTO 326
         GEO( 3, I) = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         IF ( LINE( 1:1) .EQ. '''' .OR. LINE(1:1) .EQ. '*' .OR.
     .       LINE(1:1) .EQ. '+' ) THEN
            SOPT( 3) = ' '//LINE(1:1)//' '
            CALL POPARG( LINE, LINE)
         ELSE
            SOPT( 3) = ' '
         ENDIF
         NA( I) = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         NB( I) = READA( LINE, 1, ERROR)
         CALL POPARG( LINE, LINE)
         NC( I) = READA( LINE, 1, ERROR)

 326  IF(ELEM.EQ.'  ')GOTO 322
      IF ( ELEM(1:1) .EQ. ' ') ELEM = ELEM(2:2)
      DO 325 J=1,3
          IF ( SOPT(J).EQ.' * ')THEN
              IOPT(J,I) = 1
              NVAR=NVAR+1
              LOC(1,NVAR)=J
              LOC(2,NVAR)=I
          ELSEIF ( SOPT(J) .EQ. '   ') THEN
              IOPT( J, I) = 0
          ELSEIF ( SOPT(J) .EQ. ' '' ') THEN
              IOPT( J, I) = -1
          ELSEIF ( SOPT(J) .EQ. ' + ') THEN
              IOPT( J, I) = -1
          ELSE
              IOPT( J, I) = READA( SOPT(J), 1, ERROR)
          ENDIF      
  325 CONTINUE
      IF ( .NOT. GOTS(2)) THEN
C?         DO 323 J=1,99
C?  323       IF ( ATSYMB(J)(1:2) .EQ.ELEM) GOTO 324
C?  324    CONTINUE
C?         NAT( I)=J
         NAT( I)= ITEMP
         IF( ITEMP.LT.99 .OR. ITEMP.EQ.ISP1 .OR. ITEMP.EQ.ISP2 .OR.
     .       ITEMP.EQ.ISP3 .OR. ITEMP.EQ.ISP4) THEN
             NUMAT=NUMAT+1
             NFIRST(NUMAT)=NORBS+1
             NORBS=NORBS+1
             IF( ITEMP.EQ.1 ) THEN
               CONTINUE
             ELSEIF(ITEMP.EQ.ISP1 .OR. ITEMP.EQ.ISP2 .OR.
     .                 ITEMP.EQ.ISP3 .OR. ITEMP.EQ.ISP4 ) THEN
                NORBS=NORBS-1
             ELSE
                NORBS=NORBS+3
             ENDIF
             NLAST(NUMAT)=NORBS
         ENDIF
      ENDIF
  321 CONTINUE
  322 CONTINUE
*                 ALL ATOMS ARE IN.
      NATOMS=I-1
      IF( DEBUGI) WRITE (*,*) 'READER: NATOMS=',NATOMS
      IF( DEBUGI) WRITE (*,*) 'READER:  NORBS=',NORBS
      GOTO 1000
*
  330 CONTINUE
*
*   READ IN CARTESIAN COORDINATES
*
      IF (DEBUGI) CALL DEBUGR('READER: READING CARTESIAN COORDINATES.')
      READ( IR,'(A)',END=999,ERR=1000)DUMC,DUMC,DUMC
      DO 331 I =1, NUMATM
          READ ( IR, '( A )',END=999,ERR=1000) LINE
          CALL LCLEAN( LINE, LINE, .FALSE.)
          IF ( LINE( :1) .EQ. ' ') GOTO 332
  331 CONTINUE
  332 CONTINUE
*                ALL ATOMS ARE IN.
      GOTO 1000
*
  340 CONTINUE
*
*  READ IN ORDINARY DATA FILE
*
      IF (DEBUGI) CALL DEBUGR( 'READER: READING ORDINARY DATA FILE.')
      READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC, DUMC
      CALL GETGEO( IR, NAT, GEO,IOPT,NA,NB,NC,AMS,NATOMS)
      GOTO 1000
  350 CONTINUE
      GOTO 1000
  360 CONTINUE
*
*  ELECTRON POPULATIONS READ IN
*
      IF (DEBUGI) CALL DEBUGR('READER: READING ELECTRON POPULATIONS.')
      DO 365 ITEMP = 1, NORBS/8
         READ(IR,'(A)',END=999,ERR=999) LINE
 365  CONTINUE
      IF( MOD( NORBS, 8) .NE. 0) READ(IR,'(A)',END=999,ERR=999) LINE
C?      GOTO 1000
C??      RETURN
      GOTO 1000
  370 CONTINUE
*
*  READ IN EIGENVALUES
*
      IF (DEBUGI) CALL DEBUGR('READER: READING EIGENVALUES.')
      OFFSET = 0
      DO 375 ITEMP = 1, NORBS/8
         READ( IR,*,END=999,ERR=1000)(EIGS(OFFSET+I),I=1,8)
         OFFSET = OFFSET + 8
 375  CONTINUE
      IF( MOD( NORBS, 8) .NE. 0) THEN
         READ( IR,*,END=999,ERR=1000)(EIGS(OFFSET+I),I=1,MOD(NORBS,8))
      ENDIF
      GOTO 1000
  380 CONTINUE
*
*  READ IN ATOMIC CHARGES
*
      IF (DEBUGI) CALL DEBUGR('READER: ATOMIC CHARGES.')
c?      READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC
 381  CONTINUE
      READ( IR, '(A)', END=999, ERR=999) LINE
      CALL LCLEAN( LINE, LINE, .TRUE.)
      IF ( LINE(1:1) .NE. '1') GOTO 381
      CALL POPARG( LINE, LINE)
      CALL POPARG( LINE, LINE)
      Q(1) = READA( LINE, 1, ERROR)
C?      DO 385 I = 2, NUMAT
      DO 385 I = 2, NATOMS
         READ( IR, '(A)', END=999, ERR=999) LINE
         CALL LCLEAN( LINE, LINE, .TRUE.)
         CALL POPARG( LINE, LINE)
         CALL POPARG( LINE, LINE)
         Q(I) = READA( LINE, 1, ERROR)
 385  CONTINUE
C?      READ( IR,'(A30,F14.4)',END=999,ERR=999)(DUMC,Q(I),I=1,NUMAT)
* NOW READ AND SKIP THE DIPOLE JUNK
C?      READ( IR,'(A)',END=999,ERR=999) LINE
C?      CALL LCLEAN( LINE, LINE, .TRUE.)
C?      IF ( LINE( 1:1) .EQ. ' ') GOTO 1000
C??  387 READ( IR,'(A)',END=999,ERR=999) LINE
C??      IF ( INDEX( LINE, 'SUM ') .EQ. 0 ) GOTO 387
      GOTO 1000
*
 390  CONTINUE
      IF ( DEBUGI) CALL DEBUGR('READER: SYMMETRY JUNK')
 391  READ( IR,'(A)',END=999,ERR=999) LINE
      IF ( INDEX( LINE, 'FUNCTION') .EQ. 0) GOTO 391
      NSYMS = 0
 392  READ( IR,'(A)',END=999,ERR=999) LINE
      CALL LCLEAN( LINE, LINE, .TRUE.)
      IF ( INDEX( LINE, 'DESCRIPTION') .NE. 0) GOTO 395
      ITEMP = READA( LINE, 1, ERROR)
      LINE = LINE( INDEX( LINE, ' ')+1:)
      CALL LCLEAN( LINE, LINE, .TRUE.)
      IF ( ( NSYMS .EQ. 0 ) .OR. ITEMP .NE. ISYM( 1, NSYMS) ) THEN
         NSYMS = NSYMS + 1
         JSYMS = 3
         ISYM( 1, NSYMS) = ITEMP
         ISYM( 2, NSYMS) = READA( LINE, 1, ERROR)
      ELSE
         ITEMP = READA( LINE, 1, ERROR)
         IF ( ITEMP .EQ. ISYM( 2, NSYMS) ) THEN
            JSYMS = JSYMS + 1
         ELSE
            NSYMS = NSYMS + 1
            JSYMS = 3
            ISYM( 1, NSYMS) = ISYM( 1, NSYMS-1)
            ISYM( 2, NSYMS) = ITEMP
         ENDIF
      ENDIF
      LINE = LINE( INDEX( LINE, ' ')+1:)
      CALL LCLEAN( LINE, LINE, .TRUE.)
      ISYM( JSYMS, NSYMS) = READA( LINE, 1, ERROR)
      GOTO 392

 395  READ( IR,'(A)',END=999,ERR=999) LINE
      CALL LCLEAN( LINE, LINE, .TRUE.)
      IF ( LINE(1:1) .GE. '0' .AND. LINE(1:1) .LE. '9') THEN
         ITEMP = READA( LINE, 1, ERROR)
         DO 396 ITEMP = 1, NSYMS
            IF ( ITEMP .EQ. ISYM( 2, ITEMP) ) GOTO 395
 396     CONTINUE
      ENDIF

      READ( IR,'(A)',END=999,ERR=999) KEYWRD
      READ( IR,'(A)',END=999,ERR=999) KOMENT
      READ( IR,'(A)',END=999,ERR=999) TITLE

      GOTO 1000
*
*
  410 CONTINUE
      GOTO (420,430,440,450,460,470,480,490,495,500,510,520,530,
     .     540, 550, 560, 570, 580, 590 ),I
*
  420 CONTINUE
*
*   READ IN INTERATOMIC DISTANCES
* 
      IF (DEBUGI) CALL DEBUGR('READER: READING INTERATOMIC DISTANCES.')
      LR=.TRUE.
      CALL VECRED(RIJ,NUMAT, IR)
*** NATOMS DOES NOT SEEM TO WORK FOR FORCE CALCULATIONS
C?      CALL VECRED( RIJ, NATOMS, IR)
      GOTO 1000
*
  430 CONTINUE
*
*  READ IN ALPHA EIGENVECTORS
*
      IF (DEBUGI) CALL DEBUGR( 'READER: READING ALPHA EIGENVECTORS.')
      LC=.TRUE.
      CALL MATIN(CVECT,EIGS,NORBS,NORBS,NORBS,NUMAT,NFIRST,NLAST, IR)
      GOTO 1000
*
  440 CONTINUE
*
*  READ IN BETA EIGENVECTORS
*
      IF (DEBUGI) CALL DEBUGR('READER: READING BETA EIGENVECTORS.')
      LCB=.TRUE.
      CALL MATIN(CBETA,EIGB,NORBS,NORBS,NORBS,NUMAT,NFIRST,NLAST, IR)
      GOTO 1000
*
  450 CONTINUE
*
*  READ IN FORCE CALCULATION NORMAL COORDINATE ANALYSIS
*
      IF (DEBUGI) CALL DEBUGR( 'READER: NORMAL COORDINATE ANALYSIS.')
      N3=NUMAT*3
      NVIBS=N3 - MODVIB
      LF=.TRUE.
      CALL MATIN(FVECT, FEIGS, NVIBS, N3,N3, NUMATM, NFIRST,NLAST, IR)
      GOTO 1000
*
  460 CONTINUE
*
*  READ IN FORCE CALCULATION MAS-WEIGHTED COORDINATE ANALYSIS
*
      IF (DEBUGI) CALL DEBUGR( 'READER: MASS-WEIGHTED COORDINATE.')
      N3=NUMAT*3
      NVIBS=N3 - MODVIB
      LV=.TRUE.
      CALL MATIN(VIBVEC, EVIBS, NVIBS, N3,3*NUMATM,
     .                 NUMATM,NFIRST,NLAST, IR)
      GOTO 1000
*
  470 CONTINUE
*
*  READ IN BOND ORDERS AND VALENCIES
*
      IF (DEBUGI) CALL DEBUGR( 'READER: BOND ORDERS AND VALENCE.')
      LB=.TRUE.
      READ( IR,'(A)',END=999,ERR=999)DUMC, DUMC
      CALL VECRED( BONDS, NUMAT, IR)
      READ( IR, '(A)',END=999,ERR=999) LINE
      CALL LCLEAN( LINE, LINE, .TRUE.)
      IF( LINE(1:6) .EQ. 'CYCLE:') RETURN
      IF( LINE(1:5) .EQ. '*****') RETURN
      GOTO 1000
*
  480 CONTINUE
*
*  READ AND DISCARD DESCRIPTION OF VIBRATIONS
*
          IF (DEBUGI) WRITE (*,*) 'READER: DISCARDING DESCRIPT OF VIBS.'
          READ( IR,'(A)',END=999,ERR=999)LINE
          READ( IR,'(A)',END=999,ERR=999)LINE
          READ( IR,'(A)',END=999,ERR=999)LINE
  482      READ( IR,'(A)',END=999,ERR=999)LINE
          CALL LCLEAN (LINE, LINE, .FALSE.)
          CALL LCLEAN (LINE, LINE, .FALSE.)
          IF ( LINE( 1:1) .NE. ' ') GOTO 482
          READ( IR,'(A)',END=999,ERR=999)LINE
          CALL LCLEAN (LINE, LINE, .FALSE.)
          CALL LCLEAN (LINE, LINE, .FALSE.)
          IF ( LINE( 1:1) .NE. ' ') GOTO 482
          GOTO 1000
*
  490     CONTINUE
*
*  READ AND DISCARD  FREQUENCIES, REDUCED MASSES AND VIBRATION DIPOLES
*
          IF (DEBUGI) WRITE (*,*) 'READER: DISCARDING FREQ, RED MASSES.'
          ITEMP = 0
  492     READ( IR,'(A)',END=999,ERR=999)LINE
          IF ( INDEX( LINE, 'DIPT(I)') .NE. 0) THEN
             ITEMP = ITEMP + 6
             IF ( ITEMP .GE. NUMAT*3) GOTO 1000
          ENDIF
          GOTO 492
*
  495  CONTINUE
*  READ AND DISCARD FULL FORCE MATRIX, INVOKED BY "DFORCE"
*
          IF (DEBUGI) 
     .       CALL DEBUGR( 'READER: DISCARDING FULL FORCE MATRIX.')
          JTEMP = NUMAT
          IF ( INDEX( LINE, 'FULL') .NE. 0) JTEMP = NUMAT*3
          READ( IR,'(A)',END=999,ERR=999)LINE
          ITEMP = 0
  496     READ( IR,'(A)',END=999,ERR=999)LINE
          IF ( INDEX( LINE, '------') .NE. 0) THEN
             ITEMP = ITEMP + 6
          ENDIF
          CALL LCLEAN( LINE, LINE, .FALSE.)
          IF ( LINE( 1:1).EQ.' ' .AND. ITEMP.GE.JTEMP) GOTO 1000
          GOTO 496
*
  500 CONTINUE
*  READ AND DISCARD INTERNAL COORDINATE DERIVATIVES
*
          IF (DEBUGI) 
     .       CALL DEBUGR( 'READER: DISCARDING IC DERIVATIVES.')
          READ( IR,'(A)',END=999,ERR=999)LINE
          READ( IR,'(A)',END=999,ERR=999)LINE
  502     READ( IR,'(A)',END=999,ERR=999)LINE
          CALL LCLEAN( LINE, LINE, .FALSE.)
          ITEMP = READA( LINE, 1, ERROR)
          IF ( ITEMP .LT. NUMAT ) GOTO 502
          GOTO 1000
*
  510 CONTINUE
*  READ ORIENTATION OF MOLECULE IN FORCE CALCULATION
*
          IF (DEBUGI) CALL DEBUGR('READER: READING FORCE ORIENTATION.')
          READ( IR,'(A)',END=999,ERR=999)LINE
          READ( IR,'(A)',END=999,ERR=999)LINE
          KTEMP = 1
  512     READ( IR,'(A)',END=999,ERR=999)LINE
          CALL LCLEAN( LINE, LINE, .FALSE.)
          JTEMP = READA( LINE, 1, ERROR)
          IF ( JTEMP .NE. KTEMP) GOTO 512
          CALL POPARG( LINE, LINE)
          IEFOR( KTEMP) = READA( LINE, 1, ERROR)
C?          IF( IEFOR( KTEMP) .LT. 1 .AND. KTEMP.EQ.1) GOTO 512
          CALL POPARG( LINE, LINE)
          FORORE( 1, KTEMP) = READA( LINE, 1, ERROR)
          CALL POPARG( LINE, LINE)
          FORORE( 2, KTEMP) = READA( LINE, 1, ERROR)
          CALL POPARG( LINE, LINE)
          FORORE( 3, KTEMP) = READA( LINE, 1, ERROR)
          IF ( KTEMP .LT. NUMAT ) THEN
            KTEMP = KTEMP + 1
            GOTO 512
          ENDIF
          GOTO 1000
*
  520 CONTINUE
*  READ AND DISCARD FORCE CONSTANTS IN MILLIDYNES/ANGSTROM
*
          IF (DEBUGI) CALL DEBUGR('READER: DISCARDING FORCE CONSTANTS.')
          READ( IR,'(A)',END=999,ERR=999)LINE
  522     READ( IR,'(A)',END=999,ERR=999)LINE
          CALL LCLEAN( LINE, LINE, .FALSE.)
          IF ( LINE(:1) .NE. ' ') GOTO 522
          GOTO 1000
*
  530 CONTINUE
*  READ AND DISCARD CALCULATED THERMODYNAMIC PROPERTIES
*
          IF (DEBUGI) CALL DEBUGR('READER: DISCARDING THERMODYNAMICS.')
          READ( IR,'(A)',END=999,ERR=999)LINE
  532     READ( IR,'(A)',END=999,ERR=999)LINE
          IF ( INDEX( LINE, 'TOT.') .EQ. 0) GOTO 532
          READ( IR,'(A)',END=999,ERR=999)LINE
          READ( IR,'(A)',END=999,ERR=999)LINE
          IF ( INDEX( LINE, 'VIB.') .NE. 0) GOTO 532
          GOTO 1000
*
  540 CONTINUE
*
* READ AND DISCARD PRINCIPAL MOMENTS OF INERTIA ...
          IF(DEBUGI) CALL DEBUGR( 'DISCARDING MOMENTS OF INERTIA.')
          READ( IR, '(A)', END=999, ERR=999)LINE
          READ( IR, '(A)', END=999, ERR=999)LINE
          GOTO 1000
*
  550 CONTINUE
*
* READ AND DISCARD ESTIMATED TIME TO COMPLETE CALCULATION
          GOTO 1000
*
  560 CONTINUE
*
* READ AND DISCARD TRIVIAL VIBRATIONS, SHOULD BE ZERO
  562     READ( IR, '(A)', END=999, ERR=999)LINE
          IF ( INDEX( LINE, '=TX') .EQ. 0 ) GOTO 562
          GOTO 1000
*
  570 CONTINUE
*
* READ AND DISCARD THE LAST # VIBRATIONS ARE THE TRANSLATION AND ...
          READ( IR, '(A)', END=999, ERR=999)LINE
          READ( IR, '(A)', END=999, ERR=999)LINE
          GOTO 1000
*
  580 CONTINUE
* READ AND DISCARD LOCALISED ORBITALS
          IF ( DEBUGI ) 
     .           CALL DEBUGR('READER: DISCARDING LOCALISED ORBITALS')

  581     READ( IR, '(A)', END=999, ERR=999) LINE
          IF ( INDEX( LINE, 'LOCALISED ORBITALS') .EQ. 0 ) GOTO 581
  582     READ( IR, '(A)', END=999, ERR=999) LINE

          DO 588 K= 1, NCLOSE, 6
  584        READ( IR, '(A)', END=999, ERR=999) LINE
             IF ( INDEX( LINE, 'ROOT NO') .EQ. 0 ) GOTO 584
     
  585        READ( IR, '(A)', END=999, ERR=999) LINE
             CALL LCLEAN( LINE, LINE, .TRUE.)
             IF ( LINE(1:1) .NE. 'S') GOTO 585

             DO 587 I = 1, NORBS-1
  586           READ( IR, '(A)', END=999, ERR=999) LINE
                CALL LCLEAN( LINE, LINE, .TRUE.)
                IF ( LINE( :1) .EQ. ' ') GOTO 586
  587        CONTINUE

  588     CONTINUE
          GOTO 1000
          
*
  590 CONTINUE
* READ AND DISCARD EIGENVECTORS
          IF ( DEBUGI ) 
     .           CALL DEBUGR( 'READER: DISCARDING EIGENVECTORS')
          DO 598 K= 1, NORBS/7+1
  591     READ( IR, '(A)', END=999, ERR=999) LINE
          IF ( INDEX( LINE, 'ROOT NO') .EQ. 0 ) GOTO 591
     
  592     READ( IR, '(A)', END=999, ERR=999) LINE
          CALL LCLEAN( LINE, LINE, .TRUE.)
          IF ( LINE(1:1) .NE. 'S') GOTO 592

          DO 594 I = 1, NORBS-1
  593        READ( IR, '(A)', END=999, ERR=999) LINE
             CALL LCLEAN( LINE, LINE, .TRUE.)
             IF ( LINE( :1) .EQ. ' ') GOTO 593
  594     CONTINUE

  598     CONTINUE
          GOTO 1000
*
  999 CONTINUE
      IF (DEBUGI) WRITE (*,*) 'IN READER: INPUT ERROR, FIRST=',FIRST
      IF ( NEWDAT ) RETURN
      IF (.NOT. FIRST) THEN
         IOERR = 1
      ENDIF
      RETURN
      END

      SUBROUTINE GETGEO(IREAD,LABELS,GEO,LOPT,NA,NB,NC,AMS,NATOMS)
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      DIMENSION GEO(3,*),NA(*),NB(*),NC(*),AMS(*), LOPT(3,*)
     +,LABELS(*)
*****************************************************************************
*
*   GETGEO READS IN THE GEOMETRY. THE ELEMENT IS SPECIFIED BY IT'S CHEMICAL
*          SYMBOL, OR, OPTIONALLY, BY IT'S ATOMIC NUMBER.
*
*  ON INPUT   IREAD  = CHANNEL NUMBER FOR READ, NORMALLY 5
*             AMS    = DEFAULT ATOMIC MASSES.
*
*  ON OUTPUT  LABELS = ATOMIC NUMBERS OF ALL ATOMS, INCLUDING DUMMIES.
*             GEO    = INTERNAL COORDINATES, IN ANGSTROMS, AND DEGREES.
*             LOPT   = INTEGER ARRAY, A '1' MEANS OPTIMISE THIS PARAMETER,
*                      '0' MEANS DO NOT OPTIMISE, AND A '-1' LABELS THE
*                      REACTION COORDINATE.
*             NA     = INTEGER ARRAY OF ATOMS (SEE DATA INPUT)
*             NB     = INTEGER ARRAY OF ATOMS (SEE DATA INPUT)
*             NC     = INTEGER ARRAY OF ATOMS (SEE DATA INPUT)
*             ATMASS = ATOMIC MASSES OF ATOMS.
*****************************************************************************
      COMMON /ATMASS/ ATMASS(NUMATM)
      DIMENSION ISTART(40)
      LOGICAL LEADSP, ERROR
      CHARACTER*127 UPLINE
      CHARACTER ATSYMB*6, LINE*80, SPACE*1, NINE*1,ZERO*1,
     +TAB*1, COMMA*1, STRING*80, ELE*2
      COMMON /ATSYMB/ ATSYMB( 200)
      DATA COMMA,SPACE,NINE,ZERO/',',' ','9','0'/
      TAB=CHAR(9)
      NATOMS=0
      NUMAT=0
  10  READ(IREAD,'(A)',END=31,ERR=32)LINE
      IF(LINE.EQ.' ') GO TO 31
      IF(NATOMS.GT.NUMATM)THEN
      WRITE(6,'(//10X,''****  MAX. NUMBER OF ATOMS ALLOWED:'',I4)')
     +NUMATM
      STOP
      ENDIF
      NATOMS=NATOMS+1
*   CLEAN THE INPUT DATA
      LINE = UPLINE( LINE) 
      DO 9 I=1,80
9       IF(LINE(I:I).EQ.TAB.OR.LINE(I:I).EQ.COMMA)LINE(I:I)=SPACE
*
*   INITIALIZE ISTART TO INTERPRET BLANKS AS ZERO'S
      DO 11 I=1,10
11       ISTART(I)=80  
* FIND INITIAL DIGIT OF ALL NUMBERS, CHECK FOR LEADING SPACES FOLLOWED
*     BY A CHARACTER AND STORE IN ISTART
      LEADSP=.TRUE.
      NVALUE=0
      DO 12 I=1,80
         IF (LEADSP.AND.LINE(I:I).NE.SPACE) THEN
           NVALUE=NVALUE+1
           ISTART(NVALUE)=I
         END IF
         LEADSP=(LINE(I:I).EQ.SPACE)
12    CONTINUE
*
* ESTABLISH THE ELEMENT'S NAME AND ISOTOPE, CHECK FOR ERRORS OR E.O.DATA
*
      WEIGHT=0.D0
      STRING=LINE(ISTART(1):ISTART(2)-1)
      IF( STRING(1:1) .GE. ZERO .AND. STRING(1:1) .LE. NINE) THEN
*  ATOMIC NUMBER USED: NO ISOTOPE ALLOWED
         LABEL=READA(STRING,1, ERROR)
         IF (LABEL.EQ.0) GO TO 30
         IF (LABEL.LT.0.OR.LABEL.GT.99) THEN
           CALL DEBUGR( 'ILLEGAL ATOMIC NUMBER')
           GO TO 33
         END IF
         GO TO 20
      END IF
*  ATOMIC SYMBOL USED
      REAL=READA(STRING,1, ERROR)
      IF (REAL.LT..005) THEN
*   NO ISOTOPE
        ELE=STRING(1:2)
      ELSE 
        WEIGHT=REAL
        IF( STRING(2:2) .GE. ZERO .AND. STRING(2:2) .LE. NINE) THEN
          ELE=STRING(1:1)
        ELSE
          ELE=STRING(1:2)
        END IF
      END IF
*   CHECK FOR ERROR IN ATOMIC SYMBOL
C?      DO 17 I=1,200
C?        IF ( ELE .EQ. ATSYMB(I)(1:2)) THEN
C?          LABEL=I
C?          GO TO 20
C?        END IF
C?17    CONTINUE
      LABEL = NUMELE( ELE )
      IF( LABEL.GT.0) GOTO 20
      WRITE(6,'(''  UNRECOGNIZED ELEMENT NAME:  <'',A,''>'')')ELE
      GOTO 33
*
* ALL O.K.
*
20    IF (LABEL.NE.99) NUMAT=NUMAT+1
      IF(WEIGHT.NE.0.D0)THEN
          WRITE(6,'('' FOR ATOM'',I4,''  ISOTOPIC MASS:''
     +    ,F12.5)')NATOMS, WEIGHT
          ATMASS(NUMAT)=WEIGHT
      ELSE
          IF(LABEL .NE. 99)  ATMASS(NUMAT)=AMS(LABEL)
      ENDIF      
      LABELS(NATOMS)   =LABEL
      GEO(1,NATOMS)    =READA(LINE,ISTART(2), ERROR)
      LOPT(1,NATOMS)   =READA(LINE,ISTART(3), ERROR)
      IF ( ERROR ) LOPT( 1, NATOMS ) = 0
      IF ( LOPT( 1, NATOMS) .GT. 1 ) LOPT( 1, NATOMS) = 0
      IF ( LOPT( 1, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0
      GEO(2,NATOMS)    =READA(LINE,ISTART(4), ERROR)
      LOPT(2,NATOMS)   =READA(LINE,ISTART(5), ERROR)
      IF ( ERROR ) LOPT( 2, NATOMS ) = 0
      IF ( LOPT( 2, NATOMS) .GT. 1 ) LOPT( 2, NATOMS) = 0
      IF ( LOPT( 2, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0
      GEO(3,NATOMS)    =READA(LINE,ISTART(6), ERROR)
      LOPT(3,NATOMS)   =READA(LINE,ISTART(7), ERROR)
      IF ( ERROR ) LOPT( 3, NATOMS ) = 0
      IF ( LOPT( 3, NATOMS) .GT. 1 ) LOPT( 3, NATOMS) = 0
      IF ( LOPT( 3, NATOMS) .LT. -1 ) LOPT( 1, NATOMS) = 0
      NA(NATOMS)       =READA(LINE,ISTART(8), ERROR)
      NB(NATOMS)       =READA(LINE,ISTART(9), ERROR)
      NC(NATOMS)       =READA(LINE,ISTART(10), ERROR)
      GOTO 10
*
* ALL DATA READ IN, CLEAN UP AND RETURN
*
30      NATOMS=NATOMS-1
31      NA(2)=1
        IF(LOPT(1,1)+LOPT(2,1)+LOPT(3,1)+LOPT(2,2)+LOPT(3,2)+
     +     LOPT(3,3) .GT. 0)THEN
        LOPT(1,1)=0
        LOPT(2,1)=0
        LOPT(3,1)=0
        LOPT(2,2)=0
        LOPT(3,2)=0
        LOPT(3,3)=0
        WRITE(6,'(//10X,'' AN UNOPTIMIZABLE GEOMETRIC PARAMETER HAS''
     +,/10X,'' BEEN MARKED FOR OPTIMIZATION. THIS IS A NON-FATAL ''
     +,''ERROR'')')
      ENDIF
        IF(NA(3).EQ.0) THEN
            NB(3)=1
            NA(3)=2
        ENDIF
        RETURN
* ERROR CONDITIONS
  32  IF(IREAD.EQ.5) THEN
        WRITE(6,'( '' ERROR DURING READ AT ATOM NUMBER '', I3 )')NATOMS
      ELSE
        NATOMS=0
        RETURN
      ENDIF
  33  J=NATOMS-1
      WRITE(6,'('' DATA CURRENTLY READ IN ARE '')')
      DO 36 K=1,J
  36   WRITE(6,42)LABELS(K),(GEO(J,K),LOPT(J,K),J=1,3),NA(K),NB(K),NC(K)
  42   FORMAT(I4,2X,3(F10.5,2X,I2,2X),3(I2,1X))
C?      CALL EXIT
      STOP ' '
      END
