      SUBROUTINE BPDBRD(KHANEL,NATOMS,LABEL,GEO,NA,NB,NC,
     +      KEYWRD,KOMENT,TITLE,IOERR )
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      INTEGER*2 ATBOND
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
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
*       DEBUGI = DEBUGGING FOR INPUT
*
C   SUBROUTINE FOR READING BROOKHAVEN PROTEIN DATA BANK FILES
C
C  THE STRUCTURE OF A BPDB FILE IS:
C     CARD   FIELD   CONTENTS    DESCRIPTION
C       1    1-6     HEADER      IDENTIFIES FIRST CARD
C       "    7-72    TITLE       TITLE AND DATE OF FILE
C       "    72-80   SEQNR       SEQUENCE NUMBER OF FILE
C       2     1- 6    COMPND     COMPOUND CARD
C      ...
C       n     1- 6   ORIGX1      ORIGIN
C      n+1    1- 6   ORIGX2      ORIGIN
C      n+2    1- 6   ORIGX3      ORIGIN
C      n+3    1- 6   SCALE1      SCALE FACTOR
C      n+4    1- 6   SCALE2      SCALE FACTOR
C      n+5    1- 6   SCALE3      SCALE FACTOR
C      n+6    1- 6   ATOM        DESCRIPTOR FOR AN ATOM
C       "    10-13   ####        NUMBER OF ATOM
C       "    16-18   TYPE        TYPE OF ATOM (N,CA,C,O,CB,CG, ETC)
C       "    20-22   RESIDUE     TYPE OF RESIDUE
C       "    23-28   ######      RESIDUE NUMBER
C       "    30-40   ###.###     X-COORD
C       "    42-48   ###.###     Y-COORD
C       "    50-56   ###.###     Z-COORD
C       "    58-62   ##.##       ???????
C       "    63-68   ##.##       ???????
C       "    73-80   SEQNR       SEQUNECE NUMBER IN FILE
C       m     1- 6   TER         TERMINATOR CARD
C       "    10-13   ####        ATOM NUMBER (BREAK IN ATOM SEQUENCE)
C       p     1- 6   HETATM      NON-PEPTIDE ATOM
C       q     1- 6   CONECT      CONNECTION CODES
C       r     1- 6   MASTER      MASTER RECORD CARD
C       z     1- 6   END         END OF FILE
C
C ******************************
C
C   WE ASSUME THAT GPRDR HAS IDENTIFIED THE FILE AS A B PDB FILE
C   AND THAT THE FILE IS REWOUND TO THE BEGINING FOR US.
C
C ******************************
C
      DIMENSION LABEL(NUMATM),ATMASS(NUMATM),GEO(3,NUMATM)
      DIMENSION NA(NUMATM),NB(NUMATM),NC(NUMATM)
      CHARACTER*80 LINE,CLEAN, KEYWRD,KOMENT,TITLE,COMAND, DUMMY
      CHARACTER*5 RTEMP
      CHARACTER*3 RESIDU
      DIMENSION NRES1(100),NRES2(100)
      LOGICAL IRROR, ERROR, SORT, SOLVNT

      DATA XDUMMY / 0.0 /
      DATA YDUMMY / 0.0 /
      DATA ZDUMMY / 0.0 /

1000  FORMAT ( A80 )
*
      IRROR=.FALSE.
*
 10   READ(KHANEL,'(A)',ERR=97,END=101)KEYWRD
      IF (KEYWRD(1:6) .NE. 'HEADER') GOTO 10
 12   READ(KHANEL,'(A)',ERR=97,END=101)KOMENT
      IF (KOMENT(1:6) .NE. 'COMPND') GOTO 12
 14   READ(KHANEL,'(A)',ERR=97,END=101)TITLE
      IF (TITLE(1:6) .NE. 'SOURCE') GOTO 14
*
      CALL DEBUGR( 'A Bookhaven Protein Databank Tape file.' )
