C PROTEIN DATA BANK SOURCE CODE CONTNT C AUTHOR. H.NICHOLAS JR. C ENTRY DATE. 4/91 UNSUPPORTED C LAST REVISION. 4/91 C PURPOSE. GENERATE PDB CONTENTS LIST C LANGUAGE. VAX/VMS FORTRAN 77 PROGRAM Contnt C C C The Contnt program and all its modules, subroutines and functions C are copyrighted by the Pittsburgh Supercomputing Center. You are C given free license to modify this program in any way necessary to C suit your needs at your site. You may redistribute this program C only as a complete copy of the program with all modules, subroutines, C and functions, and with the complete text of this copyright notice. C You may not charge any fee for this program beyond a reasonable C distribution media fee should you redistribute the program. C C Request for current copies of the code should be addressed to: C C Hugh B. Nicholas Jr. C Pittsburgh Supercomputing Center C 4400 Fifth Avenue C Pittsburgh, PA 15213 C or C nicholas@cpwpsca - BitNet C nicholas@a.psc.edu - InterNet C C If possible include an e-mail address. C C This program was developed with support from the National C Institutes of Health Department of Research Resources agreement C U41 RR04154 and the National Science Foundation. C C Program notes: This program creates a table of contents file for the C Brookhaven PDB. It requires as input a file created by the VAX/VMS C directory command. The full command should be: C C Dir/out=file.names/columns=1 *.ent C C The header and footer lines shouild be removed from this file so that C it contains only the file names. C C There is a data statment below which contains several file names used C by the program. These should be changed according the the instructions C given just above the data statement to reflect the configuration of C your local system. C C IMPLICIT NONE C C *** Definitions of Variables and Constants for I/O operations C *** See Data File1 statement below C Integer Unit1, Unit2, Unit3, PdbUnt, StdIn, StdOut c Parameter ( Unit1 = 1, Unit2 = 2, Unit3 = 3, PdbUnt = 4, * StdIn = 5, StdOut = 6 ) C Integer NameFl, CoordFl, NoCordFl, PdbFl, Termnl, KeyBrd Character*15 PdbNam Character*46 File1, File2, File3 Character*47 PdbSpec c INTEGER Count, PdbErr, Len, Loc, Loc2 Character*4 LinTyp, Id Character*60 Name, Source, Class, Author, Remark, Rvalue, * LastLn, L60 Character*80 Choice, Line BYTE HOME(10), CLEAR(10), SCREEN(10), C1520(10), * CURON(10), CUROFF(10) LOGICAL Empty, Batch, Coords C INTEGER LASTCH, FIRSTC ! function names C C *** The items in the following DATA statement are used to manipulate the C *** screen of the Wyse WY85 terminal, at VT220 emulator. C DATA HOME / 0, 27, 91, 48, 59, 48, 50, 72, 0, 0 /, * CLEAR / 0, 27, 91, 50, 74, 0, 0, 0, 0, 0 /, * SCREEN / 0, 27, 91, 51, 50, 104, 0, 0, 0, 0 /, ! screen saver * C1520 / 0, 27, 91, 49, 53, 59, 50, 48, 72, 0 /, ! cursor pos * CURON / 0, 27, 91, 63, 50, 53,104, 0, 0, 0 /, ! cursor on * CUROFF / 0, 27, 91, 63, 50, 53,108, 0, 0, 0 / ! cursor off C C *** Modify the file names in the following data statement C C File 1 is the file that contains the directory listiing of the PDB C entry files. File 2 is the file in which the results are stored. C File 3 is a buffer file used to hold non-coordinate entries until all C of the files with coordinates have been processed. PdbSpec is the VMS C path (absolute) to the disk and directory on which the PDB files are C stored. C C Data File1 / 'PDB$disk1:[Brookhaven.data]File.Names ' /, * File2 / 'PDB$disk1:[Brookhaven.data]Contents.Table ' /, * File3 / 'Usr$Temp:[WorkSpace]NC.tmp ' /, * PdbSpec / 'PDB$disk1:[Brookhaven.data] ' / C C 1 FORMAT ( /' Create Table of Contents for the Brookhaven Protein', * ' Data Bank files.', // ) 2 FORMAT ( '+', 10A1, $ ) 3 Format ( //' There was an error opening the file holding the', * ' Brookhaven entry file names:', / A46, // ) 4 FORMAT ( A80 ) 5 Format ( //' There was an error opening the file to hold the', * ' Table of Contents:', / A46, // ) 6 FORMAT ( A < COUNT > ) 7 FORMAT ( '+', I7 ) 8 Format ( //' There was an error opening the scratch file for', * ' Non-Coordinate entries:', / A46, // ) 9 Format ( //' Now extracting table of contents information from', * ' Brookhaven files.' ) 10 FORMAT ( //' Your choice was not recognized - please enter one', * ' of the specified values.' ) 11 Format ( A15 ) 12 FORMAT ( ////' Input text processed, the print file is now being', * ' written.',//// 1 /' Pleased wait.'// ) 13 FORMAT ( A1 ) 14 Format (/' *** PDB File ', A15, ' could not be opened, error', * ' number', I4, ' occurred.' ) 15 Format (/' ',10X,' Table of Contents for the Brookhaven Protein', * ' Data Bank', 1 /' ',14X,' Entries for which atomic coordinates are', 2 ' given.', // ) 16 Format(//' ',10X,' Table of Contents for the Brookhaven Protein', * ' Data Bank', 1 /' ',12X,' Entries for which atomic coordinates are', 2 ' not given.', // ) 21 Format ( ' Entry: ', A4, ' = ', A< Len > ) 22 Format ( 7X, A< Len > ) 23 Format ( ' ' ) C C Termnl = StdOut KeyBrd = StdIn NameFl = Unit1 CoordFl = Unit2 NoCordFl = Unit3 PdbFl = PdbUnt LastLn = '~~blank~' C WRITE(Termnl,2) CLEAR WRITE(Termnl,2) HOME WRITE(Termnl,1) C C *** Open the existing file of PDB entry file names C OPEN( UNIT = NameFl, FILE = File1, STATUS = 'OLD', * DISPOSE = 'KEEP', READONLY, FORM = 'FORMATTED', * ACCESS = 'SEQUENTIAL', ERR = 110 ) GO TO 120 110 WRITE(Termnl,3) File1 Stop ' File1 Error.' C C *** Open the output file to hold the Table of Contents C 120 OPEN( UNIT = CoordFl, FILE = File2, STATUS = 'NEW', * DISPOSE = 'KEEP', FORM = 'FORMATTED', ERR = 130, * ACCESS = 'SEQUENTIAL', ORGANIZATION = 'SEQUENTIAL', * CARRIAGECONTROL = 'LIST' ) GO TO 150 130 WRITE(Termnl,5) File2 Stop ' File2 error.' C C *** Open a temporary buffer to hold non-coordinate entries until all C *** coordinate entries have been filed. C 150 OPEN( UNIT = NoCordFl, FILE = File3, STATUS = 'SCRATCH', * DISPOSE = 'DELETE', FORM = 'UNFORMATTED', RECL = 60, * ACCESS = 'Sequential', ORGANIZATION = 'SEQUENTIAL', * ERR = 160 ) Go To 180 160 WRITE(Termnl,8) File3 Stop ' File3 error.' C C *** Determine whether the run is interactive or batch C 180 READ(KeyBrd,4) Choice Call PakNam( Choice, 80, Empty ) If( Choice(1:1) .eq. 'I' .or. Choice(1:1) .eq. 'i' .or. * Empty ) Then Batch = .False. Else If( Choice(1:1) .eq. 'B' .or. Choice(1:1) .eq. 'b' ) Then Batch = .True. Else WRITE(Termnl,*) ' Incorrect, possibly uncorrectable response.' Stop ' Bad Answer.' End If Count = 0 If( .not. Batch ) Then WRITE(Termnl,2) CLEAR WRITE(Termnl,2) HOME WRITE(Termnl,2) CUROFF Else End If WRITE(Termnl,9) Write( CoordFl, 15 ) C C *** Read the name of a Brookhaven Protein Data Bank File and open it. C 300 READ( NameFl, 11, END = 500 ) PdbNam PdbSpec(33:47) = PdbNam Open( Unit = PdbFl, File = PdbSpec, Status = 'Old', ReadOnly, * Form = 'Formatted', Access = 'Sequential', Err = 310, * IOstat = PdbErr ) Go To 400 310 Write( Termnl, 14 ) PdbNam, PdbErr Go To 300 C C *** Now Read the Brookhaven PDB file and create an entry C 400 Read( PdbFl, 4, End = 450 ) Line C LinTyp = Line(1:4) If( LinTyp .eq. 'HEAD' ) Then Id = Line(63:66) If( Id(1:1) .eq. '0' ) Then Coords = .False. Line(67:70) = '~bgn' Write( NoCordFl ) Line(11:70) Else Coords = .True. Class = Line(11:50) Len = LastCh( Class, 40 ) Write( CoordFl, 21 ) Id, Class(1:Len) End If Else If( LinTyp .eq. 'COMP' ) Then If( Coords ) Then Name = Line(11:70) Len = LastCh( Name, 60 ) Write( CoordFl, 22 ) Name(1:Len) Else Write( NoCordFl ) Line(11:70) End If Else If( LinTyp .eq. 'SOUR' ) Then If( Coords ) Then Source = Line(11:70) Len = LastCh( Source, 60 ) Write( CoordFl, 22 ) Source(1:Len) Else Write( NoCordFl ) Line(11:70) End If Else If( LinTyp .eq. 'AUTH' ) Then If( Coords ) Then Author = Line(11:70) Len = LastCh( Author, 60 ) Write( CoordFl, 22 ) Author(1:Len) Else Write( NoCordFl ) Line(11:70) End If Else If( LinTyp .eq. 'REMA' .and. Line(9:10) .eq. ' 2' ) Then Loc = Index( Line, 'RESOLUTION.' ) If( Loc .gt. 0 ) Then Loc2 = Index( Line, 'ANGSTROMS.' ) If( Loc2 - Loc .ge. 15 .and. Loc2 - Loc .le. 21 ) Then Remark = Line( Loc : Loc2+8 ) Call LowCas( Remark, 30 ) If( Coords ) Then Len = LastCh( Remark, 30 ) Write( CoordFl, 22 ) Remark(1:Len) Else Write( NoCordFl ) Remark End If Else End If Else End If Else If( LinTyp .eq. 'REMA' .and. Line(9:10) .eq. ' 3' ) Then Loc = Index( Line, 'R VALUE IS' ) If( Loc .gt. 0 ) Then Loc2 = LastCh( Line, 70 ) If( Loc2 - Loc .ge. 11 ) Then Call NextNm( Line, Rvalue, Loc, Loc2 ) If( Coords ) Then Len = LastCh( Rvalue, 30 ) Write( CoordFl, 22 ) Rvalue(1:Len) Else Write( NoCordFl ) Rvalue End If Else End If Else End If Else If( LinTyp .eq. 'REMA' .and. lge( Line(9:10), ' 4' ) .or. * LinTyp .eq. 'SEQR' .or. LinTyp .eq. 'ATOM' ) Then If( Coords ) Then Write( CoordFl, 23 ) Else Write( NOCordFl ) LastLn End If Go To 450 Else End If C GO TO 400 C C *** Finished with one PDB file, close it so we can open the next one. C 450 Close( Unit = PdbFl, Dispose = 'Keep' ) Go To 300 C C 500 REWIND NoCordFl Write( CoordFl, 16 ) CLOSE( UNIT = NameFl, DISPOSE = 'KEEP' ) C C *** Transfer Non co-ordinate entries to table of contents file. C 600 Read( NoCordFl, End = 1000 ) L60 C If( L60(57:60) .eq. '~bgn' ) Then Id = L60(53:56) Class = L60(1:40) Len = LastCh( Class, 40 ) Write( CoordFl, 21 ) Id, Class(1:Len) Else If( L60 .eq. '~~blank~' ) Then Write( CoordFl, 23 ) Else Len = LastCh( L60, 60 ) Write( CoordFl, 22 ) L60(1:Len) End If Go To 600 C 1000 CLOSE( UNIT = CoordFl, DISPOSE = 'KEEP' ) CLOSE( UNIT = NoCordFl, DISPOSE = 'DELETE' ) C C WRITE(Termnl,2) CURON WRITE(Termnl,2) CLEAR WRITE(Termnl,2) HOME STOP ' Brookhaven Table of Contents.' END C C C Subroutine NextNm( Line, Rvalue, Loc, Loc2 ) C IMPLICIT NONE C Integer Loc, Loc2 Character*60 Rvalue Character*80 Line c Integer I, N1, Rloc, Bgn, Finish Character*15 Text Data Text / 'The R value is:' / C Rvalue = Text Bgn = Loc + 10 Do 100 i = Bgn, Loc2, 1 If( ( lge( Line(i:i), '0' ) .and. lle( Line(i:i), '9' ) ) .or. * Line(i:i) .eq. '.' ) Then N1 = i Go To 200 Else End If 100 continue Rvalue(18:25) = 'Unknown.' Return C 200 rloc = 17 Do 300 i = N1, Loc2 If( ( lge( Line(i:i), '0' ) .and. lle( Line(i:i), '9' ) ) .or. * Line(i:i) .eq. '.' ) Then rloc = rloc + 1 Rvalue(rloc:rloc) = Line(i:i) Else Return End If 300 continue C End C C C SUBROUTINE PAKNAM ( NAME, LENGTH, BLANKS ) C C *** Subroutine PAKNAM (PAcK NAMe) removes leading blanks from a string C *** of text. C IMPLICIT NONE C INTEGER LENGTH, I, J, L CHARACTER*(*) NAME LOGICAL BLANKS C BLANKS = .FALSE. DO 100 L = 1, LENGTH IF( NAME(L:L) .EQ. ' ' ) GO TO 100 I = L GO TO 150 100 CONTINUE BLANKS = .TRUE. RETURN C 150 IF( I .GT. 1 ) THEN J = 0 DO 200 L = I, LENGTH J = J + 1 NAME(J:J) = NAME(L:L) 200 NAME(L:L) = ' ' ELSE END IF C RETURN END C C C SUBROUTINE ALLCAP( NAME, LENGTH ) C C *** Subroutine ALLCAP converts the alphameric characters in the first C *** LENGTH characters of NAME to upper case. C IMPLICIT NONE C INTEGER LENGTH, L CHARACTER*(*) NAME C DO 100 L = 1, LENGTH IF( NAME(L:L) .GE. 'a' .AND. NAME(L:L) .LE. 'z' ) THEN NAME(L:L) = CHAR( ICHAR( NAME(L:L) ) - 32 ) ELSE END IF 100 CONTINUE C RETURN END C C C Subroutine LowCas( NAME, LENGTH ) C C *** Subroutine LowCas converts the alphameric characters in the first C *** LENGTH characters of NAME to lower case. C IMPLICIT NONE C INTEGER LENGTH, L CHARACTER*(*) NAME C DO 100 L = 1, LENGTH IF( NAME(L:L) .GE. 'A' .AND. NAME(L:L) .LE. 'Z' ) THEN NAME(L:L) = CHAR( ICHAR( NAME(L:L) ) + 32 ) ELSE END IF 100 CONTINUE C RETURN END C C C INTEGER FUNCTION LASTCH ( STRING, MAX ) C IMPLICIT NONE C INTEGER MAX, I CHARACTER*(*) STRING C DO 100 I = MAX, 1, -1 IF( STRING(I:I) .EQ. ' ' ) GO TO 100 LASTCH = I RETURN 100 CONTINUE C LASTCH = 0 RETURN END C C C INTEGER FUNCTION FIRSTC ( STRING, MAX ) C IMPLICIT NONE C INTEGER MAX, I CHARACTER*(*) STRING C DO 100 I = 1, MAX, 1 IF( STRING(I:I) .EQ. ' ' ) GO TO 100 FIRSTC = I RETURN 100 CONTINUE C FIRSTC = 0 RETURN END