      SUBROUTINE GPRDR( IR, FNAME, FTYPE, COOUT, IEOUT, NATOUT, 
     .                  NAOUT, NBOUT, NCOUT, UPDATE)
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      DIMENSION COOUT( 3, NUMATM), IEOUT( NUMATM)
      DIMENSION NAOUT( NUMATM ), NBOUT( NUMATM), NCOUT( NUMATM)
      CHARACTER*80 KEYWRD, KOMENT, TITLE, COMAND, LINE, FNAME
      CHARACTER*5 SYMBL(100)
      CHARACTER FTYPE*3
      LOGICAL OPNERR, ERROR, UPDATE
      LOGICAL FIRST
      REAL DENMAT, BONDS
      REAL VFREQ, VIBVEC
      REAL FVECT
      REAL CVECT, CBETA
      COMMON /FILEST/ FIRST
      COMMON /SYMTRY/ ISYM(10,NUMATM)
      COMMON /ATMASS / ATMASS ( NUMATM )
      COMMON /INTCOR/ XNDOGM(3, NUMATM), INTFRE(3, NUMATM)
      COMMON /KEYS/ KEYWRD,KOMENT,TITLE
      COMMON /ATOMS/ CO(3, NUMATM),IE( NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      DIMENSION IA(NUMATM), IB(NUMATM), IC(NUMATM)
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DENSTY/ DENMAT( MPACK ), BONDS( MPACK )
C
C  DEBUGGING NOTES
C       DEBUG  - GENERAL DEBUG LOGICAL
*       DEBUGL - DEBUG FOR LINE DRAWING
*       DEBUGN - DEBUG FOR NAGOYA
*       DEBUGO - DEBUG FOR ORTEP
C       DEBUGP - DEBUG FLAG FOR PLOTTING SUBROUTINES
*
      LOGICAL LR, LF, LV, LC, LCB, LB
      COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT
      DIMENSION RIJ(1000), FVECT(3*NUMATM, 3*NUMATM), C(1000)
*  RIJ    == INTERATOMIC DISTANCES
* FVECT   == FORCE VECTORS
* VIBVEC  == NORMAL MODE VIBRATIONS
      DIMENSION CBETA(1000)
      COMMON /DATUMS/ NVAR, NUMAT, NORBS, NELECS, NALPHA, NBETA,
     .                NCLOSE, NOPEN, NNATOM
      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)
      DIMENSION X(NUMATM), Y(NUMATM), Z(NUMATM), ZLINER(NUMATM*3)
      EQUIVALENCE  (COOLD(1,1),ZLINER(1))
      EQUIVALENCE (ZLINER(1), X(1))
      EQUIVALENCE (ZLINER(NUMATM), Y(1))
      EQUIVALENCE (ZLINER(NUMATM*2), Z(1))
