File: ribbon.f

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

	read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(1),
     1		a1, resno(1), rescode(1), xca(1), xca(2), xca(3)
	read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(2),
     1		a1, resno(2), rescode(2), xo(1), xo(2), xo(3)
    2	format(a4,2x,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,5f8.3,2f6.2,1x,i3)

	if (resname(1) .ne. resname(2)) ierr = 1
	if (resno(1)   .ne. resno(2))   ierr = 1
	if (rescode(1) .ne. rescode(2)) ierr = 1
	return

  100	continue
	ierr = 1
	nat = -1
	return

	end



      SUBROUTINE GETCAO(XCA,XO,NAT,NATOM,IERR)
C     ========================================
C
C Get coordinates of CA in XCA, O in XO, 
C modified to get coords from common /SPAM/
C
C  On exit: NAT next atom 
C           IERR  =0 if succesfull, else = 1
C
      DIMENSION XCA(3),XO(3)
C
	parameter	(MAXATOM=10000)
	common /SPAM/ natm, SPAM(4,MAXATOM), SCAM(MAXATOM)
	integer SCAM
c
	if ((nat .gt. natm) .or. (nat .gt. natom-1)) then
	     ierr = 1
CEAM	     nat = -1
	     return
	end if

	do i=1,3
	    xca(i) = spam(i,nat)
	    xo(i)  = spam(i,nat+1)
	end do
	nat  = nat + 2
	ierr = 0
	return

	end

	subroutine zeroi( a, nwords )
	integer*4 a(nwords)
	do i = 1,nwords
	    a(i) = 0
	end do
	return
	end