1C === RIBBON === 2C (extracted from frodo.tlb in CCP program package) 3C 4 SUBROUTINE RIBBON(NRIB,RIBWID,NCHORD,OFFSET,NATOM) 5C ================================================== 6C 7C Generate guide points for protein ribbon, based on ideas on 8C Carson & Bugg, J.Molec.Graphics 4,121-122 (1986) 9C 10C Guide points for Bspline are generated along a line passing 11C through each CA and along the average of the two peptide planes 12C 13C NRIB number of strands in ribbon (maximum=MAXRIB=15) 14C RIBWID total ribbon width 15C NCHORD number of chords/residue 16C OFFSET amount to offset guide points away from CA positions 17C NATOM number of atoms stored in arrays 18C 19 PARAMETER (MAXRIB=5,MAXRES=1500) 20 PARAMETER (NOISE=0) 21 DIMENSION GUIDE(4,MAXRES,MAXRIB) 22 DIMENSION XCA(3,2),XO(3,2),A(3),B(3),C(3),D(3),E(3),F(3), 23 . G(3),H(3),P(3) 24C 25C Maximum CA-CA distance **2 26 PARAMETER (DISMAX=6.**2) 27C 28 IF(NATOM.LE.0) THEN 29 WRITE(NOISE,1005) 301005 FORMAT(' No atoms selected') 31 RETURN 32 ENDIF 33C 34 IF(NRIB.GT.MAXRIB) THEN 35 WRITE(NOISE,1001) NRIB,MAXRIB 361001 FORMAT(' Too many ribbon strands',I6,' reset to ',I6) 37 NRIB=MAXRIB 38 ENDIF 39C 40 WRITE(NOISE,1002) NRIB,RIBWID,NCHORD,OFFSET 411002 FORMAT(' Ribbon drawn with',I4,' strands, width ',F6.2, 42 . 'A'/' Number of chords =',I3,', offset = ',F6.2,'A') 43C 44C Strand separation 45 DRIB=0. 46 IF(NRIB.GT.1) DRIB=RIBWID/(NRIB-1) 47 RIB2=FLOAT(NRIB+1)/2. 48C 49 NAT=1 50C 51C Get first CA and O 521 CALL GETCAO(XCA(1,1),XO(1,1),NAT,NATOM,IERR) 53CEAM IF(NAT.LE.0) RETURN 54CEAM IF(IERR.NE.0) GO TO 1 55 IF(IERR.NE.0) RETURN 56 I=0 57C 58C Loop for residues 5910 I=I+1 60C Get CA and O for residue I+1 61 CALL GETCAO(XCA(1,2),XO(1,2),NAT,NATOM,IERR) 62C Set LEND = 1 for end of chain under 3 conditions: 63C (a) all atoms done; (b) one fo CA or O missing; (c) break in chain 64 IF(NAT.LT.0.OR.IERR.NE.0) THEN 65 LEND=1 66 ELSE 67 LEND=0 68 ENDIF 69C 70 IF(LEND.EQ.0) THEN 71C Not last one unless CA-CA distance too large 72C A is vector CAi to Ci+1 73 CALL VDIF(A,XCA(1,2),XCA(1,1)) 74 IF(DOT(A,A).GT.DISMAX) LEND=1 75 ENDIF 76 IF(LEND.EQ.0) THEN 77C Not last one 78C B is vector CAi to Oi 79 CALL VDIF(B,XO(1,1),XCA(1,1)) 80C C = A x B; D = C x A 81 CALL CROSS(A,B,C) 82 CALL CROSS(C,A,D) 83 CALL UNIT(D) 84C 85 IF(I.EQ.1) THEN 86C First peptide, no previous one to average with 87 CALL VSET(E,D) 88C No offset for first CA 89 CALL ZEROI(P,3) 90 ELSE 91C Not first, ribbon cross vector is average of peptide plane 92C with previous one 93 CALL SCALEV(B,SIGN(1.,DOT(D,G)),D) 94 CALL VSUM(E,G,B) 95C Offset is along bisector of CA-CA-CA vectors A (H is Ai-1) 96 CALL VDIF(P,H,A) 97 CALL UNIT(P) 98 ENDIF 99 ELSE 100C Last one, just use last plane 101 CALL VSET(E,G) 102C No offset for last CA 103 CALL ZEROI(P,3) 104 ENDIF 105C Normalise vector E 106 CALL UNIT(E) 107C WRITE(NOISE,1003) I,G,D,B,E 108C1003 FORMAT(' I,G,D,B,E',I4,4(3X,3F8.2)/) 109C 110C 111C Generate guide points 112 CALL SCALEV(P,OFFSET,P) 113 CALL VSUM(P,XCA(1,1),P) 114C 115 DO 20,J=1,NRIB 116 FR=(FLOAT(J)-RIB2)*DRIB 117 CALL SCALEV(F,FR,E) 118 CALL VSUM(GUIDE(1,I,J),P,F) 119C EAM - Maybe should be NAT-2 ?? 120 guide(4,i,j) = NAT - 3 12120 CONTINUE 122C 123C Store things for next residue 124 CALL VSET(XCA(1,1),XCA(1,2)) 125 CALL VSET(XO(1,1),XO(1,2)) 126 CALL VSET(G,E) 127 CALL VSET(H,A) 128C 129 IF(LEND.EQ.0) GO TO 10 130C 131 NPT=I 132 CALL RIBDRW(GUIDE,NRIB,MAXRES,NPT,NCHORD) 133C 134C Loop chains if required 135CEAM IF(NAT.GT.0) GO TO 1 136 IF (IERR.EQ.0) GOTO 1 137C 138 RETURN 139 END 140C 141C 142 SUBROUTINE pdb_GETCAO(XCA,XO,NAT,NATOM,IERR) 143C ======================================== 144C 145C Get coordinates of CA in XCA, O in XO, 146C Modified to read sequential CA and O records in PDB format from file 147C 148C On exit: NAT next atom 149C IERR =0 if succesfull, else = 1 150C 151 DIMENSION XCA(3),XO(3) 152C 153 integer PDBFILE 154 parameter (PDBFILE = 1) 155 character*1 a1, rescode(2) 156 character*3 resname(2) 157 character*4 reclabel, atname 158 integer resno(2) 159C 160 ierr=0 161 162 read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(1), 163 1 a1, resno(1), rescode(1), xca(1), xca(2), xca(3) 164 read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(2), 165 1 a1, resno(2), rescode(2), xo(1), xo(2), xo(3) 166 2 format(a4,2x,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,5f8.3,2f6.2,1x,i3) 167 168 if (resname(1) .ne. resname(2)) ierr = 1 169 if (resno(1) .ne. resno(2)) ierr = 1 170 if (rescode(1) .ne. rescode(2)) ierr = 1 171 return 172 173 100 continue 174 ierr = 1 175 nat = -1 176 return 177 178 end 179 180 181 182 SUBROUTINE GETCAO(XCA,XO,NAT,NATOM,IERR) 183C ======================================== 184C 185C Get coordinates of CA in XCA, O in XO, 186C modified to get coords from common /SPAM/ 187C 188C On exit: NAT next atom 189C IERR =0 if succesfull, else = 1 190C 191 DIMENSION XCA(3),XO(3) 192C 193 parameter (MAXATOM=10000) 194 common /SPAM/ natm, SPAM(4,MAXATOM), SCAM(MAXATOM) 195 integer SCAM 196c 197 if ((nat .gt. natm) .or. (nat .gt. natom-1)) then 198 ierr = 1 199CEAM nat = -1 200 return 201 end if 202 203 do i=1,3 204 xca(i) = spam(i,nat) 205 xo(i) = spam(i,nat+1) 206 end do 207 nat = nat + 2 208 ierr = 0 209 return 210 211 end 212 213 subroutine zeroi( a, nwords ) 214 integer*4 a(nwords) 215 do i = 1,nwords 216 a(i) = 0 217 end do 218 return 219 end 220