*
      IF (DEBUGI) CALL DEBUGR( 'IN GPRDR: FTYPE='//FTYPE )
      IF ( IR.LT.0)THEN
        CLOSE( UNIT=ABS(IR) )
        FIRST = .TRUE.
        FTYPE = ' '
        RETURN
      ENDIF

      IF ( FTYPE(:1) .EQ. ' ') THEN
         IF (DEBUGI) CALL DEBUGR( 'IN GPRDR: OPENING '//
     .                FNAME(:INDEX(FNAME, ' ')) )
         IRROR = 0
         IOERR = 0
* changed from readonly
         OPEN( UNIT= IR, FILE= FNAME, STATUS= 'OLD', IOSTAT= IRROR)
         IF ( IRROR .NE. 0) GOTO 9000
         REWIND (UNIT=IR, ERR=9000)
         FIRST = .TRUE.
C?         DO 10 NZZ= 1, 20
         DO 10 NZZ= 1, 60
            READ( IR, '( A )', ERR=9100, END= 11 ) LINE
            IF( INDEX( LINE, 'GIP/DRAW') .GT. 0) THEN
                FTYPE = 'GIP'
                GOTO 12
            ELSEIF(INDEX(LINE,'ATOMS WITH A CHARGE OF').NE.0) THEN
                FTYPE='COR'
                GOTO 12
            ELSEIF ( INDEX( LINE, ' SUMMARY OF ').GT. 0) THEN
                FTYPE='ARC'
                GOTO 12
            ELSEIF (LINE(:6) .EQ. 'HEADER') THEN
                FTYPE='PDB'
                GOTO 12
            ELSEIF ( INDEX(LINE,'NUMBER OF CONTOURS') .GT. 0) THEN
                FTYPE='TEC'
                GOTO 12
            ELSEIF ( INDEX( LINE, ' CALCULATION RESULTS') .GT. 0) THEN
                FTYPE='OUT'
            ELSEIF ( INDEX( LINE, 'INTRINSIC REACTION C') .GT. 0) THEN
                FTYPE='IRC'
c?? keep looking for DRC      GOTO 12
            ELSEIF ( INDEX( LINE, 'DYNAMIC REACTION COO') .GT. 0) THEN
                FTYPE='DRC'
                GOTO 12
            ELSEIF( INDEX( LINE, 'HALF-LIFE FOR KINETIC EN').GT. 0) THEN
                FTYPE='DRC'
                GOTO 12
            ENDIF
 10      CONTINUE
* ASSUME DATA TYPE IF END OF FILE
   11    IF (FTYPE .EQ. '   ') FTYPE='GEO'
   12    CONTINUE
         REWIND (UNIT=IR, ERR=9000)
      ENDIF
      IF ( FTYPE(:1) .EQ. ' ') THEN
         FTYPE='GEO'
      ENDIF
 50   IF (DEBUGI) CALL DEBUGR( 'IN GPRDR: FTYPE='//FTYPE )
      IF ( FTYPE .EQ. 'COR') THEN
         CALL CORRD( IR, NATOUT, KHARGE, TITLE, SYMBL, X,Y,Z, 
     +                 IBONDS, IOERR )
         IF (IOERR.NE.0) GO TO 9100
         DO 20 I= 1, NATOUT
            COOUT(1,I) = X(I)
            COOUT(2,I) = Y(I)
            COOUT(3,I) = Z(I)
  20     CONTINUE
         RETURN
       ELSEIF ( FTYPE.EQ.'GEO') THEN
            CALL GEORD( IR, NATOUT,IEOUT,COOUT,NAOUT,NBOUT,NCOUT,
     +             IA, IB, IC, ISYM, IOERR )
            IF (IOERR.NE.0) GO TO 9100
        ELSEIF ( FTYPE.EQ.'ARC') THEN
            CALL ARCRD( IR, NATOUT,IEOUT,COOUT,NAOUT,NBOUT,NCOUT,
     +             IA, IB, IC, ISYM, IOERR )
            IF (IOERR.NE.0) GO TO 9100
        ELSEIF ( FTYPE.EQ.'GIP') THEN
            CALL GIPRD( IR, NATOUT,IEOUT,COORD,NAOUT,NBOUT,NCOUT,
     .             IOERR )
            IF (IOERR.NE.0) THEN
               IF ( NATOUT .LT. 1 ) GOTO 9100
               CALL UPROMP( 'I had an ERROR reading the file.' )
               WRITE (*, '('' I found '', I4,'' atoms.'')' ) NATOUT
               CALL UPROMP( 'Do you want me to use them [YES/no] ? ')
               READ (*, '(A)', END=9100) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE. )
               IF ( COMAND(1:1) .EQ. 'N' ) GOTO 9100
            ENDIF
            DO 48 I=2,NATOUT
               IA(I)=1
               IF (I.GT.2) IB(I)=1
               IF (I.GT.3) IC(I)=1
  48        CONTINUE
            DO 49 I=1,NATOUT
               CO( 1, I) = COORD( 1, I)
               CO( 2, I) = COORD( 2, I)
               CO( 3, I) = COORD( 3, I)
               INTFRE(1,I)=IA(I)
               INTFRE(2,I)=IB(I)
               INTFRE(3,I)=IC(I)
  49        CONTINUE
            GOTO 120
        ELSEIF ( FTYPE .EQ. 'PDB') THEN
            CALL BPDBRD( IR, NATOUT,IEOUT,COORD,NAOUT,NBOUT,NCOUT,
     .         KEYWRD, KOMENT, TITLE, IOERR )
            IF (IOERR.NE.0) GOTO 9100
            DO 80 I=1,NATOUT
               CO( 1, I) = COORD( 1, I)
               CO( 2, I) = COORD( 2, I)
               CO( 3, I) = COORD( 3, I)
               IF ( I .GT. 1) INTFRE(1,I)=1
               IF ( I .GT. 2) INTFRE(2,I)=1
               IF ( I .GT. 3) INTFRE(3,I)=1
  80        CONTINUE
            RETURN
        ELSEIF ( FTYPE .EQ. 'TEC' ) THEN
            CALL CONTUR( IR, IOERR )
            IF (IOERR.NE.0) GO TO 9100
            RETURN
        ELSEIF ( FTYPE.EQ.'DRC' .OR. FTYPE.EQ.'IRC') THEN
            CALL DRCRD( IR, NATOUT,IEOUT,COOUT,NAOUT,NBOUT,NCOUT,
     +             IA, IB, IC, ISYM, KEYWRD, KOMENT, TITLE, IOERR )
            IF (IOERR.NE.0) GO TO 9100
        ELSEIF ( FTYPE .EQ. 'OUT') THEN
            CALL READER(COOUT, IEOUT, NAOUT, NBOUT, NCOUT, INTFRE, 
     .                  LR, FVECT, LF, VIBVEC, LV, CVECT, LC,
     .                  CBETA, LCB, BONDS, LB, IR, IOERR)
            IF (IOERR.NE.0) GOTO 9100
            NATOUT = NNATOM
            DO 60 I= 1, NATOUT
              IA( I ) = INTFRE( 1, I)
              IB( I ) = INTFRE( 2, I)
              IC( I ) = INTFRE( 3, I)
              DO 60 J= 1, 3
                 VFREQ( (I-1)*3 + J) = EVIBS( (I-1)*3 + J)
   60         CONTINUE
        ENDIF
C
      WRITE ( COMAND, '(''GPRDR: NATOUT='',I4)' ) NATOUT
      IF (DEBUGI) CALL DEBUGR( COMAND )
*
      IF ( ISYM(1,1) .NE. 0 ) THEN
         CALL DEBUGR( 'GPRDR: SYMMETRY INFORMATION PRESENT.' )
      ENDIF

C?      CALL GMETRY(NUMAT,NATOUT,IEOUT,COOUT,NA,NB,NC,COORD,ERROR)
C
  120          DO 150 I=1,NATOUT
                  IF ( UPDATE ) THEN
C                     CO( 1, I) = COORD( 1, I)
C                     CO( 2, I) = COORD( 2, I)
C                     CO( 3, I) = COORD( 3, I)
                     INTFRE(1,I)=IA(I)
                     INTFRE(2,I)=IB(I)
                     INTFRE(3,I)=IC(I)
C                  ELSE
                   ENDIF
C?                     COOUT(1,I) = COORD(1,I)
C?                     COOUT(2,I) = COORD(2,I)
C?                     COOUT(3,I) = COORD(3,I)
C                  ENDIF
150            CONTINUE
C               IF ( UPDATE ) NATOMS = NATOUT
C
C     END GEO-COR CALCULATION
       RETURN
9000   IFILE=INDEX( FNAME,' ')
       WRITE(*,'('' ERROR IN OPENING '', A )')  FNAME(:IFILE)
       NATOUT = -1000
      FNAME=' '
      FTYPE = ' '
      RETURN
9100  IFILE = INDEX( FNAME, ' ')
      WRITE (*,'('' ERROR IN READING '', A)')  FNAME(:IFILE)
      FNAME=' '
      FTYPE = ' '
      NATOUT = -100
      RETURN
      END