*
20    CONTINUE
      CALL DEBUGR( 'Enter the specific residue(s) desired')
      CALL DEBUGR( 'format:  ##[-[##]][,## ...]' )
      READ (*,1000) COMAND
* LCLEAN WILL REPLACE COMMAS WITH SINGLE SPACES
      CALL LCLEAN(COMAND,COMAND, .TRUE.)
      IF ( COMAND(1:1) .EQ. '?') THEN
         COMAND = 'DRAW INPUT BROOKHAVEN'
         CALL HELP ( COMAND)
         GOTO 20
      ENDIF
      LCOM = LLENG( COMAND ) + 1
      IF ( LCOM .LT. 2 ) THEN
         CALL DEBUGR( 'NULL ENTRY.')
         GOTO 30
      ENDIF
C
      NN=0
  24  NIND=INDEX(COMAND,' ')
      IF (NIND .EQ. 0) NIND=LCOM+1
      MIND=INDEX(COMAND,'-')
      IF ( MIND .GT. NIND) MIND = 0
      NN=NN+1
      NRES1(NN)=READA(COMAND,1,ERROR)
      IF (ERROR) THEN
         CALL DEBUGR( 'ERROR AT START OF:')
         CALL DEBUGR( COMAND(:LCOM))
      ENDIF
      IF ( MIND .EQ. 0 ) THEN
         NRES2(NN) = NRES1( NN)
      ELSE
         NRES2(NN)=READA(COMAND,MIND+1,ERROR)
         IF (ERROR) THEN
            CALL DEBUGR( 'ERROR AT MINUS OF:')
            CALL DEBUGR( COMAND(:LCOM))
         ENDIF
      ENDIF
      DO 28 I=NIND,LCOM
         IF (COMAND(I:I) .NE. ' ') GOTO 29
  28  CONTINUE
      I=LCOM
  29  COMAND = COMAND(I:)
      LCOM=LCOM - I
      IF (LCOM .GT. 0) GOTO 24
C
C  SORT THE ARRAYS  NRES1 AND NRES2 IN INCREASING ORDER OF NRES1
C
 30   IF ( NN .LT. 1 ) RETURN
      IF ( DEBUGI ) THEN
         WRITE (DUMMY, '('' YOU ENTERED '',I4,'' RESIDUES.'')') NN
         CALL DEBUGR( DUMMY(1: 30) )
         DO 33 I=1,NN
            WRITE ( DUMMY, '('' RESIDUES FROM '',I4,'' TO '',I4)')
     .          NRES1(I), NRES2(I)
            CALL DEBUGR( DUMMY( 1:30) )
  33     CONTINUE
         CALL DEBUGR( 
     .       'Here are the residues sorted in order for search.' )
      ENDIF
 31   SORT=.FALSE.
      DO 32 I=1,NN-1
         IF (NRES1(I) .LT. NRES1(I+1)) GOTO 32
         SORT=.TRUE.
         NTEMP=NRES1(I)
         NRES1(I)=NRES1(I+1)
         NRES1(I+1)=NTEMP
         NTEMP=NRES2(I)
         NRES2(I)=NRES2(I+1)
         NRES2(I+1)=NTEMP
  32  CONTINUE
      IF (SORT) GOTO 31
C
      IF ( DEBUGI ) THEN
         DO 40 I=1,NN
            WRITE ( DUMMY, '('' RESIDUES FROM '',I4,'' TO '',I4)')
     .          NRES1(I), NRES2(I)
            CALL DEBUGR( DUMMY( 1:30) )
  40     CONTINUE
      ENDIF
