C C This code is distributed under the terms and conditions of the C CCP4 licence agreement as `Part ii)' software. See the conditions C in the CCP4 manual for a copyright statement. C PROGRAM SURFACE C ============== C C---- Modified to preceed informational output with '*' C (HYDRA comment flag). C Now requires to be built with FORTRAN /NOCHECK /EXTEND C M R Harris June '86 C C---- Read in files, C check formats of files, C check atom names and residue names, C assign van der waals radius to each atom. C C Works under alliant unix: kxh/mbg 19-IX-92 C Modified to used CHC radii. C Tested with optimization. C C C .. Parameters .. REAL COVDFT PARAMETER (COVDFT=0.77) REAL VDWDFT PARAMETER (VDWDFT=1.80) INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER NPARM PARAMETER (NPARM=200) c c---- with CUBE(NEDGEX,NEDGEY,NEDGEZ,2) maxatm required c 25*25*25*2 == 31250 c c INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX,ZMIN, + ZSTEP INTEGER KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER FNAME*80 LOGICAL USECHC , USERIC C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 REAL FVALUE(NPARM) INTEGER IBEG(NPARM),IEND(NPARM), + ITYP(NPARM),IDEC(NPARM) LOGICAL LEND CHARACTER CVALUE(NPARM)*4,LINEKW*255,KEYP*4,CWORK*4 C .. C .. Local Scalars .. REAL AAREA,CAREA,DELTAX,DELTAY,DELTAZ,FRCACC,RMIN,STAR INTEGER I,J,IC,ICHAIN,ICPASS,IERR,IND,INDOLD,MAXERR,N,NDFLT,NHYD, + NOPT,NREC,NSEQ,IPASS CHARACTER SKIP*1,SKIPH*1,ANAME*4,KEYWRD*6,CID*1 LOGICAL OKFILE(2),DOCALC C .. C .. Local Arrays .. INTEGER NATOMS(2) CHARACTER BLINE(64)*1,LINE(80)*1,A3OPT(10)*4 C .. C .. External Subroutines .. EXTERNAL CALCACC,RADASNCHC,RADASNRICH,SETFLAG,CCPRCS C .. C .. Intrinsic Functions .. INTRINSIC MOD C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. C C CALL CCPFYP CALL CCPRCS(6,'SURFACE','$Date: 2002/08/08 13:42:06 $') C in lieu of block data: XMIN = 9999.0 YMIN = 9999.0 ZMIN = 9999.0 XMAX = -9999.0 YMAX = -9999.0 ZMAX = -9999.0 C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C SKIPH = 'Y' PROBE = 1.40 ZSTEP = 0.25 IPASS = 0 ICHAIN = 0 ICPASS = 0 NREC = 0 NDFLT = 0 NHYD = 0 NFILES = 1 OKFILE(1) = .TRUE. OKFILE(2) = .TRUE. DOCALC = .TRUE. USECHC = .TRUE. USERIC = .FALSE. DO J=1,4 DO I=1,MAXATM IFLAG(I,J) = 0 ENDDO ENDDO C C---- The current formats accepted by this program are C Konnert - Hendrikson, C PDB PROTEIN DATA BANK, C and our own 'Accessibility' format. C C C---- WAH format C C ' 1 ARG R143NH1 23456.890 23456.890 23456.890 2345.7890 2345.7890 1' C A3OPT(1) = 'WAH ' C C---- BROOK format C C KEYWRD,IND,ATM(N),RES3(N),CID,NSEQ,X(N),Y(N),Z(N) C A6,I5,2X,A4,A3,1X,A1,I4,4X,3F8.3 C A3OPT(2) = 'PDB ' A3OPT(3) = 'RAD ' A3OPT(4) = 'CHA ' NOPT = 4 FTYPE(1) = 'PDB ' FTYPE(2) = 'PDB ' ZSTEP = 0.25 PROBE = 1.40 C C---- Section to get the input files and to check the format C WRITE (6,FMT=6000) 6000 FORMAT ( + ' PROGRAM: SURFACE',/, + ' Authors: Mark Handschumacher and F. M. Richards ',/,/, + ' PURPOSE: Calculation of the accessibility of the ',/, + ' van der Waals Surface of atoms to a probe ', + //) C LDUMX = 80 IFAILX = 0 CALL CCPDPN(4,'XYZOUT','NEW','F',LDUMX,IFAILX) C WRITE (6,FMT=6028) ' ' WRITE (6,FMT=6006) 6006 FORMAT (' Accessibility program by Mark Handschumacher and ', + ' F.M. Richards - 3/9/84') WRITE (6,FMT=6028) ' ' 10 CONTINUE C NTOK=NPARM LINEKW = ' ' C C *********************************************************** CALL PARSER(KEYP,LINEKW,IBEG,IEND,ITYP, + FVALUE,CVALUE,IDEC,NTOK,LEND,.TRUE.) C *********************************************************** C IF (LEND) GOTO 8877 C C---- NFILES C IF (KEYP.EQ.'NFIL') THEN NFILES = NINT(FVALUE(2)) IF (NFILES.GT.MAXFIL .OR. NFILES.LE.0) THEN WRITE (6,FMT=6008) MAXFIL WRITE (6,FMT=6010) MAXFIL 6008 FORMAT (7X,'The program can only handle - ',I2,' - FILES ') 6010 FORMAT (7X,'Enter any value from 1 to - ',I2) END IF GO TO 10 C C--- FORMAT of input of coordinates C ELSE IF (KEYP.EQ.'FORM') THEN C IF (NTOK.LT.3) THEN CALL CCPERR(2, + ' FORMAT keyword error: not enough arguments given!!!') GO TO 10 END IF C I = NINT(FVALUE(2)) IF (I.LE.0 .OR. I.GT.MAXFIL) THEN WRITE(6,'( a,I1)') ' File number out of range 1 to ',MAXFIL GO TO 10 END IF FTYPE(I) = CVALUE(3) CALL CCPUPC(FTYPE(I)) WRITE (6,'( a,a4,a,I1)') + ' Format ',FTYPE(I),' requested for file ',I OKFILE(I) = .FALSE. DO 40 N = 1,NOPT IF (FTYPE(I).EQ.A3OPT(N)) OKFILE(I) = .TRUE. 40 CONTINUE C IF (.NOT. OKFILE(I)) + WRITE (6,FMT=6022) FTYPE(I) 6022 FORMAT (7X,'Sorry, file type < ',A, + ' > unacceptable. Assumed PDB.') GO TO 10 C C----- PROBE C ELSE IF (KEYP.EQ.'PROB') THEN PROBE = FVALUE(2) RMIN = 0.0 RMAX = 9.9 IF (PROBE.LT.RMIN .OR. PROBE.GT.RMAX) THEN WRITE (6,FMT=*) ' Bad value for PROBE' WRITE (6,FMT=*) ' ' PROBE = 1.40 END IF GO TO 10 C C---- VDWR CHC or RICH C ELSE IF (KEYP.EQ.'VDWR') THEN CWORK = CVALUE(2) CALL CCPUPC(CWORK) IF (CWORK(1:3) .EQ. 'CHC') THEN USECHC = .TRUE. USERIC = .FALSE. ELSE IF (CWORK(1:4).EQ.'RICH') THEN USECHC = .FALSE. USERIC = .TRUE. END IF GO TO 10 C C---- ZSTEP size C ELSE IF (KEYP.EQ.'ZSTE') THEN ZSTEP = FVALUE(2) RMIN = 0.1 RMAX = 1.0 IF (ZSTEP.LT.RMIN .OR. ZSTEP.GT.RMAX)THEN WRITE (6,FMT=*) ' Bad value for probe' WRITE (6,FMT=*) ' ' ZSTEP = 0.25 END IF GO TO 10 C C skip C ELSE IF (KEYP.EQ.'SKIP') THEN DOCALC = .FALSE. GO TO 10 C C rerun C ELSE IF (KEYP.EQ.'RERU') THEN WRITE (6,FMT=6148) WRITE (6,FMT=6150) WRITE (6,FMT=6152) WRITE (6,FMT=6154) 6148 FORMAT (' ',78 ('-')) 6150 FORMAT (' ', (' ')) 6152 FORMAT (6X,'Begining of a new calculation') 6154 FORMAT (6X,'-------- -- - --- -----------') GO TO 250 C C run C ELSE IF (KEYP.EQ.'RUN ') THEN GO TO 8877 C C stop C ELSE IF (KEYP.EQ.'STOP') THEN GO TO 8844 END IF C go to 10 C---- do a full run, starting with the input files 8877 CONTINUE C C ********************************************** CALL CCPDPN(1,'XYZIN1','READONLY','F',LDUMX,IFAILX) IF (NFILES.EQ.2) + CALL CCPDPN(2,'XYZIN2','READONLY','F',LDUMX,IFAILX) C ********************************************** C WRITE (6,FMT=6072) PROBE WRITE (6,FMT=6074) ZSTEP C C---- Now lets check the input files to make sure that all is in order C DO 130 I = 1,NFILES WRITE (6,FMT=6024) I 6024 FORMAT (7X,'Expected format for file -',I2,' - on top line') WRITE (6,FMT=*) ' Read format on bottom line' 6026 FORMAT (1X,79 ('-')) C IF (FTYPE(I).EQ.'WAH') THEN WRITE (6,FMT=6030) 6030 FORMAT (' 1 ARG R143NH1 23456.890 23456.890 23456.890 2345.7890', + ' 2345.7890 1') READ (I,FMT=6028) LINE WRITE (6,FMT=6028) LINE ELSE IF (FTYPE(I).EQ.'CHA') THEN 60 CONTINUE IERR = IERR + 1 MAXERR = 20 C C IF (IERR.GT.MAXERR) THEN GO TO 330 ELSE C C READ (I,FMT=6050,ERR=60) IND,NSEQ,RES3(1),ATM(1),X(1), + Y(1),Z(1) END IF C C WRITE (6,FMT=*) ' ' WRITE (6,FMT=6050) IND,NSEQ,RES3(1),ATM(1),X(1),Y(1),Z(1) C ELSE IF (FTYPE(I).EQ.'PDB') THEN 70 CONTINUE READ (I,FMT=6034,END=80) KEYWRD,BLINE 6034 FORMAT (A6,64A1) CALL CCPUPC(KEYWRD) IF (KEYWRD.EQ.'ATOM ' .OR. KEYWRD.EQ.'HETATM') THEN GO TO 90 ELSE WRITE (6,FMT=6034) KEYWRD,BLINE GO TO 70 END IF C 80 CALL CCPERR(1, + ' File error: no ATOM or HETATM descriptor in PDB file.') 90 WRITE (6,FMT=6036) ' First data line is: ' 6036 FORMAT (/,A,/) WRITE (6,FMT=6034) KEYWRD,BLINE ELSE IF (FTYPE(I).EQ.'RAD') THEN 100 CONTINUE READ (I,FMT=6034,END=110) KEYWRD,BLINE CALL CCPUPC(KEYWRD) WRITE (6,FMT=6034) KEYWRD,BLINE IF (KEYWRD.EQ.' BEGIN') GO TO 120 GO TO 100 C 110 CALL CCPERR(1, + ' File format error: no BEGIN descriptor in RAD file.') 120 WRITE (6,FMT=6036) ' First data line is: ' READ (I,FMT=6034) KEYWRD,BLINE CALL CCPUPC(KEYWRD) WRITE (6,FMT=6034) KEYWRD,BLINE ELSE CALL CCPERR(1,' Unknown file format.') END IF 130 CONTINUE C WRITE (6,FMT=6026) WRITE (6,FMT=*) ' ' REWIND (1) REWIND (2) N = 0 C C---- Read all coordinate files into data arrays C DO 230 I = 1,NFILES NATOMS(I) = 0 C IF (FTYPE(I).EQ.'RAD') THEN 170 CONTINUE READ (I,FMT=6034) KEYWRD CALL CCPUPC(KEYWRD) IF (KEYWRD.NE.' BEGIN') GO TO 170 ELSE IF (FTYPE(I).EQ.'CHA') THEN 180 CONTINUE READ (I,FMT=6146) SKIP C IF (SKIP.EQ.'*') THEN READ (I,FMT=6146) SKIP IF (SKIP.EQ.'*') THEN STAR = 1 GO TO 180 ELSE GO TO 210 END IF ELSE IF (STAR.NE.1) THEN GO TO 180 END IF C C STAR = STAR ELSE IF (FTYPE(I).EQ.'PDB') THEN C C ******************************************************* CLOSE(UNIT=3) CALL CCPDPN(3,'surface.TMP','SCRATCH','F',LDUMX,IFAILX) C ******************************************************* C 190 CONTINUE READ (I,FMT=6034,END=200) KEYWRD,BLINE CALL CCPUPC(KEYWRD) C IF (KEYWRD.EQ.'ATOM ' .OR. KEYWRD.EQ.'HETATM') THEN WRITE (3,FMT=6034) KEYWRD,BLINE NREC = NREC + 1 END IF C GO TO 190 200 WRITE (6,*) + ' Number of records written to temp PDB file =',NREC NREC = 0 REWIND (3) C ******** CLOSE(UNIT=I) C ******** C END IF 210 CONTINUE C C---- Come back to here for next record C N = N + 1 IF (MOD(N,100).EQ.0) WRITE (6,FMT=*) N, + ' Atom records read from coordinate file(s)' C C IF (FTYPE(I).EQ.'WAH') THEN READ (I,FMT=6044,END=220) ICHAIN,RES3(N),CID,NSEQ,ATM(N), + X(N),Y(N),Z(N) 6044 FORMAT (I2,1X,A3,1X,A1,I3,A4,5F10.5,I2) NATOMS(I) = NATOMS(I) + 1 ELSE IF (FTYPE(I).EQ.'PDB') THEN READ (3,FMT=6046,END=220) + KEYWRD,IND,ATM(N),RES3(N),CID,NSEQ,X(N),Y(N),Z(N) 6046 FORMAT (A6,I5,2X,A4,A3,1X,A1,I4,4X,3F8.3) NATOMS(I) = NATOMS(I) + 1 ELSE IF (FTYPE(I).EQ.'CHA') THEN READ (I,FMT=6050,END=220) IND,NSEQ,RES3(N),ATM(N),X(N), + Y(N),Z(N) 6050 FORMAT (I5,I5,1X,A4,1X,A4,3F10.5) NATOMS(I) = NATOMS(I) + 1 ELSE IF (FTYPE(I).EQ.'RAD') THEN READ (I,FMT=6048,END=220,ERR=220) KEY(N),INDOLD, + IFLAG(N,2),INDOLD,ATM(N),RES3(N),IFLAG(N,3),X(N),Y(N),Z(N), + VDWRAD(N),COVRAD(N),AAREA,CAREA,FRCACC 6048 FORMAT (1X,I2,1X,I5,1X,I2,1X,I2,1X,2A4,1X,I3,3F8.3,2F5.2,2F6.1,1X, + F4.2) IFLAG(N,1) = I IFLAG(N,4) = KEY(N) NATOMS(I) = NATOMS(I) + 1 C C---- Skip radius assignment if radius already assigned C GO TO 210 END IF C C ANAME = ATM(N) C C IF ( ANAME(1:1).EQ.'H') THEN N = N - 1 NATOMS(I) = NATOMS(I) - 1 NHYD = NHYD + 1 ELSE IFLAG(N,1) = I IFLAG(N,2) = ICHAIN IFLAG(N,3) = NSEQ C C---- Assign der waals radii to atoms based on atom name C and residue name. iflag(i,4) is set to negative if atom C is not found or residue is not found. if the residue C type is not found and the atom is a main chain atom: C "C ", "N ", "O ", "CA ", the radius will be assigned. C IC = 1 IF (USECHC) THEN CALL RADASNCHC(RES3(N),ATM(N),COVRAD(N), + IFLAG(N,4),IC,IPASS) ELSE IF (USERIC) THEN CALL RADASNRICH(RES3(N),ATM(N),COVRAD(N), + IFLAG(N,4),IC,IPASS) END IF C C IC = 2 C C IF (USECHC) THEN CALL RADASNCHC(RES3(N),ATM(N),VDWRAD(N), + IFLAG(N,4),IC,IPASS) ELSE IF (USERIC) THEN CALL RADASNRICH(RES3(N),ATM(N),VDWRAD(N), + IFLAG(N,4),IC,IPASS) END IF C C IF (IFLAG(N,4).EQ.-1) THEN VDWRAD(N) = VDWDFT COVRAD(N) = COVDFT NDFLT = NDFLT + 1 WRITE (6,FMT=6054) + ICHAIN,RES3(N),CID,NSEQ,ATM(N),X(N),Y(N),Z(N),VDWRAD(N) 6054 FORMAT (I2,A4,1X,A1,I3,A4,3F8.3,' BAD RES NAME, VDW RAD =',F5.2) ELSE IF (IFLAG(N,4).EQ.-2) THEN VDWRAD(N) = VDWDFT COVRAD(N) = COVDFT NDFLT = NDFLT + 1 WRITE (6,FMT=6052) + ICHAIN,RES3(N),CID,NSEQ,ATM(N),X(N),Y(N),Z(N),VDWRAD(N) 6052 FORMAT (I2,A4,1X,A1,I3,A4,3F8.3,' BAD ATM NAME, VDW RAD =',F5.2) END IF C C---- Go back and read next record from input file C END IF GO TO 210 C C---- Finished reading current file C 220 CONTINUE C C ************* IF (FTYPE(I).EQ.'PDB') CLOSE(UNIT=3) C ************* C WRITE (6,FMT=6056) I,NATOMS(I) 6056 FORMAT (7X,'The number of atoms from file - ',I2,' - = ',I6) N = N - 1 230 CONTINUE C C---- Finished reading in all atoms and assigning radii C NTOTAL = N C C---- Now all the data in all coordinate files has been stored C into arrays and van der waals radii have been assigned. C WRITE (6,FMT=6058) NTOTAL 6058 FORMAT (6X,'Number of atoms accepted from input file(s) = ',I6) WRITE (6,FMT=6060) NDFLT 6060 FORMAT (6X,'Number of atoms assigned default radii = ',I6) C C WRITE (6,FMT=6062) NHYD 6062 FORMAT (6X,'Number of hydrogen atoms skipped over = ',I6) WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) NHYD, + ' Atoms begining with "H" have been skipped' WRITE (6,FMT=*) ' ' WRITE (6,FMT=6058) NTOTAL WRITE (6,FMT=*) ' ' WRITE (6,FMT=6060) NDFLT WRITE (6,FMT=*) ' ' 250 CONTINUE C C WRITE (6,FMT=6066) C C---- Now that all manditory data is in the data arrays a C subroutine will be called to assign flag values of -1, 1, C or 0 to all atoms in the arrays. C C KEY = -1 Means that the atom will be ommitted entirely from the C calculations. it is essentially the same as deleting those C atoms from the molecule(s) that were read into the arrays. C C KEY = 0 Means that the atom is included in the calculation and that C the the accessible surface area is to be calculated. there C may be times that the user is interested in the accessibility C of smaller group of atoms within the entire molecule(s). C In this case it would be a waste of time to calculate the C accessibility of all atoms read into the arrays. C C KEY = 1 Means that atoms are to be included in the calculation but C that the user has no interest in the accessible surface C area of these atoms. this allows the user to specify the C environment around the atoms for which accessible surface C is to be calculated. C C ******* CALL SETFLAG C ******* C C---- Set "skip" to default C SKIP = 'N' 260 CONTINUE C C WRITE (6,FMT=*) ' ' WRITE (6,FMT=6070) WRITE (6,FMT=6076) C C IF (.NOT. DOCALC) THEN WRITE (6,FMT=6080) WRITE (6,FMT=6082) ELSE IF (DOCALC) THEN WRITE (6,FMT=6078) END IF C C XMIN = 9999.0 XMAX = -9999.0 YMIN = 9999.0 YMAX = -9999.0 ZMIN = 9999.0 ZMAX = -9999.0 RMIN = 9999.0 RMAX = -9999.0 C C DO 310 I = 1,NTOTAL KEY(I) = IFLAG(I,4) C C IF (KEY(I).GE.0) THEN RADIUS(I) = VDWRAD(I) + PROBE ERADSQ(I) = RADIUS(I)*RADIUS(I) C C---- Check for maximum and minimum coordinate values and radii C IF (Z(I).GT.ZMAX) ZMAX = Z(I) IF (Z(I).LT.ZMIN) ZMIN = Z(I) IF (X(I).GT.XMAX) XMAX = X(I) IF (X(I).LT.XMIN) XMIN = X(I) IF (Y(I).GT.YMAX) YMAX = Y(I) IF (Y(I).LT.YMIN) YMIN = Y(I) IF (RADIUS(I).GT.RMAX) RMAX = RADIUS(I) IF (RADIUS(I).LT.RMIN) RMIN = RADIUS(I) ELSE RADIUS(I) = 0. ERADSQ(I) = 0. END IF C C 310 CONTINUE C C DELTAX = XMAX - XMIN DELTAY = YMAX - YMIN DELTAZ = ZMAX - ZMIN C C WRITE (6,FMT=*) ' ' WRITE (6,FMT=6088) XMIN,XMAX,DELTAX WRITE (6,FMT=6090) YMIN,YMAX,DELTAY WRITE (6,FMT=6092) ZMIN,ZMAX,DELTAZ WRITE (6,FMT=*) ' ' WRITE (6,FMT=6028) ' *' WRITE (6,FMT=6028) ' *' WRITE (6,FMT=6088) XMIN,XMAX,DELTAX WRITE (6,FMT=6090) YMIN,YMAX,DELTAY WRITE (6,FMT=6092) ZMIN,ZMAX,DELTAZ WRITE (6,FMT=6028) ' *' WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' The maximum radius assigned to an atom =',RMAX WRITE (6,FMT=*) ' The minimum radius assigned to an atom =',RMIN WRITE (6,FMT=*) ' ' WRITE (6,FMT=6028) ' *' WRITE (6,FMT=6098) NEQ WRITE (6,FMT=6100) NGT WRITE (6,FMT=6102) NLT WRITE (6,FMT=6028) ' *' WRITE (6,FMT=6104) RMIN WRITE (6,FMT=6106) RMAX WRITE (6,FMT=6094) PROBE WRITE (6,FMT=6096) ZSTEP WRITE (6,FMT=6028) ' *' C C---- Description of variables written to the output files C ICPASS = ICPASS + 1 C C IF (ICPASS.LE.1) THEN WRITE (6,FMT=6108) WRITE (6,FMT=6110) WRITE (6,FMT=6112) WRITE (6,FMT=6114) WRITE (6,FMT=6116) WRITE (6,FMT=6118) WRITE (6,FMT=6120) WRITE (6,FMT=6122) WRITE (6,FMT=6124) WRITE (6,FMT=6126) WRITE (6,FMT=6128) WRITE (6,FMT=6130) WRITE (6,FMT=6132) WRITE (6,FMT=6134) WRITE (6,FMT=6136) END IF C C WRITE (6,FMT=6028) ' *' WRITE (6,FMT=6138) WRITE (6,FMT=6140) WRITE (4,FMT=6142) C C---- SKIP "subroutine calcacc" and therfore the calculation of "aarea", C "carea", C and "frcacc" if the output file is for volume calculations only. C IF (.NOT. DOCALC) THEN C C---- Reset the skip variable C DOCALC = .TRUE. SKIP = 'N' WRITE (6,*) ' Skipping accessible area calculations.' WRITE (6,*) + ' File XYZOUT created for volume program or editing only.' C FRCACC = 0.0 AAREA = 0.0 CAREA = 0.0 C DO 320 I = 1,NTOTAL WRITE (4,FMT=6144) KEY(I),I,IFLAG(I,2),IFLAG(I,1),ATM(I), + RES3(I),IFLAG(I,3),X(I),Y(I),Z(I),VDWRAD(I),COVRAD(I),AAREA, + CAREA,FRCACC 320 CONTINUE C C ELSE C C ******* CALL CALCACC C ******* C END IF C GO TO 10 8844 CONTINUE C WRITE (6,'(/,A,/)') ' Finished with ACCESS Subroutine' CALL CCPERR(0,' Normal Termination') 330 WRITE (6,FMT=*) ' ERROR Count exceeded for < CHA > file' CALL CCPERR(1,' STOP 330') C C---- key index ic if atm res num x y z vdw cov aarea carea frct C C---- Format statements C 6028 FORMAT (80A) 6040 FORMAT (A6) 6042 FORMAT (/7X,'Sorry key word "',A,/, + '" Not found',/) 6066 FORMAT (/' Entering section 2',/' ------------') 6068 FORMAT (A6) 6070 FORMAT (7X,'-------') 6072 FORMAT (7X,'Probe = ',F7.2,/, + ' Radius of probe sphere in angstroms.') 6074 FORMAT (7X,'ZStep = ',F7.2,/, + ' Thickness of crossections through ') 6076 FORMAT (27X,'Atoms in angstroms. ') 6078 FORMAT (7X,'Don`t SKIP',10X,'Do the Area Calculation') 6080 FORMAT (7X,'SKIP',16X,'Skip the area calculation and') 6082 FORMAT (27X,'Make output file with all atoms.') 6084 FORMAT (/, +' Enter "PROBE " if you want to change the probe radius',/, +' Enter "ZSTEP " if you want to change the step increment',/, +' Enter "SKIP " if you want to skip the area calculation',/, +' But make the standard output file with',/, +' van der Waals radii and flag asssignments.',/, +' This file is compatible with the "volume"',/, +' program. The output file from the area',/, +' calculation is also compatible. ',/, +' Enter "NEXT " when you are done',/, +' ------') 6086 FORMAT (F5.2) 6088 FORMAT (6X,'X Min =',F8.3,' X Max =',F8.3,' Delta X = ',F8.3) 6090 FORMAT (6X,'Y Min =',F8.3,' Y Max =',F8.3,' Delta Y = ',F8.3) 6092 FORMAT (6X,'Z Min =',F8.3,' Z Max =',F8.3,' Delta Z = ',F8.3) 6094 FORMAT (6X,'Probe Radius = ',F8.3) 6096 FORMAT (6X,'Step Interval = ',F8.3) 6098 FORMAT (6X,'Number of Atoms calculated = ',I5) 6100 FORMAT (6X,'Number of Atoms included = ',I5) 6102 FORMAT (6X,'Number of Atoms ommited = ',I5) 6104 FORMAT (6X,'Minimum Effective Radius = ',F8.2) 6106 FORMAT (6X,'Maximum Effective Radius = ',F8.2) 6108 FORMAT (6X,'KEY = PROGRAM FLAG: "OMIT", "INCLUDE", "CALCULATE"') 6110 FORMAT (6X,'INDEX = Serial number of atom') 6112 FORMAT (6X,'IC = Chain number') 6114 FORMAT (6X,'IF = File number') 6116 FORMAT (6X,'ATM = Atom type') 6118 FORMAT (6X,'RES = Residue type') 6120 FORMAT (6X,'NUM = Sequence number') 6122 FORMAT (6X,'X,Y,Z = Atom coordinates') 6124 FORMAT (6X,'VDW = van waals Radius of atom') 6126 FORMAT (6X,'COV = Covalent radius of atom') 6128 FORMAT (6X,'AAREA = Surface area of contact in square angstroms ') 6130 FORMAT (14X,'of the probe with the effective surface') 6132 FORMAT (6X,'CAREA = Surface area of contact in square angstroms ') 6134 FORMAT (14X,'of the probe with the van der waals surface') 6136 FORMAT (6X,'FRCT = Fractional accessibility (not in use)') 6138 FORMAT (' KEY INDEX IC IF ATM RES NUM X Y Z V', + 'DW COV AAREA CAREA FRCT') 6140 FORMAT (' -- ----- -- -- -------- --- ------- ------- ------- --', + '-- ---- ----- ----- ----') 6142 FORMAT (' BEGIN') 6144 FORMAT (1X,I2,1X,I5,1X,I2,1X,I2,1X,2A4,1X,I3,3F8.3,2F5.2,2F6.1,1X, + F4.2) 6146 FORMAT (A1) C C END C C C SUBROUTINE ARCLAP C ================ C C C C---- Program removes arc overlaps. reduces arrays arci and arcf C to a unique set. karc is reduced to indicate the final C number of arc entries. C C arrays atmi and atmf contain the serial numbers of atoms C which provide the beginning and end of overlaps on the C target atom and thus reduce the accessible area. C C Common blocks for area and volume programs. C Present version: 9 march 84 C Old version: 2 march 83 C C C .. Parameters .. INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX, + ZMIN,ZSTEP INTEGER KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER FNAME*80 C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 C .. C .. Local Scalars .. REAL T INTEGER K,KK,KS CHARACTER SKIPH*1 C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. C .. Data statements .. save C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C DATA SKIPH/'Y'/ C .. C C T = ARCF(1) KS = 2 10 CONTINUE C C DO 20 K = KS,KARC KK = K IF (T.GT.ARCI(K)) THEN GO TO 30 ELSE T = ARCF(K) END IF 20 CONTINUE C C GO TO 50 C 30 IF (ARCF(KK).GT.ARCF(KK-1)) ARCF(KK-1) = ARCF(KK) T = ARCF(KK-1) KS = KK + 1 C C DO 40 K = KS,KARC ARCI(K-1) = ARCI(K) ARCF(K-1) = ARCF(K) 40 CONTINUE C C KARC = KARC - 1 KS = KK C GO TO 10 C C 50 CONTINUE C C END C C C SUBROUTINE CALCACC C =================== C C C C C--- Calculate accessible (and contact) surface C area for a group of atoms. C C The accessible area for a given atom is calculated by the formula, C C (arcsum) x (atom radius+probe radius) x (deltz) C C Numerical integration is carried out over z. in each z-section, C the arcsum for a given atom is the arclength of the circle C (intersection of the atom sphere with the z-section) that C is not interior to any other atom circles in the same z-section. C C C---- Dimension parameters C C NTOTAL = max. no. of atoms C NCUBE = max. no. of cubes C ICT = max. no. of circle intersections of neighboring spheres C C C---- Atom parameters read from input file or computed in access3 C C X(NTOTAL) = x coordinate C Y(NTOTAL) = y coordinate C Z(NTOTAL) = z coordinate C C RADIUS(NTOTAL) = atom radius in input. reset C to atom radius+probe radius C in access. C C KEY(NTOTAL) = flag for area to be calculated (key=0), C or not calculated (key=1). C C CUBE(3*EDGE,1)= pointer to the location of the first atom C in the array "ITAB(MAXATM)" that falls into C the given cube. C C CUBE(3*EDGE,2)= Pointer to the location of the C last atom in the array C cube number in which the atom falls. C C SEQNO (NTOTAL) = residue sequence number C RES3 (NTOTAL) = residue name C ATM(NTOTAL) = atom name C RADSQ (NTOTAL) = square of (atom radius+probe radius) C C INOV (ICT) = serial numbers of neighbors of test atom. C C ARCI (ICT) = angles at starts of overlap arc intersections C ARCF (ICT) = angles at ends of overlap arc intersections C C DX (ICT) = difference in x coord. between test atom and neighbor C DY (ICT) = difference in y coord. between test atom and neighbor C D (ICT) = distance between test atom and neighbor in xy plane C DSQ (ICT) = square of distance d C C C OUTPUT FILE : X[X].ARE LUN=4 C 2X,3I6,2A4,2F10.4 C IB = running count of atoms whose area C has been calculated C IR = serial number of atom in coordinate list C SEQNO = sequence no. C RES3 = residue name C ATM = atom name C AAREA = accessible area C CAREA = contact area C C---- Variables and format of output records for each C atom whose accessibility was calculated. C C OUTPUT: C C key(ir), ir, iflag(ir,2), iflag(i,1), atm(ir), res3(ir), iflag(ir,3) C x(ir), y(ir), z(ir), vdwrad(ir), aarea, carea, frcacc C C OUTPUT:FORMAT( 1X,I2, 1X,I5, 1X,I2, 1X,I2, 1X,2A4, 1X,I3, C OUTPUT 3F8.3, F5.2, 2F8.3, 1X,F5.3) C C C Common blocks for area and volume programs. C Present version: 9 march 84 C Old version: 2 march 83 C C C .. Parameters .. INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PI,PIX2,PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX, + ZMIN,ZSTEP INTEGER II,KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER*80 FNAME C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 C .. C .. Local Scalars .. REAL AARC,AAREA,ALPHA,ARCSUM,B,BETA,CAREA,EDGE,FRCACC,PRBOLD,RJCT, + RJDIST,RRSQ,RRX2,RSEC2N,RSEC2R,RSECN,T,TF,TI,XR,YR,ZGRID,ZR, + ATOTAL INTEGER I,IB,IN,INDX,IO,ISTART,ISTOP,ISUM,IZ,J,JSTART,JSTOP,JY,K, + KSTART,KSTOP,KX,L,M,MSTART,MSTOP,N,NPASS,NX,NY,NZ,NZP, + IOMIN,IOMAX CHARACTER SKIPH*1 C .. C .. External Subroutines .. EXTERNAL ARCLAP,SORTAB C .. C .. Intrinsic Functions .. INTRINSIC ABS,ACOS,ATAN2,MOD,SQRT C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. save C .. Data statements .. C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C DATA SKIPH/'Y'/ C .. C C PI = ACOS(-1.0) PIX2 = 2.0*PI C C---- Atom records input, 60 bytes/record C IF KEY=-1 atom is omitted entirely C IF KEY= 0 atom is included and area is calculated C IF KEY= 1 atom is included but area is not calculated C C The radius of an atom sphere = atom radius + probe radius C IB = 0 RMAX = 0.0 KARC = ICT C C DO 10 I = 1,NTOTAL IF (RADIUS(I).GT.RMAX) RMAX = RADIUS(I) IF (X(I).LT.XMIN) XMIN = X(I) IF (Y(I).LT.YMIN) YMIN = Y(I) IF (Z(I).LT.ZMIN) ZMIN = Z(I) IF (X(I).GT.XMAX) XMAX = X(I) IF (Y(I).GT.YMAX) YMAX = Y(I) IF (Z(I).GT.ZMAX) ZMAX = Z(I) 10 CONTINUE C C EDGE = RMAX*2.0 C C---- If this is the second pass through and the probe C radius remains the same there is no need to repack C the arrays. C NPASS = NPASS + 1 IF (NPASS.LE.1 .OR. PROBE.NE.PRBOLD) THEN PRBOLD = PROBE C C---- EDGE= maximum diameter of any atom sphere C C---- Cubicals containing the atoms are setup. C the dimension of an edge equals C the diameter of the largest atom sphere C the cubes have a single index C NX = (XMAX-XMIN)/EDGE + 1.0 NY = (YMAX-YMIN)/EDGE + 1.0 NZ = (ZMAX-ZMIN)/EDGE + 1.0 WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' NUMBER OF CUBES PER AXIS: X,Y,Z = ',NX, + NY,NZ IF (NX.GT.NEDGEX .OR. NY.GT.NEDGEY .OR. NZ.GT.NEDGEZ) WRITE (6, + FMT=*) ' INCREASE PARAMETERS "NEDGE-X,Y,Z" TO VALUES ABOVE' WRITE (6,FMT=*) ' ' C C---- Load array "cube" with the number of atoms C that fall into the particular locations in C a course cubic array with an edge of "edge". C these will be used subsequently to speed up C coordinate list searches. C C---- Set the numbers of atoms in each cube to zero C DO 40 K = 1,NX DO 30 J = 1,NY DO 20 I = 1,NZ CUBE(K,J,I,1) = 0 CUBE(K,J,I,2) = 0 20 CONTINUE 30 CONTINUE 40 CONTINUE C C---- Find the number of atoms in each cube C DO 50 L = 1,NTOTAL KX = (X(L)-XMIN)/EDGE + 1 JY = (Y(L)-YMIN)/EDGE + 1 IZ = (Z(L)-ZMIN)/EDGE + 1 CUBE(KX,JY,IZ,1) = CUBE(KX,JY,IZ,1) + 1 50 CONTINUE C C---- Calculated the starting point in the array "itab" C for the atoms that fall into each cube. the first C cube that has atoms starts at the first location C in "itab". the starting point of the atoms in the C next cube(s) is the starting point of the last cube C plus the number of atoms in that cube. C DO 80 K = 1,NX DO 70 J = 1,NY DO 60 I = 1,NZ ISUM = CUBE(K,J,I,1) + ISUM CUBE(K,J,I,1) = ISUM CUBE(K,J,I,2) = ISUM 60 CONTINUE 70 CONTINUE 80 CONTINUE C C---- the array "cube" now contains a pointer to the C array "itab". the entry in "itab" at that position C contains the number of atoms in the cube C C (identified by the index "kji") which is equal to the C number of following consecutive entries in "itab". "itab" C contains the serial numbers of atoms sorted by cube number. C C C---- When all the atoms for a cube have been placed the value C of the pointer will contain the location of the last atom C in cube "kji". C DO 90 L = 1,NTOTAL K = (X(L)-XMIN)/EDGE + 1 J = (Y(L)-YMIN)/EDGE + 1 I = (Z(L)-ZMIN)/EDGE + 1 INDX = CUBE(K,J,I,1) ITAB(INDX) = L INDX = INDX - 1 CUBE(K,J,I,1) = INDX 90 CONTINUE END IF C C---- Process each atom C write(6,*) ntotal C C---- PJX: Reset sum for total area C ATOTAL = 0.0 C DO 200 IR = 1,NTOTAL C C---- Calculate areas only for indicated atoms (key=0) C IF (KEY(IR).EQ.0) THEN IO = 0 AARC = 0 XR = X(IR) YR = Y(IR) ZR = Z(IR) RR = RADIUS(IR) RRX2 = RR*2.0 RRSQ = ERADSQ(IR) C C---- Get the cube index of the atom and reset values for new atom. C KX = (XR-XMIN)/EDGE + 1 JY = (YR-YMIN)/EDGE + 1 IZ = (ZR-ZMIN)/EDGE + 1 KSTART = KX - 1 KSTOP = KX + 1 IF (KSTART.LT.1) KSTART = 1 IF (KSTOP.GT.NX) KSTOP = NX JSTART = JY - 1 JSTOP = JY + 1 IF (JSTART.LT.1) JSTART = 1 IF (JSTOP.GT.NY) JSTOP = NY ISTART = IZ - 1 ISTOP = IZ + 1 IF (ISTART.LT.1) ISTART = 1 IF (ISTOP.GT.NZ) ISTOP = NZ C C IO = 1 IOMIN = IO+10000 IOMAX = IO-10000 RJCT = VDWRAD(IR) + PROBE + PROBE C C DO 130 KX = KSTART,KSTOP DO 120 JY = JSTART,JSTOP DO 110 IZ = ISTART,ISTOP C C---- Retrieve all atoms from each neighboring cube C record the atoms in inov that neighbor atom ir C MSTART = CUBE(KX,JY,IZ,1) IF (MSTART.EQ.0) MSTART = 1 C MSTOP = CUBE(KX,JY,IZ,2) C C IF ((MSTOP-MSTART).NE.0) THEN C C DO 100 M = MSTART,MSTOP IN = ITAB(M) IF (KEY(IN).GE.0) THEN IF (IN.NE.IR) THEN IO = IO + 1 IF (IO.GT.ICT) THEN GO TO 190 ELSE DX(IO) = X(IN) - XR DY(IO) = Y(IN) - YR DSQ(IO) = DX(IO)**2 + DY(IO)**2 RJDIST = (VDWRAD(IN)+RJCT)**2 IF (DSQ(IO).GT.RJDIST .OR. + DSQ(IO).LE.0.0001) THEN IO = IO - 1 ELSE D(IO) = SQRT(DSQ(IO)) INOV(IO) = IN IOMIN=MIN(IOMIN,IO) IOMAX=MAX(IOMAX,IO) END IF END IF END IF END IF 100 CONTINUE END IF 110 CONTINUE 120 CONTINUE 130 CONTINUE IF (IO.GT.0) THEN C C---- Z resolution determined C NZP = RRX2/ZSTEP + 0.5 ZGRID = Z(IR) - RR - ZSTEP/2.0 C C---- Section atom spheres perpendicular to the z axis C II = 1 C DO 180 I = 1,NZP ZGRID = ZGRID + ZSTEP C C---- Find the radius of the circle of intersection of the ir sphere C on the current z-plane C RSEC2R = RRSQ - (ZGRID-ZR)**2 IF (RSEC2R.LT.0.0) RSEC2R = 0.000001 RSECR = SQRT(RSEC2R) C C DO 140 K = 1,ICT ARCI(K) = 0.0 ARCF(K) = 0.0 140 CONTINUE C C KARC = 0 ARCSUM = 0 C C---- Check all surrounding atoms for intersections C DO 150 N = IOMIN,IOMAX IN = INOV(N) C C---- Find radius of circle locus C IF (IN.GT.0) THEN RSEC2N = ERADSQ(IN) - (ZGRID-Z(IN))**2 ELSE RSEC2N = 0.0 END IF IF (RSEC2N.GT.0.0) THEN RSECN= SQRT(RSEC2N) C C---- Find intersections of n.circles with ir circles in section C IF (D(N).LT.RSECR+RSECN) THEN C C---- Do the circles intersect, or C is one circle completely inside the other? C B = RSECR - RSECN IF (D(N).GT.ABS(B)) THEN C C---- If the circles intersect, find the points of intersection C KARC = KARC + 1 IF (KARC.LT.ICT) THEN C C---- Initial and final arc endpoints are found C for the ir circle intersected by a neighboring C circle contained in the same plane. the initial endpoint C of the enclosed arc is stored in arci, and the final C endpoint in arcf law of cosines C IF ((DSQ(N)+RSEC2R-RSEC2N)/ (2.0*D(N)*RSECR).GE. + 1.0) THEN ALPHA = 0.999 WRITE (6,FMT=*) + ' ATTEMP TO CALCULATE ACOS OF NUMBER > 1' WRITE (6,FMT=*) ' IN ROUTINE CALCACC' WRITE (6,FMT=*) ' N= ',N ELSE ALPHA = ACOS((DSQ(N)+RSEC2R-RSEC2N)/ + (D(N)*2.0*RSECR)) END IF C C---- Alpha is the angle between a line containing either C point of intersection C & the reference circle center and the line containing C both circle centers C BETA = ATAN2(DY(N),DX(N)) IF (DY(N).LT.0) BETA = BETA + PIX2 C C---- BETA is the angle between the line containing both C circle centers and the X-AXIS C TI = BETA - ALPHA TF = BETA + ALPHA IF (TI.LT.0.0) TI = TI + PIX2 IF (TF.GT.PIX2) TF = TF - PIX2 ARCI(KARC) = TI IF (TF.LT.TI) THEN C C---- If the arc crosses zero, then it is broken into two segments. C the first ends at pix2 and the second begins at zero C ARCF(KARC) = PIX2 KARC = KARC + 1 END IF ARCF(KARC) = TF ELSE GO TO 190 END IF ELSE IF (B.LE.0.0) THEN GO TO 170 END IF END IF END IF 150 CONTINUE C C---- Find the accessible surface area for the sphere ir on C this section C IF (KARC.NE.0) THEN C C---- General case of several intersecting arcs C the arc endpoints are sorted on the value C of the initial arc endpoint C C ****** CALL SORTAB C ****** C C ****** CALL ARCLAP C ****** C C---- Calculate the accessible area C ARCSUM = ARCI(1) T = ARCF(1) IF (KARC.NE.1) THEN C C DO 160 K = 2,KARC ARCSUM = ARCI(K) + ARCSUM - ARCF(K-1) 160 CONTINUE C C END IF ARCSUM = ARCSUM + PIX2 - ARCF(KARC) ELSE C C---- Special case of no intersections C ARCSUM = PIX2 C C---- At this point overlapping arcs of intersection have C been accounted for and all remaining unique arcs have C been summed for this z section. arcsum now represents C the arc (as an angle)that does not overlap with other atoms C C (i.e. the accessible portion of the total arc.) C END IF C 170 II = II + 1 AARC = AARC + ARCSUM 180 CONTINUE C C---- AARC now represents the total accessible arc angle summed C over all z sections. this is converted to an arc C length by multiplying by the atom radius+the probe radius C and then by the separation of the z sectioning planes,zstep, C to get the accessible area. the contact area is calculated C by reducing the accessible area by the ratio of the C appropriate radii squared. C AAREA = AARC*RR*ZSTEP ELSE AAREA = 4*PI* (RR**2) END IF CAREA = (RR-PROBE)**2*AAREA/RR**2 C C---- Output atom identifiers and accessible and contact surface areas C 67 bytes/record C IB = IB + 1 C C---- The variable "frcacc" will be left for the C fractional accessibility. this would be to C compare the calculated accessibility with C some ideal value. this is has not been implemented yet. C FRCACC = 0.00 WRITE (4,FMT=6002) KEY(IR),IR,IFLAG(IR,2),IFLAG(IR,1), + ATM(IR),RES3(IR),IFLAG(IR,3),X(IR),Y(IR),Z(IR),VDWRAD(IR), + COVRAD(IR),AAREA,CAREA,FRCACC C C---- ATOTAL records the total accessible area for all atoms C ATOTAL = ATOTAL + AAREA C cc WRITE (6,FMT=6002) KEY(IR),IR,IFLAG(IR,2),IFLAG(IR,1), cc + ATM(IR),RES3(IR),IFLAG(IR,3),X(IR),Y(IR),Z(IR),VDWRAD(IR), cc + COVRAD(IR),AAREA,CAREA,FRCACC 6002 FORMAT (1X,I2,1X,I5,1X,I2,1X,I2,1X,2A4,1X,I3,3F8.3,2F5.2,2F6.1,1X, + F4.2) C IF (MOD(IB,100).EQ.0) WRITE (6,FMT=6004) IB GO TO 200 190 WRITE (6,FMT=6000) IR END IF 200 CONTINUE C C---- Write total area for all the atoms C WRITE (6,FMT='(/,A,/,A,F12.2,A,/)') + ' Total accessible area summed over', + ' all atoms in calculation = ',ATOTAL,' Ang.sq' C WRITE (6,FMT=6006) IB C C---- Format statements C 6000 FORMAT (' INCREASE ICT FOR ATOM NO.',I4) 6004 FORMAT (7X,'Completed',I5,' Atoms') 6006 FORMAT (7X,'Total number of atoms whose area was calculated = ', + I6) C C END C C C SUBROUTINE SETFLAG C ================== C C C Common blocks for area and volume programs. C Present version: 9 march 84 C Old version: 2 march 83 C C C .. Parameters .. INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX, + ZMIN,ZSTEP INTEGER KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER*80 FNAME C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 C .. C .. Local Scalars .. INTEGER I,NFLAG CHARACTER SKIPH*1,KEYWRD*6 C .. C .. External Subroutines .. EXTERNAL SUBSET C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. C .. Data statements .. save C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C DATA SKIPH/'Y'/ 10 CONTINUE C .. C C WRITE (6,FMT=6000) READ (5,FMT=6002) KEYWRD CALL CCPUPC(KEYWRD) WRITE (6,FMT=*) ' ------' WRITE (6,FMT=6004) C C IF (KEYWRD.EQ.'PRESET') THEN WRITE (6,FMT=6008) WRITE (6,FMT=6006) KEYWRD WRITE (6,FMT=6004) ELSE IF (KEYWRD.EQ.'ALLATM') THEN NFLAG = 0 C C DO 20 I = 1,NTOTAL IFLAG(I,4) = 0 NFLAG = NFLAG + 1 20 CONTINUE C C WRITE (6,FMT=6006) KEYWRD WRITE (6,FMT=6004) ELSE IF (KEYWRD.EQ.'SUBSET') THEN WRITE (6,FMT=6006) KEYWRD WRITE (6,FMT=6004) C C ****** CALL SUBSET C ****** C ELSE C WRITE (6,FMT=6010) KEYWRD WRITE (6,FMT=*) ' ' GO TO 10 END IF C C WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) + ' ALL ATOM FLAGS HAVE BEEN SET FOR THE ACCESSIBILITY RUN' WRITE (6,FMT=*) + ' ------------------------------------------------------' C C NLT = 0 NEQ = 0 NGT = 0 C C DO 30 I = 1,NTOTAL IF (IFLAG(I,4).LT.0) THEN NLT = NLT + 1 ELSE IF (IFLAG(I,4).EQ.0) THEN NEQ = NEQ + 1 ELSE NGT = NGT + 1 END IF 30 CONTINUE C C WRITE (6,FMT=6012) NLT WRITE (6,FMT=6014) NGT WRITE (6,FMT=6016) NEQ WRITE (6,FMT=6018) NTOTAL WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ENTER "NEXT " IF THIS IS ACCEPTABLE' WRITE (6,FMT=*) + ' ENTER "RESET " IF YOU WANT TO REDEFINE THE FLAGS' WRITE (6,FMT=*) ' ------' READ (5,FMT=6002) KEYWRD CALL CCPUPC(KEYWRD) WRITE (6,FMT=*) ' ------' C C IF (KEYWRD.EQ.'NEXT ') THEN RETURN ELSE IF (KEYWRD.EQ.'RESET ') THEN GO TO 10 END IF C C WRITE (6,FMT=6010) KEYWRD C C---- Format statements C 6000 FORMAT ( +' There are three basic operations that can be performed',/, +' 1) Entering "ALLATM" will calculate the accessible',/, +' surface of all atoms read into',/, +' the data arrays.',//, +' 2) Entering "SUBSET" will allow you to define a subset',/, +' of atoms. if you have an interest',/, +' in a particular group of atoms',/, +' they can be specified rather than',/, +' producing lengthy output files and',/, +' taking up unneccessary program run',/, +' time. further information will be',/, +' provided if this option is entered',//, +' 3) Entering "PRESET" this option is available only if',/, +' the input file(s) were of "rad"',/, +' format. this will take the flag',/, +' values from this file and create',/, +' the indicated subsets based on the',/, +' standard flag values.',/' ------') 6002 FORMAT (A6) 6004 FORMAT (' ',A5) 6006 FORMAT (6X,'SETTYP ',A6) 6008 FORMAT ( +' Flags will default to those currently in',/, +' The array. If the input file(s) is not',/, +' of the standard "rad" format and "subset"',/, +' has not been previously called all atoms',/, +' will be considered in the calculations.',/) 6010 FORMAT (2X,'SORRY KEYWORD "',A6,'" NOT ACCEPTABLE ANSWER') 6012 FORMAT (7X,'The Number of Atoms to be OMMITED ENTIRELY = ',I6) 6014 FORMAT (7X,'The Number of Atoms to be INCLUDED = ',I6) 6016 FORMAT (7X,'The Number of Atoms to be CALCULATED = ',I6) 6018 FORMAT (7X,'The Total Number of Atoms = ',I6) C C END C C C SUBROUTINE SORTAB C ================= C C C C---- Sort arrays a,b,c,d with n entries each in order of C increasing values of the arguments in array a. C C Common blocks for area and volume programs. C Present version: 9 march 84 C Old version: 2 march 83 C C C .. Parameters .. INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX, + ZMIN,ZSTEP INTEGER KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER*80 FNAME C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 C .. C .. Local Scalars .. REAL AA,BB,TEMP INTEGER I,IT,J CHARACTER SKIPH*1 C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. save C .. Data statements .. C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C DATA SKIPH/'Y'/ C .. C C J = 1 10 CONTINUE C C IF (J.LE.KARC) THEN AA = ARCI(J) BB = ARCF(J) TEMP = 10.0 C C DO 20 I = J,KARC IF (ARCI(I).LE.TEMP) THEN TEMP = ARCI(I) IT = I END IF 20 CONTINUE C C ARCI(J) = ARCI(IT) ARCF(J) = ARCF(IT) ARCI(IT) = AA ARCF(IT) = BB J = J + 1 GO TO 10 END IF C C END C C C SUBROUTINE SUBSET C ================= C C C Assigns flags to atoms based on 1) file number C 2) chain number C 3) sequence number C 4) residue TYPE C 5) atom TYPE C C C C C Common blocks for area and volume programs. C Present version: 9 march 84 C Old version: 2 march 83 C C C .. Parameters .. INTEGER MAXFIL PARAMETER (MAXFIL=2) INTEGER MAXATM PARAMETER (MAXATM=150000) INTEGER ICT PARAMETER (ICT=15000) INTEGER NEDGEX PARAMETER (NEDGEX=25) INTEGER NEDGEY PARAMETER (NEDGEY=25) INTEGER NEDGEZ PARAMETER (NEDGEZ=25) C .. C .. Scalars in Common .. REAL PROBE,RMAX,XMAX,XMIN,YMAX,YMIN,ZMAX, + ZMIN,ZSTEP INTEGER KARC,NEQ,NFILES,NGT,NLT,NTOTAL CHARACTER*80 FNAME C .. C .. Arrays in Common .. REAL ARCF,ARCI,COVRAD,D,DSQ,DX,DY,ERADSQ,RADIUS,VDWRAD,X,Y,Z INTEGER CUBE,ICUBE,IFLAG,INOV,ITAB,KEY CHARACTER ATM*4,FTYPE*4,RES3*4 C .. C .. Local Scalars .. INTEGER I,IKEY,ISERI1,ISERI2,IZONE1,IZONE2,KMAX,KMIN,MAX,MIN,NFIL, + NFLAG,NUMCHN,NUMFIL CHARACTER SKIPH*1,ATYPE*4,KEYWRD*4,RRTYPE*4 C .. C .. Common blocks .. COMMON /SURFCC/X(MAXATM),Y(MAXATM),Z(MAXATM),RADIUS(MAXATM), + VDWRAD(MAXATM),COVRAD(MAXATM),ERADSQ(MAXATM),KEY(MAXATM), + RMAX,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,PROBE,ZSTEP COMMON /XAREA/ + INOV(ICT),ARCI(ICT),ARCF(ICT),DX(ICT),DY(ICT),D(ICT), + DSQ(ICT) COMMON /BLOCK3/NFILES,IFLAG(MAXATM,4) COMMON /CBLOCK/FTYPE(MAXFIL),RES3(MAXATM),ATM(MAXATM) COMMON /XCUBES/ITAB(MAXATM),CUBE(NEDGEX,NEDGEY,NEDGEZ,2), + ICUBE(MAXATM) COMMON /SURFETC/KARC COMMON /SFFILES/FNAME COMMON /SINOUT/NLT,NEQ,NGT,NTOTAL C .. save C .. Data statements .. C C---- Skip all atoms that have the first letter of C the atom name begining with 'H' C DATA SKIPH/'Y'/ 10 CONTINUE C .. C C WRITE (6,FMT=6000) C READ (5,FMT=6010) KEYWRD CALL CCPUPC(KEYWRD) WRITE (6,FMT=*) ' ------' C C IF (KEYWRD.EQ.'OMIT') THEN IKEY = -1 ELSE IF (KEYWRD.EQ.'CALC') THEN IKEY = 0 ELSE IF (KEYWRD.EQ.'INCL') THEN IKEY = 1 ELSE IF (KEYWRD.EQ.'DONE') THEN GO TO 340 ELSE WRITE (6,FMT=6016) KEYWRD GO TO 10 END IF C C WRITE (6,FMT=6002) KEYWRD 20 CONTINUE C WRITE (6,FMT=6018) READ (5,FMT=6010,ERR=30) KEYWRD CALL CCPUPC(KEYWRD) WRITE (6,FMT=*) ' ------' C C IF (KEYWRD.EQ.'FILE') THEN GO TO 290 ELSE IF (KEYWRD.EQ.'CHAI') THEN GO TO 230 ELSE IF (KEYWRD.EQ.'ZONE') THEN GO TO 170 ELSE IF (KEYWRD.EQ.'RESI') THEN GO TO 130 ELSE IF (KEYWRD.EQ.'ATOM') THEN GO TO 90 ELSE IF (KEYWRD.EQ.'SERI') THEN GO TO 40 END IF C C 30 WRITE (6,FMT=6016) KEYWRD GO TO 20 C C---- 'SERI'(AL) option C ================= C 40 CONTINUE C KMIN = -99 KMAX = 9999 50 CONTINUE WRITE (6,FMT=6022) ISERI1 WRITE (6,FMT=6022) ISERI2 WRITE (6,FMT=6024) KMIN WRITE (6,FMT=6026) KMAX WRITE (6,FMT=*) ' ------------------------------' WRITE (6,FMT=*) ' ------ENTER BEGINING SERIAL NUMBER' READ (5,FMT=6012,ERR=60) ISERI1 WRITE (6,FMT=*) ' ------------------------------------' WRITE (6,FMT=*) ' ------ENTER ENDING SERIAL NUMBER' READ (5,FMT=6012,ERR=60) ISERI2 WRITE (6,FMT=*) ' ------' WRITE (6,FMT=6028) ISERI1 C C IF (ISERI2.GT.NTOTAL) THEN ISERI2 = NTOTAL WRITE (6,FMT=*) ' RESETTING ENDING SERIAL NUMBER ', + 'TO TOTAL NUMBER OF ATOMS READ' END IF C C WRITE (6,FMT=6028) ISERI2 C C IF (ISERI1.LT.KMIN .OR. ISERI1.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 50 ELSE IF (ISERI2.LT.KMIN .OR. ISERI2.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 50 ELSE GO TO 70 END IF C C 60 WRITE (6,FMT=6020) GO TO 50 70 CONTINUE C C DO 80 I = 1,NTOTAL IF (I.GE.ISERI1 .AND. I.LE.ISERI2) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 80 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) ISERI1 WRITE (6,FMT=6006) ISERI2 END IF C C NFLAG = 0 GO TO 10 90 CONTINUE C C---- ATOM option C =========== C IF (NFILES.GT.1) THEN WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) + ' ------WHICH FILE DO YOU WANT TO WORK WITH ?--->' READ (5,FMT=6012,ERR=90) NFIL WRITE (6,FMT=*) ' ------' KMIN = 1 KMAX = NFILES C C IF (NFIL.LT.KMIN .OR. NFIL.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 90 ELSE GO TO 100 END IF END IF C C NFIL = 1 100 CONTINUE C WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ------ENTER ATOM TYPE, "END " = FINISHED' READ (5,FMT=6014,ERR=120) ATYPE WRITE (6,FMT=*) ' ------' WRITE (6,FMT=6030) ATYPE C C IF (ATYPE.EQ.'END ') THEN GO TO 10 ELSE C C DO 110 I = 1,NTOTAL IF (ATM(I).EQ.ATYPE .AND. IFLAG(I,1).EQ.NFIL) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 110 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) NFIL WRITE (6,FMT=6008) ATYPE END IF C C NFLAG = 0 GO TO 100 END IF 120 WRITE (6,FMT=6020) GO TO 100 130 CONTINUE C C---- RESI(DUE) option C ================ C IF (NFILES.GT.1) THEN WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) + ' ------WHICH FILE DO YOU WANT TO WORK WITH ?--->' READ (5,FMT=6012,ERR=130) NFIL WRITE (6,FMT=*) ' ------' KMIN = 1 KMAX = NFILES C C IF (NFIL.LT.KMIN .OR. NFIL.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 130 ELSE GO TO 140 END IF END IF C C NFIL = 1 140 CONTINUE C WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ------ENTER RESIDUE WRITE(, "END " = FINISHED ' READ (5,FMT=6014,ERR=160) RRTYPE WRITE (6,FMT=*) ' ------' WRITE (6,FMT=6030) RRTYPE C C IF (RRTYPE.EQ.'END ') THEN GO TO 10 ELSE C C DO 150 I = 1,NTOTAL IF (RES3(I).EQ.RRTYPE .AND. IFLAG(I,1).EQ.NFIL) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 150 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) NFIL WRITE (6,FMT=6008) RRTYPE END IF C C NFLAG = 0 GO TO 140 END IF 160 WRITE (6,FMT=6020) GO TO 140 170 CONTINUE C C---- 'ZONE' option C ============ C IF (NFILES.GT.1) THEN WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) + ' ------WHICH FILE DO YOU WANT TO WORK WITH ?---> ' READ (5,FMT=6012,ERR=170) NFIL WRITE (6,FMT=*) ' ------' KMIN = 1 KMAX = NFILES C C IF (NFIL.LT.KMIN .OR. NFIL.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 170 ELSE GO TO 180 END IF END IF C C NFIL = 1 C 180 MIN = -99 MAX = 999 190 CONTINUE WRITE (6,FMT=6022) IZONE1 WRITE (6,FMT=6022) IZONE2 WRITE (6,FMT=6024) KMIN WRITE (6,FMT=6026) KMAX WRITE (6,FMT=*) ' ------------------------------' WRITE (6,FMT=*) ' ------ENTER BEGINING SEQUENCE NUMBER' READ (5,FMT=6012,ERR=200) IZONE1 WRITE (6,FMT=*) ' ------------------------------------' WRITE (6,FMT=*) ' ------ENTER ENDING SEQUENCE NUMBER' READ (5,FMT=6012,ERR=200) IZONE2 WRITE (6,FMT=*) ' ------' WRITE (6,FMT=6028) IZONE1 WRITE (6,FMT=6028) IZONE2 C C IF (IZONE1.LT.MIN .OR. IZONE1.GT.MAX) THEN WRITE (6,FMT=6020) GO TO 190 ELSE IF (IZONE2.LT.MIN .OR. IZONE2.GT.MAX) THEN WRITE (6,FMT=6020) GO TO 190 ELSE GO TO 210 END IF C C 200 WRITE (6,FMT=6020) GO TO 190 210 CONTINUE C C DO 220 I = 1,NTOTAL IF (IFLAG(I,3).GE.IZONE1 .AND. IFLAG(I,3).LE.IZONE2 .AND. + IFLAG(I,1).EQ.NFIL) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 220 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) NFIL WRITE (6,FMT=6006) IZONE1 WRITE (6,FMT=6006) IZONE2 END IF C C NFLAG = 0 GO TO 10 230 CONTINUE C C---- 'CHAIN' option C ============= C IF (NFILES.GT.1) THEN WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) + ' ------WHICH FILE DO YOU WANT TO WORK WITH ?---> ' READ (5,FMT=6012,ERR=230) NFIL WRITE (6,FMT=*) ' ------' KMIN = 1 KMAX = NFILES C C IF (NFIL.LT.KMIN .OR. NFIL.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 230 ELSE GO TO 240 END IF END IF C C NFIL = 1 C 240 KMIN = -9 KMAX = 99 250 CONTINUE WRITE (6,FMT=6022) NUMCHN WRITE (6,FMT=6024) KMIN WRITE (6,FMT=6026) KMAX WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ------ENTER CHAIN NUMBER' READ (5,FMT=6012,ERR=260) NUMCHN WRITE (6,FMT=6028) NUMCHN WRITE (6,FMT=*) ' ------' C C IF (NUMCHN.LT.KMIN .OR. NUMCHN.GT.KMAX) THEN WRITE (6,FMT=6020) GO TO 250 ELSE GO TO 270 END IF C C---- Error C 260 WRITE (6,FMT=6020) GO TO 250 270 CONTINUE C C DO 280 I = 1,NTOTAL IF (IFLAG(I,2).EQ.NUMCHN .AND. IFLAG(I,1).EQ.NFIL) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 280 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) NFIL WRITE (6,FMT=6006) NUMCHN END IF C C NFLAG = 0 C GO TO 10 C C---- 'FILE' option C ============= C 290 CONTINUE KMIN = 1 KMAX = NFILES 300 CONTINUE WRITE (6,FMT=6022) NUMFIL WRITE (6,FMT=6024) KMIN WRITE (6,FMT=6026) KMAX WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ------ENTER FILE NUMBER ' READ (5,FMT=6012,ERR=310) NUMFIL WRITE (6,FMT=6028) NUMFIL WRITE (6,FMT=*) ' ------' C C IF (NUMFIL.LT.MIN .OR. NUMFIL.GT.MAX) THEN WRITE (6,FMT=6020) GO TO 300 ELSE GO TO 320 END IF C C---- Error C 310 WRITE (6,FMT=6020) GO TO 300 320 CONTINUE C C DO 330 I = 1,NTOTAL IF (IFLAG(I,1).EQ.NUMFIL) THEN IFLAG(I,4) = IKEY NFLAG = NFLAG + 1 END IF 330 CONTINUE C C WRITE (6,FMT=*) ' NUMBER OF ATOMS WITH NEW FLAG =',NFLAG C C IF (NFLAG.GT.0) THEN WRITE (6,FMT=6004) KEYWRD WRITE (6,FMT=6006) NUMFIL END IF C C NFLAG = 0 GO TO 10 C 340 CONTINUE WRITE (6,FMT=*) ' ' WRITE (6,FMT=*) ' ---------------------------' WRITE (6,FMT=*) ' EXITING SUBROUTINE "SUBSET"' WRITE (6,FMT=*) ' ' C C---- Format statements C 6000 FORMAT (/, +' KEY OPTIONS: 1) "OMIT"',/, +' 2) "INCL"',/, +' 3) "CALC"',/, +' 4) "DONE"',/' ______') 6002 FORMAT (7X,'SUBSET COMMANDS: ',A4) 6004 FORMAT (7X,'SUBSET COMMANDS:',5X,A4) 6006 FORMAT (7X,'SUBSET COMMANDS:',9X,I4) 6008 FORMAT (7X,'SUBSET COMMANDS:',9X,A4) 6010 FORMAT (A4) 6012 FORMAT (I6) 6014 FORMAT (A4) 6016 FORMAT (7X,'SORRY KEY WORD "',A6,'" NOT ACCEPTABLE') 6018 FORMAT (/, +' FLAG OPTIONS: 1) "FILE"',/, +' 2) "CHAI"(N)',/, +' 3)"ZONE" ',/, +' 4) "RESI"(DUE)',/, +' 5) "ATOM"',/, +' 6)"SERI"(AL)',/' ------') 6020 FORMAT (7X,'NEW VALUE IS INACCEPTABLE PLEASE TRY AGAIN') 6022 FORMAT (7X,'Current Value: ',I5) 6024 FORMAT (7X,'Minimum Value Allowed: ',I5) 6026 FORMAT (7X,'Maximum Value Allowed: ',I5) 6028 FORMAT (7X,'New Value: ',I5) 6030 FORMAT (7X,'New Value: ',A4) C C END C C C SUBROUTINE RADASNCHC(RNAME,ANAME,RADIUS,IFLAG,IC,IPASS) C ======================================================= C C C C---- This subroutine will assign the atomic radius to the atom C based on residue type and atom name. multiple atom names C for same atom will be handeled whenever possible. C C C---- Remember to declare atom TYPE variables that start with C integers to be real variables. C C C .. Parameters .. INTEGER NTYPER PARAMETER (NTYPER=24) REAL DUMMYR PARAMETER (DUMMYR=1.80) C .. C .. Scalar Arguments .. REAL RADIUS INTEGER IC,IFLAG CHARACTER ANAME*4,RNAME*4 C .. C .. Local Scalars .. INTEGER I,IPASS C .. C .. Local Arrays .. REAL C3(2),C3H(2),C3HH(2),C4(2),C4H(2),C4HH(2),C4HHH(2),FE(2), + N3(2),N3H(2),N3HH(2),N4(2),N4H(2),N4HH(2),N4HHH(2),O1(2), + O1N3HH(2),O1O2H(2),O2H(2),P4(2),S2(2),S2H(2),Z2ION(2) CHARACTER RTYPE(24)*4 save C .. C .. Data statements .. C C C ATMTYP = name associated with particular atomtype C RCOV = covalent radius of atom type C RVDW = van der waals radius of atom type C C ATMTYP DESCRIPTION ATMTYP DESCRIPTION C ------ ---------------------- ------ ----------------- C C4 C - TETRAHEDRAL - 0 H N4 N - TETRAHEDRAL - 0 H C C4H C - TETRAHEDRAL - 1 H N4H N - TETRAHEDRAL - 1 H C C4HH C - TETRAHEDRAL - 2 H N4HH N - TETRAHEDRAL - 2 H C C4HHH C - TETRAHEDRAL - 3 H N4HHH N - TETRAHEDRAL - 3 H C C3 C - TRIGONAL - 0 H N3 N - TRIGONAL - 0 H C C3H C - TRIGONAL - 1 H N3H N - TRIGONAL - 1 H C C3HH C - TRIGONAL - 2 H N3HH N - TRIGONAL - 2 H C O1 O - CARBONYL - 0 H S2 S - DIVALENT - 0 H C O2H O - HYDROXYL - 1 H S2H S - SULFHYDRYL - 1 H C O1O2H O - CARBOXYL -1/2 H P4 P - PENTAVALENT - 0 H C C O1N3HH A - (O OR N) C ATMTYP RCOV RVDW C ---- ------ ---- ---- C C C C CHC radii from Chothia (1975). "Structural Invariants in Protein C Folding," Nature 254: 304-308 C C Angstroms C --------- C C4 C - TETRAHEDRAL - 0 H 0.0 C C4H C - TETRAHEDRAL - 1 H 1.87 C C4HH C - TETRAHEDRAL - 2 H 1.87 C C4HHH C - TETRAHEDRAL - 3 H 1.87 C C3 C - TRIGONAL - 0 H 1.76 C C3H C - TRIGONAL - 1 H 1.76 C C3HH C - TRIGONAL - 2 H 1.76 C O1 O - CARBONYL - 0 H 1.4 C O2H O - HYDROXYL - 1 H 1.4 C O1O2H O - CARBOXYL -1/2 H 1.4 C N4 N - TETRAHEDRAL - 0 H 1.5 C N4H N - TETRAHEDRAL - 1 H 1.5 C N4HH N - TETRAHEDRAL - 2 H 1.5 C N4HHH N - TETRAHEDRAL - 3 H 1.5 C N3 N - TRIGONAL - 0 H 1.65 C N3H N - TRIGONAL - 1 H 1.65 C N3HH N - TRIGONAL - 2 H 1.65 C S2 S - DIVALENT - 0 H 1.85 C S2H S - SULFHYDRYL - 1 H 1.85 C P4 P - PENTAVALENT - 0 H C C============================================================================ C COMMENTED CODE FROM VOLUME7.FOR C RICHARDS ORIGINAL C============================================================================ C C ARRAY RCOV(I) CONTAINS THE COVALENT RADIUS ASSIGNED TO C ATOM TYPE NUMBER I. THESE IN GENERAL ARE SINGLE BOND RADII C OR COMPOSITES FOR RINGS. SINCE ONLY RATIOS ARE REQUIRED , C THESE ARE USED IN THE VOLUME PROGRAMS FOR DOUBLE BONDS C AS WELL. UNUSED ENTRIES ARE LOADED WITH 0.0. C C- DATA RCOV/7*0.77,3*0.66,7*0.70,1.04,1.04,1.10,0.68, C- 1 2.17,0.0,1.92,0.0,1.60,0.0,1.92,0.0,2.54,0.0,9*0.0/ C C ARRAY RVDW(I) CONTAINS THE VAN DER WAALS RADIUS ASSIGNED TO C ATOM TYPE NUMBER I.A SINGLE RADIUS IS GIVEN TO ALL ATOMS OR C GROUPS EXCEPT PLANAR AROMATIC SYSTEMS.THESE ARE APPROXIMATED C BY ELLIPSOIDS OF REVOLUTION;THE ENTRIES ARE PAIRED THE FIRST C GIVING THE RADIUS CORRESPONDING TO THE UNIQUE AXIS OF C REVOLUTION(PERPENDICULAR TO THE RINGS),THE SECOND THE OTHER C RADIUS(CORRESPONDING TO THE PLANE OF THE RING). C C- DATA RVDW/0.0,3*1.87,2*1.76,0.0,3*1.4,3*0.0,1.50,0.0, C- 1 2*1.65,2*1.85,0.0,1.6,1.7,3.4,1.7,3.0,1.7,2.9,1.7,3.0,1.7,3.4, C- 3 0.65,8*0.0/ C C============================================================================ C END COMMENTED CODE C============================================================================ DATA RTYPE/'ALA ','ARG ','ASN ','ASP ','CYS ','GLN ','GLU ', + 'GLY ','HIS ','ILE ','LEU ','LYS ','MET ','PHE ','PRO ', + 'SER ','THR ','TRP ','TYR ','VAL ','ZN ','HEM ','ACE ', + 'ASH '/ C C . ACCESS VALUES RCOV & RVDW from VOLUME7 C C Volume 7 data inserted C DATA C4/0.77,0.00/ DATA C4H/0.77,1.87/ DATA C4HH/0.77,1.87/ DATA C4HHH/0.77,1.87/ DATA C3/0.77,1.76/ DATA C3H/0.77,1.76/ DATA C3HH/0.77,0.0/ DATA O1/0.66,1.40/ DATA O2H/0.66,1.40/ DATA O1O2H/0.66,1.40/ DATA N4/0.70,0.00/ DATA N4H/0.70,1.50/ DATA N4HH/0.70,1.50/ DATA N4HHH/0.70,1.50/ DATA N3/0.70,1.5/ DATA N3H/0.70,1.65/ DATA N3HH/0.70,1.65/ DATA S2/1.04,1.85/ DATA S2H/1.04,1.85/ DATA P4/1.10,0.00/ DATA O1N3HH/0.68,1.60/ DATA Z2ION/0.74,0.74/ DATA FE/0.70,1.70/ C .. C C IPASS = IPASS + 1 C C IF (IPASS.EQ.1) THEN WRITE (6,FMT=6000) WRITE (6,FMT=6002) WRITE (6,FMT=6004) WRITE (6,FMT=6006) WRITE (6,FMT=6000) WRITE (6,FMT=6008) WRITE (6,FMT=6010) WRITE (6,FMT=6012) C4 WRITE (6,FMT=6014) C4H WRITE (6,FMT=6016) C4HH WRITE (6,FMT=6018) C4HHH WRITE (6,FMT=6020) C3 WRITE (6,FMT=6022) C3H WRITE (6,FMT=6024) C3HH WRITE (6,FMT=6026) O1 WRITE (6,FMT=6028) O2H WRITE (6,FMT=6030) O1O2H WRITE (6,FMT=6032) N4 WRITE (6,FMT=6034) N4H WRITE (6,FMT=6036) N4HH WRITE (6,FMT=6038) N4HHH WRITE (6,FMT=6040) N3 WRITE (6,FMT=6042) N3H WRITE (6,FMT=6044) N3HH WRITE (6,FMT=6046) S2 WRITE (6,FMT=6048) S2H WRITE (6,FMT=6050) P4 WRITE (6,FMT=6052) O1N3HH WRITE (6,FMT=6054) Z2ION WRITE (6,FMT=6056) FE WRITE (6,FMT=6010) END IF C IFLAG = 1 C C IF (ANAME.EQ.'CA ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'C ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'O ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'N ') THEN RADIUS = N3H(IC) ELSE C DO 10 I = 1,NTYPER IF (RNAME.EQ.RTYPE(I)) THEN IFLAG = 1 GO TO (240,230,220,210,200,190,180,170, + 160,150,140,130,120,110,100,90, + 80,70,60,50,40,30,20,210) I END IF 10 CONTINUE C C---- Residue TYPE not found so dummy radius has C been assigned and iflag set to -1 C C IFLAG = 1 atom is found C IFLAG = -1 atom is not associated with a residue type C or is not in the main chain list or a special C atom name list. (i.e. 'ot1 ') C IFLAG = -2 atom name not found but the residue TYPE has been found C IFLAG = -1 GO TO 250 C C---- Assignment of radius for acetyl group 'ace ' C 20 CONTINUE IF (ANAME.EQ.'CH3 ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - 'hem ' C 30 CONTINUE IF (ANAME.EQ.'FE ') THEN RADIUS = FE(IC) C C---- CMA CMB CMC CMD C ELSE IF (ANAME(1:2).EQ.'CM') THEN RADIUS = C4HHH(IC) C C---- CAA CBA CAD CBD C ELSE IF (ANAME.EQ.'CAA ' .OR. ANAME.EQ.'CBA ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CAD ' .OR. ANAME.EQ.'CBD ') THEN RADIUS = C4HH(IC) C C---- CAB CH CAC C ELSE IF (ANAME.EQ.'CAB ' .OR. ANAME.EQ.'CAC ') THEN RADIUS = C3H(IC) ELSE IF (ANAME(1:2).EQ.'CH') THEN RADIUS = C3H(IC) C C---- CBB CBC C ELSE IF (ANAME.EQ.'CBB ' .OR. ANAME.EQ.'CBC ') THEN RADIUS = C3HH(IC) C C---- N A N B N C N D C ELSE IF (ANAME(1:2).EQ.'N ') THEN RADIUS = N3(IC) C C---- O1A O2A O1D O2D C ELSE IF (ANAME.EQ.'O1A ' .OR. ANAME.EQ.'O2A ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'O1D ' .OR. ANAME.EQ.'O2D ') THEN RADIUS = O1O2H(IC) C C---- C1A C2A C3A C4A CGA C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'A') THEN RADIUS = C3(IC) C C---- C1B C2B C3B C4B C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'B') THEN RADIUS = C3(IC) C C---- C1C C2C C3C C4C C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'C') THEN RADIUS = C3(IC) C C---- C1D C2D C3D C4D CGD C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'D') THEN RADIUS = C3(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ' zn ' C 40 CONTINUE RADIUS = Z2ION(IC) GO TO 250 C C---- Radius assignment for residue - val C 50 CONTINUE IF (ANAME.EQ.'CG2 ' .OR. ANAME.EQ.'CG1 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - tyr C 60 CONTINUE IF (ANAME.EQ.'OH ' .OR. ANAME.EQ.'OEH ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ ' .OR. ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CE1 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - trp C 70 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CE3 ' .OR. ANAME.EQ.'CZ3 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CH2 ' .OR. ANAME.EQ.'CEH2') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ2 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'NE1 ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - thr C 80 CONTINUE IF (ANAME.EQ.'CG2 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'OG ' .OR. ANAME.EQ.'OG1 ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ser C 90 CONTINUE IF (ANAME.EQ.'OG ' .OR. ANAME.EQ.'OG1 ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - pro C 100 CONTINUE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - phe C 110 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ ' .OR. ANAME.EQ.'CE1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - met C 120 CONTINUE IF (ANAME.EQ.'CE ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'SD ') THEN RADIUS = S2(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - lys C 130 CONTINUE IF (ANAME.EQ.'NZ ') THEN RADIUS = N4HHH(IC) ELSE IF (ANAME.EQ.'CE ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - leu C 140 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ile C 150 CONTINUE IF (ANAME.EQ.'CD1 ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CG1 ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'CG2 ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - his C 160 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'NE2 ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'ND1 ') THEN RADIUS = N3(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - gly C 170 CONTINUE IFLAG = -2 GO TO 250 C C---- Radius assignment for residue - glu C 180 CONTINUE IF (ANAME.EQ.'OE2 ' .OR. ANAME.EQ.'OE1 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CD ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - gln C 190 CONTINUE IF (ANAME.EQ.'NE2 ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'OE1 ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'AE1 ' .OR. ANAME.EQ.'AE2 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'NOE1' .OR. ANAME.EQ.'NOE2') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CD ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - cys C 200 CONTINUE IF (ANAME.EQ.'SG ') THEN RADIUS = S2(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - asp C 210 CONTINUE IF (ANAME.EQ.'OD2 ' .OR. ANAME.EQ.'OD1 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - asn C 220 CONTINUE IF (ANAME.EQ.'ND2 ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'OD1 ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'AD1 ' .OR. ANAME.EQ.'AD2 ') THEN RADIUS = O1N3HH(IC) ELSE IF (ANAME.EQ.'NOD1' .OR. ANAME.EQ.'NOD2') THEN RADIUS = O1N3HH(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - arg C 230 CONTINUE IF (ANAME(1:1).EQ.'N' .AND. ANAME(3:3).NE.' ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'CZ ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'NE ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'CD ' .OR. ANAME.EQ.'CG ' .OR. + ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ala C 240 CONTINUE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF END IF C 250 CONTINUE IF (IFLAG.LT.0) THEN RADIUS = DUMMYR IF (ANAME.EQ.'OT ' .OR. ANAME.EQ.'OXT ' .OR. + ANAME.EQ.'OT1 ' .OR. ANAME.EQ.'OT2 ' .OR. + ANAME.EQ.'OE ') THEN RADIUS = O1O2H(IC) IFLAG = 1 ELSE IF (ANAME.EQ.'NT ') THEN RADIUS = N4HHH(IC) IFLAG = 1 END IF END IF C C---- Format statements C 6000 FORMAT (8X) 6002 FORMAT (6X,'ATMTYP = Name associated with particular atom type') 6004 FORMAT (6X,'RCOV = Covalent radius of atom type ') 6006 FORMAT (6X,'RVDW = van der Waals radius of atom type ') 6008 FORMAT (7X,'ATMTYP Description RCOV RVDW') 6010 FORMAT (7X,'------ ---------------------- ------ ------') 6012 FORMAT (7X,'C4 C - Tetrahedral - 0 H ',F6.2,1X,F6.2) 6014 FORMAT (7X,'C4H C - Tetrahedral - 1 H ',F6.2,1X,F6.2) 6016 FORMAT (7X,'C4HH C - Tetrahedral - 2 H ',F6.2,1X,F6.2) 6018 FORMAT (7X,'C4HHH C - Tetrahedral - 3 H ',F6.2,1X,F6.2) 6020 FORMAT (7X,'C3 C - Trigonal - 0 H ',F6.2,1X,F6.2) 6022 FORMAT (7X,'C3H C - Trigonal - 1 H ',F6.2,1X,F6.2) 6024 FORMAT (7X,'C3HH C - Trigonal - 2 H ',F6.2,1X,F6.2) 6026 FORMAT (7X,'O1 O - Carbonyl - 0 H ',F6.2,1X,F6.2) 6028 FORMAT (7X,'O2H O - Hydroxyl - 1 H ',F6.2,1X,F6.2) 6030 FORMAT (7X,'O1O2H O - Carboxyl -1/2 H ',F6.2,1X,F6.2) 6032 FORMAT (7X,'N4 N - Tetrahedral - 0 H ',F6.2,1X,F6.2) 6034 FORMAT (7X,'N4H N - Tetrahedral - 1 H ',F6.2,1X,F6.2) 6036 FORMAT (7X,'N4HH N - Tetrahedral - 2 H ',F6.2,1X,F6.2) 6038 FORMAT (7X,'N4HHH N - Tetrahedral - 3 H ',F6.2,1X,F6.2) 6040 FORMAT (7X,'N3 N - Trigonal - 0 H ',F6.2,1X,F6.2) 6042 FORMAT (7X,'N3H N - Trigonal - 1 H ',F6.2,1X,F6.2) 6044 FORMAT (7X,'N3HH N - Trigonal - 2 H ',F6.2,1X,F6.2) 6046 FORMAT (7X,'S2 S - Divalent - 0 H ',F6.2,1X,F6.2) 6048 FORMAT (7X,'S2H S - Sulfhydryl - 1 H ',F6.2,1X,F6.2) 6050 FORMAT (7X,'P4 P - Pentavalent - 0 H ',F6.2,1X,F6.2) 6052 FORMAT (7X,'O1N3HH A - (O or N) - ',F6.2,1X,F6.2) 6054 FORMAT (7X,'Z2ION ZN- Plus 2 ion - ',F6.2,1X,F6.2) 6056 FORMAT (7X,'FE FE- Heme Iron - ',F6.2,1X,F6.2) C C END C C C SUBROUTINE RADASNRICH(RNAME,ANAME,RADIUS,IFLAG,IC,IPASS) C ================================================ C C C C---- This subroutine will assign the atomic radius to the atom C based on residue type and atom name. multiple atom names C for same atom will be handeled whenever possible. C C C---- Remember to declare atom TYPE variables that start with C integers to be real variables. C C C .. Parameters .. INTEGER NTYPER PARAMETER (NTYPER=24) REAL DUMMYR PARAMETER (DUMMYR=1.80) C .. C .. Scalar Arguments .. REAL RADIUS INTEGER IC,IFLAG CHARACTER ANAME*4,RNAME*4 C .. C .. Local Scalars .. INTEGER I,IPASS C .. C .. Local Arrays .. REAL C3(2),C3H(2),C3HH(2),C4(2),C4H(2),C4HH(2),C4HHH(2),FE(2), + N3(2),N3H(2),N3HH(2),N4(2),N4H(2),N4HH(2),N4HHH(2),O1(2), + O1N3HH(2),O1O2H(2),O2H(2),P4(2),S2(2),S2H(2),Z2ION(2) CHARACTER RTYPE(24)*4 save C .. C .. Data statements .. C C C ATMTYP = name associated with particular atomtype C RCOV = covalent radius of atom type C RVDW = van der waals radius of atom type C C ATMTYP DESCRIPTION ATMTYP DESCRIPTION C ------ ---------------------- ------ ----------------- C C4 C - TETRAHEDRAL - 0 H N4 N - TETRAHEDRAL - 0 H C C4H C - TETRAHEDRAL - 1 H N4H N - TETRAHEDRAL - 1 H C C4HH C - TETRAHEDRAL - 2 H N4HH N - TETRAHEDRAL - 2 H C C4HHH C - TETRAHEDRAL - 3 H N4HHH N - TETRAHEDRAL - 3 H C C3 C - TRIGONAL - 0 H N3 N - TRIGONAL - 0 H C C3H C - TRIGONAL - 1 H N3H N - TRIGONAL - 1 H C C3HH C - TRIGONAL - 2 H N3HH N - TRIGONAL - 2 H C O1 O - CARBONYL - 0 H S2 S - DIVALENT - 0 H C O2H O - HYDROXYL - 1 H S2H S - SULFHYDRYL - 1 H C O1O2H O - CARBOXYL -1/2 H P4 P - PENTAVALENT - 0 H C C O1N3HH A - (O OR N) C ATMTYP RCOV RVDW C ---- ------ ---- ---- C C C C DATA RTYPE/'ALA ','ARG ','ASN ','ASP ','CYS ','GLN ','GLU ', + 'GLY ','HIS ','ILE ','LEU ','LYS ','MET ','PHE ','PRO ', + 'SER ','THR ','TRP ','TYR ','VAL ','ZN ','HEM ','ACE ', + 'ASH '/ C C DATA C4/0.77,0.00/ DATA C4H/0.77,2.00/ DATA C4HH/0.77,2.00/ DATA C4HHH/0.77,2.00/ DATA C3/0.77,1.70/ DATA C3H/0.77,1.85/ DATA C3HH/0.77,1.85/ DATA O1/0.66,1.40/ DATA O2H/0.66,1.60/ DATA O1O2H/0.66,1.50/ DATA N4/0.70,0.00/ DATA N4H/0.70,2.00/ DATA N4HH/0.70,2.00/ DATA N4HHH/0.70,2.00/ DATA N3/0.70,1.50/ DATA N3H/0.70,1.70/ DATA N3HH/0.70,1.80/ DATA S2/1.04,1.85/ DATA S2H/1.04,2.00/ DATA P4/1.10,0.00/ DATA O1N3HH/0.68,1.60/ DATA Z2ION/0.74,0.74/ DATA FE/0.70,1.70/ C .. C C IPASS = IPASS + 1 C C IF (IPASS.EQ.1) THEN WRITE (6,FMT=6000) WRITE (6,FMT=6002) WRITE (6,FMT=6004) WRITE (6,FMT=6006) WRITE (6,FMT=6000) WRITE (6,FMT=6008) WRITE (6,FMT=6010) WRITE (6,FMT=6012) C4 WRITE (6,FMT=6014) C4H WRITE (6,FMT=6016) C4HH WRITE (6,FMT=6018) C4HHH WRITE (6,FMT=6020) C3 WRITE (6,FMT=6022) C3H WRITE (6,FMT=6024) C3HH WRITE (6,FMT=6026) O1 WRITE (6,FMT=6028) O2H WRITE (6,FMT=6030) O1O2H WRITE (6,FMT=6032) N4 WRITE (6,FMT=6034) N4H WRITE (6,FMT=6036) N4HH WRITE (6,FMT=6038) N4HHH WRITE (6,FMT=6040) N3 WRITE (6,FMT=6042) N3H WRITE (6,FMT=6044) N3HH WRITE (6,FMT=6046) S2 WRITE (6,FMT=6048) S2H WRITE (6,FMT=6050) P4 WRITE (6,FMT=6052) O1N3HH WRITE (6,FMT=6054) Z2ION WRITE (6,FMT=6056) FE WRITE (6,FMT=6010) END IF C IFLAG = 1 C C IF (ANAME.EQ.'CA ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'C ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'O ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'N ') THEN RADIUS = N3H(IC) ELSE C DO 10 I = 1,NTYPER IF (RNAME.EQ.RTYPE(I)) THEN IFLAG = 1 GO TO (240,230,220,210,200,190,180,170, + 160,150,140,130,120,110,100,90, + 80,70,60,50,40,30,20,210) I END IF 10 CONTINUE C C---- Residue TYPE not found so dummy radius has C been assigned and iflag set to -1 C C IFLAG = 1 atom is found C IFLAG = -1 atom is not associated with a residue type C or is not in the main chain list or a special C atom name list. (i.e. 'ot1 ') C IFLAG = -2 atom name not found but the residue TYPE has been found C IFLAG = -1 GO TO 250 C C---- Assignment of radius for acetyl group 'ace ' C 20 CONTINUE IF (ANAME.EQ.'CH3 ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - 'hem ' C 30 CONTINUE IF (ANAME.EQ.'FE ') THEN RADIUS = FE(IC) C C---- CMA CMB CMC CMD C ELSE IF (ANAME(1:2).EQ.'CM') THEN RADIUS = C4HHH(IC) C C---- CAA CBA CAD CBD C ELSE IF (ANAME.EQ.'CAA ' .OR. ANAME.EQ.'CBA ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CAD ' .OR. ANAME.EQ.'CBD ') THEN RADIUS = C4HH(IC) C C---- CAB CH CAC C ELSE IF (ANAME.EQ.'CAB ' .OR. ANAME.EQ.'CAC ') THEN RADIUS = C3H(IC) ELSE IF (ANAME(1:2).EQ.'CH') THEN RADIUS = C3H(IC) C C---- CBB CBC C ELSE IF (ANAME.EQ.'CBB ' .OR. ANAME.EQ.'CBC ') THEN RADIUS = C3HH(IC) C C---- N A N B N C N D C ELSE IF (ANAME(1:2).EQ.'N ') THEN RADIUS = N3(IC) C C---- O1A O2A O1D O2D C ELSE IF (ANAME.EQ.'O1A ' .OR. ANAME.EQ.'O2A ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'O1D ' .OR. ANAME.EQ.'O2D ') THEN RADIUS = O1O2H(IC) C C---- C1A C2A C3A C4A CGA C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'A') THEN RADIUS = C3(IC) C C---- C1B C2B C3B C4B C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'B') THEN RADIUS = C3(IC) C C---- C1C C2C C3C C4C C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'C') THEN RADIUS = C3(IC) C C---- C1D C2D C3D C4D CGD C ELSE IF (ANAME(1:1).EQ.'C' .AND. ANAME(3:3).EQ.'D') THEN RADIUS = C3(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ' zn ' C 40 CONTINUE RADIUS = Z2ION(IC) GO TO 250 C C---- Radius assignment for residue - val C 50 CONTINUE IF (ANAME.EQ.'CG2 ' .OR. ANAME.EQ.'CG1 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - tyr C 60 CONTINUE IF (ANAME.EQ.'OH ' .OR. ANAME.EQ.'OEH ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ ' .OR. ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CE1 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - trp C 70 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CE3 ' .OR. ANAME.EQ.'CZ3 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CH2 ' .OR. ANAME.EQ.'CEH2') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ2 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'NE1 ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - thr C 80 CONTINUE IF (ANAME.EQ.'CG2 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'OG ' .OR. ANAME.EQ.'OG1 ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ser C 90 CONTINUE IF (ANAME.EQ.'OG ' .OR. ANAME.EQ.'OG1 ') THEN RADIUS = O2H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - pro C 100 CONTINUE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - phe C 110 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE2 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CZ ' .OR. ANAME.EQ.'CE1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CD1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - met C 120 CONTINUE IF (ANAME.EQ.'CE ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'SD ') THEN RADIUS = S2(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - lys C 130 CONTINUE IF (ANAME.EQ.'NZ ') THEN RADIUS = N4HHH(IC) ELSE IF (ANAME.EQ.'CE ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - leu C 140 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CD1 ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ile C 150 CONTINUE IF (ANAME.EQ.'CD1 ' .OR. ANAME.EQ.'CD ') THEN RADIUS = C4HHH(IC) ELSE IF (ANAME.EQ.'CG1 ') THEN RADIUS = C4HH(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4H(IC) ELSE IF (ANAME.EQ.'CG2 ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - his C 160 CONTINUE IF (ANAME.EQ.'CD2 ' .OR. ANAME.EQ.'CE1 ') THEN RADIUS = C3H(IC) ELSE IF (ANAME.EQ.'NE2 ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'ND1 ') THEN RADIUS = N3(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - gly C 170 CONTINUE IFLAG = -2 GO TO 250 C C---- Radius assignment for residue - glu C 180 CONTINUE IF (ANAME.EQ.'OE2 ' .OR. ANAME.EQ.'OE1 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CD ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - gln C 190 CONTINUE IF (ANAME.EQ.'NE2 ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'OE1 ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'AE1 ' .OR. ANAME.EQ.'AE2 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'NOE1' .OR. ANAME.EQ.'NOE2') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CD ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CG ' .OR. ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - cys C 200 CONTINUE IF (ANAME.EQ.'SG ') THEN RADIUS = S2(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - asp C 210 CONTINUE IF (ANAME.EQ.'OD2 ' .OR. ANAME.EQ.'OD1 ') THEN RADIUS = O1O2H(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - asn C 220 CONTINUE IF (ANAME.EQ.'ND2 ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'OD1 ') THEN RADIUS = O1(IC) ELSE IF (ANAME.EQ.'AD1 ' .OR. ANAME.EQ.'AD2 ') THEN RADIUS = O1N3HH(IC) ELSE IF (ANAME.EQ.'NOD1' .OR. ANAME.EQ.'NOD2') THEN RADIUS = O1N3HH(IC) ELSE IF (ANAME.EQ.'CG ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - arg C 230 CONTINUE IF (ANAME(1:1).EQ.'N' .AND. ANAME(3:3).NE.' ') THEN RADIUS = N3HH(IC) ELSE IF (ANAME.EQ.'CZ ') THEN RADIUS = C3(IC) ELSE IF (ANAME.EQ.'NE ') THEN RADIUS = N3H(IC) ELSE IF (ANAME.EQ.'CD ' .OR. ANAME.EQ.'CG ' .OR. + ANAME.EQ.'CB ') THEN RADIUS = C4HH(IC) ELSE IFLAG = -2 END IF GO TO 250 C C---- Radius assignment for residue - ala C 240 CONTINUE IF (ANAME.EQ.'CB ') THEN RADIUS = C4HHH(IC) ELSE IFLAG = -2 END IF END IF C 250 CONTINUE IF (IFLAG.LT.0) THEN RADIUS = DUMMYR IF (ANAME.EQ.'OT ' .OR. ANAME.EQ.'OXT ' .OR. + ANAME.EQ.'OT1 ' .OR. ANAME.EQ.'OT2 ' .OR. + ANAME.EQ.'OE ') THEN RADIUS = O1O2H(IC) IFLAG = 1 ELSE IF (ANAME.EQ.'NT ') THEN RADIUS = N4HHH(IC) IFLAG = 1 END IF END IF C C---- Format statements C 6000 FORMAT (8X) 6002 FORMAT (6X,'ATMTYP = Name associated with particular atom type') 6004 FORMAT (6X,'RCOV = Covalent radius of atom type ') 6006 FORMAT (6X,'RVDW = van der Waals radius of atom type ') 6008 FORMAT (7X,'ATMTYP Description RCOV RVDW') 6010 FORMAT (7X,'------ ---------------------- ------ ------') 6012 FORMAT (7X,'C4 C - Tetrahedral - 0 H ',F6.2,1X,F6.2) 6014 FORMAT (7X,'C4H C - Tetrahedral - 1 H ',F6.2,1X,F6.2) 6016 FORMAT (7X,'C4HH C - Tetrahedral - 2 H ',F6.2,1X,F6.2) 6018 FORMAT (7X,'C4HHH C - Tetrahedral - 3 H ',F6.2,1X,F6.2) 6020 FORMAT (7X,'C3 C - Trigonal - 0 H ',F6.2,1X,F6.2) 6022 FORMAT (7X,'C3H C - Trigonal - 1 H ',F6.2,1X,F6.2) 6024 FORMAT (7X,'C3HH C - Trigonal - 2 H ',F6.2,1X,F6.2) 6026 FORMAT (7X,'O1 O - Carbonyl - 0 H ',F6.2,1X,F6.2) 6028 FORMAT (7X,'O2H O - Hydroxyl - 1 H ',F6.2,1X,F6.2) 6030 FORMAT (7X,'O1O2H O - Carboxyl -1/2 H ',F6.2,1X,F6.2) 6032 FORMAT (7X,'N4 N - Tetrahedral - 0 H ',F6.2,1X,F6.2) 6034 FORMAT (7X,'N4H N - Tetrahedral - 1 H ',F6.2,1X,F6.2) 6036 FORMAT (7X,'N4HH N - Tetrahedral - 2 H ',F6.2,1X,F6.2) 6038 FORMAT (7X,'N4HHH N - Tetrahedral - 3 H ',F6.2,1X,F6.2) 6040 FORMAT (7X,'N3 N - Trigonal - 0 H ',F6.2,1X,F6.2) 6042 FORMAT (7X,'N3H N - Trigonal - 1 H ',F6.2,1X,F6.2) 6044 FORMAT (7X,'N3HH N - Trigonal - 2 H ',F6.2,1X,F6.2) 6046 FORMAT (7X,'S2 S - Divalent - 0 H ',F6.2,1X,F6.2) 6048 FORMAT (7X,'S2H S - Sulfhydryl - 1 H ',F6.2,1X,F6.2) 6050 FORMAT (7X,'P4 P - Pentavalent - 0 H ',F6.2,1X,F6.2) 6052 FORMAT (7X,'O1N3HH A - (O or N) - ',F6.2,1X,F6.2) 6054 FORMAT (7X,'Z2ION ZN- Plus 2 ion - ',F6.2,1X,F6.2) 6056 FORMAT (7X,'FE FE- Heme Iron - ',F6.2,1X,F6.2) C C END