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