C
 45   CALL UPROMP( 'Do you want ATOMS or RESIDUES? ')
      READ ( *, '(A)') LINE
      CALL LCLEAN( LINE, LINE, .TRUE. )
      IF ( LINE(1:1) .EQ. 'R' ) THEN
         CALL UPROMP( 'Do you also want any solvent molecules? [YES]')
         READ ( *, '(A)') LINE
         CALL LCLEAN( LINE, LINE, .TRUE.)
         IF ( LINE( 1: 1) .EQ. 'N' ) THEN
            SOLVNT = .FALSE.
         ELSE
            SOLVNT = .TRUE.
         ENDIF
********  GETTING RESIDUES *********************
         SEQRES = 0
         LRES=0
         MM=1
         NATOMS=0
 50      READ(KHANEL,'(A)',ERR=97,END=102) LINE
         IF ( DEBUGI) CALL DEBUGR( LINE(1:78) )
         IF ( LINE( 1: 6) .EQ. 'HETATM' .AND. SOLVNT) GOTO 200
         IF (LINE(:6) .NE. 'ATOM  ') GOTO 50
         IF (LINE(:6) .EQ. 'END   ') GOTO 102
         IF ( LINE( 14: 15) .NE. 'CA' ) GOTO 50
C  GET RESIDUE AND NUMBER OF THIS LINE
         RTEMP=LINE(18:22)
         NTEMP=READA(LINE,23,ERROR)
         IF (ERROR) THEN
            CALL DEBUGR( 'ERROR IN RESIDUE NUMBER')
            CALL DEBUGR( LINE)
            GOTO 95
         ENDIF
         IF (DEBUGI) THEN
            WRITE (DUMMY,'('' COMPARING RES '',I6,'' TO '',I6)' ) 
     .               NTEMP, NRES1(MM)
            CALL DEBUGR( DUMMY( 1: 35) )
         ENDIF
         IF ( LRES+1 .EQ. NTEMP) LRES=NTEMP
C  CHECK IF THIS RESIDUE IS WANTED
  55     IF (NTEMP .LT. NRES1(MM)) GOTO 50
         IF (NTEMP .GT. NRES2(MM)) THEN
            MM = MM + 1
            IF (MM .LE. NN) THEN
               GOTO 55
            ELSE
               GOTO 95
            ENDIF
         ENDIF
 56      IF ( NTEMP.GT.SEQRES+1 .AND.
     .      (SEQRES+1.GE.NRES1(MM) .AND. SEQRES+1.LE.NRES2(MM)) ) THEN
            NATOMS=NATOMS + 1
            GEO(1,NATOMS) = XDUMMY
            GEO(2,NATOMS) = YDUMMY
            GEO(3,NATOMS) = ZDUMMY
            IF ( NATOMS .GT. 1) NA( NATOMS) = NATOMS - 1
            IF ( NATOMS .GT. 2) NB( NATOMS) = NATOMS - 2
            IF ( NATOMS .GT. 3) NC( NATOMS) = 1
            IF ( DEBUGI ) THEN
               WRITE (*,'('' BPDBRD: DUMMIED residue '', I4,
     .    '' at '',3F10.4 )') NATOMS,(GEO( IDMS, NATOMS),IDMS=1,3)
            ENDIF
            LABEL( NATOMS) = 99
            SEQRES = SEQRES + 1
            IF ( XDUMMY.EQ.YDUMMY .AND. XDUMMY.EQ.ZDUMMY ) THEN
               XDUMMY = XDUMMY + 1.0
            ELSEIF ( YDUMMY .EQ. ZDUMMY ) THEN
               YDUMMY = YDUMMY + 1.0
            ELSE
               ZDUMMY = ZDUMMY + 1.0
            ENDIF
            GOTO 56
         ENDIF
         IF ( DEBUGI) THEN
            CALL DEBUGR( 'Match on residue '//RTEMP )
         ENDIF
         IF ( NRES1(1) .EQ. NTEMP) THEN
            IF ( DEBUGI .AND. LRES+1 .NE. NTEMP ) 
     .                     WRITE (*,2000) LRES+1,NTEMP-1
2000           FORMAT (' Skipping residue(s) ',I3,' thru ',I3,'.')
            WRITE ( *, '('' Selecting from residue '',A6,I6,''.'')')
     .                   LINE( 18: 23 ), NTEMP
            LRES=NTEMP
         ENDIF
*  GET RESIDUE LABEL  -  IF THIS IS THE FIRST TIME
         NATOMS = NATOMS + 1
         LABEL( NATOMS) = NUMELE( RTEMP )
         SEQRES = NTEMP
         GEO(1,NATOMS)=READA(LINE,31,IRROR)
         GEO(2,NATOMS)=READA(LINE,39,IRROR)
         GEO(3,NATOMS)=READA(LINE,47,IRROR)
         IF ( NATOMS .GT. 1) NA( NATOMS) = NATOMS - 1
         IF ( NATOMS .GT. 2) NB( NATOMS) = NATOMS - 2
         IF ( NATOMS .GT. 3) NC( NATOMS) = 1
         IF ( NATOMS .GT. 1 ) THEN
            IF ( LABEL( NATOMS-1 ) .NE. 99 ) THEN
               ATBOND( NATOMS, NATOMS-1) = 1
               ATBOND( NATOMS-1, NATOMS) = 1
            ENDIF
         ENDIF
         IF ( DEBUGI ) THEN
            WRITE (*,'('' BPDBRD: SELECTED residue '', I4,
     .    '' at '',3F10.4 )') NTEMP, (GEO( IDMS, NATOMS),IDMS=1,3)
         ENDIF
         IF ( NATOMS .LT. NUMATM ) THEN
            GOTO 50
         ELSE
            CALL DEBUGR( 'Residue selection incomplete.' )
            WRITE ( *, '('' DRAW is dimensioned for '',I8,'' atoms.'')')
     .            NUMATM
         ENDIF
 95   CONTINUE
********
      ELSEIF ( LINE(1:1) .EQ. 'A' ) THEN
********
         CALL UPROMP( 'Do you also want any solvent molecules? [YES]')
         READ ( *, '(A)') LINE
         CALL LCLEAN( LINE, LINE, .TRUE.)
         IF ( LINE( 1: 1) .EQ. 'N' ) THEN
            SOLVNT = .FALSE.
         ELSE
            SOLVNT = .TRUE.
         ENDIF
      LRES=0
         MM=1
         NATOMS=0
 150      READ(KHANEL,'(A)',ERR=97,END=102) LINE
         IF ( DEBUGI) CALL DEBUGR( LINE(1:78) )
         IF ( LINE(1: 6) .EQ. 'HETATM' .AND. SOLVNT) GOTO 200
         IF (LINE(:6) .NE. 'ATOM  ') GOTO 150
         IF (LINE(:6) .EQ. 'END   ') GOTO 102
C  GET RESIDUE AND NUMBER OF THIS LINE
         RTEMP=LINE(18:22)
         NTEMP=READA(LINE,23,ERROR)
         IF (ERROR) THEN
            CALL DEBUGR( 'ERROR IN RESIDUE NUMBER' )
            CALL DEBUGR( LINE(1: 78 ) )
            GOTO 195
         ENDIF
         IF (DEBUGI) THEN
           WRITE (*,'('' COMPARING RES '',I6,'' TO '',I6)' ) 
     .               NTEMP, NRES1(MM)
         ENDIF
C?         IF ( LRES+1 .EQ. NTEMP) LRES=NTEMP
C  CHECK IF THIS RESIDUE IS WANTED
 155     IF (NTEMP .LT. NRES1(MM)) GOTO 150
         IF (NTEMP .GT. NRES2(MM)) THEN
            MM = MM + 1
            IF (MM .LE. NN) GOTO 155
            GOTO 195
         ENDIF
         IF (NTEMP.GE. NRES1(MM) .AND. NTEMP.LE.NRES2(MM)) THEN
            IF ( DEBUGI) THEN
               CALL DEBUGR( 'Match on residue '//RTEMP )
            ENDIF
               NATOMS = NATOMS + 1
            IF ( LRES .NE. NTEMP) THEN
               IF ( DEBUGI .AND. LRES+1 .NE. NTEMP ) 
     .                     WRITE (*,2000) LRES+1,NTEMP-1
C?2000           FORMAT (' Skipping residue(s) ',I3,' thru ',I3,'.',/)
               WRITE ( *, '('' Selecting residue '',A6,I6,''.'')')
     .                   LINE( 18: 23 ), NTEMP
               LRES=NTEMP
            ENDIF
C  FIND ATOM TYPE 
               LABEL(NATOMS)=NUMELE(LINE(14:14))
C   CHECK OUT THE GEO
            GEO(1,NATOMS)=READA(LINE,31,IRROR)
            GEO(2,NATOMS)=READA(LINE,39,IRROR)
            GEO(3,NATOMS)=READA(LINE,47,IRROR)
            IF ( NATOMS .GT. 1) NA( NATOMS) = NATOMS - 1
            IF ( NATOMS .GT. 2) NB( NATOMS) = NATOMS - 2
            IF ( NATOMS .GT. 3) NC( NATOMS) = 1
         ENDIF
         IF ( NATOMS .LT. NUMATM ) THEN
            GOTO 150
         ELSE
            CALL DEBUGR( 'Residue selection incomplete.' )
            WRITE ( *, '('' DRAW is dimensioned for '',I8,'' atoms.'')')
     .            NUMATM
         ENDIF
 195   CONTINUE
      ELSE
         CALL DEBUGR( 'I don''t understand your response.' )
         GOTO 45
      ENDIF
      IF ( SOLVNT ) GOTO 200
      RETURN
C   ERROR CONDITIONS
97     CALL DEBUGR( 'ERROR READING BROOKHAVEN PDB FILE' )
      GO TO 101
99     WRITE( *,'('' ERROR READING ATOMIC SYMBOL '',A,'' ON ATOM '',
     +        I2/'' IN OR NEAR '',A)')LINE(1:K),I,LINE
101    IOERR=1
102    RETURN 

*********  GETTING SOLVENT MOLECULES
 200  CONTINUE
      IF ( DEBUGI ) CALL DEBUGR( 'BPDBRD: GETTING SOLVENT')
 201  CONTINUE
      READ(KHANEL,'(A)',ERR=97,END=102) LINE
      IF ( DEBUGI) CALL DEBUGR( LINE(1:78) )
      IF ( LINE( 1: 6) .NE. 'HETATM' ) GOTO 201
      IF ( LINE( 1: 6) .EQ. 'END   ') GOTO 102
C  GET RESIDUE AND NUMBER OF THIS LINE
      RTEMP=LINE(18:22)
      NTEMP=READA(LINE,23,ERROR)
      IF ( RTEMP .NE. 'HOH' ) GOTO 201
      NATOMS = NATOMS + 1
C  FIND ATOM TYPE 
      LABEL( NATOMS) = NUMELE( RTEMP)
C   CHECK OUT THE GEO
      GEO(1,NATOMS)=READA(LINE,31,IRROR)
      GEO(2,NATOMS)=READA(LINE,39,IRROR)
      GEO(3,NATOMS)=READA(LINE,47,IRROR)
      IF ( NATOMS .GT. 1) NA( NATOMS) = NATOMS - 1
      IF ( NATOMS .GT. 2) NB( NATOMS) = NATOMS - 2
      IF ( NATOMS .GT. 3) NC( NATOMS) = 1
      IF ( DEBUGI ) THEN
         WRITE (*,'('' BPDBRD: Reading SOLVENT '', I4,
     .    '' at '',3F10.4 )') NATOMS, (GEO( IDMS, NATOMS),IDMS=1,3)
      ENDIF
      GOTO 201

      END 
