1 subroutine proc_cont(iprot,nn,*)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.COMPAR'
6 include 'COMMON.IOUNITS'
8 include 'COMMON.SBRIDGE'
9 include 'COMMON.COMPAR'
10 include 'COMMON.CHAIN'
11 include 'COMMON.HEADER'
12 include 'COMMON.CONTACTS1'
13 include 'COMMON.PEPTCONT'
15 include 'COMMON.CLASSES'
16 include 'COMMON.PROTNAME'
17 include 'COMMON.NAMES'
18 include 'COMMON.INTERACT'
19 integer i,j,k,ib,iprot,nn,ind,icant,length_frag,ndigit,len_cut,
23 character*3 strstr(0:4) /'und','hel','har','std','stp'/
25 write (iout,*) "proc_cont: nlevel",nlevel(iprot)
27 if (nlevel(iprot).lt.0) then
29 write (iout,*) "call define_fragments"
31 call define_fragments(iprot)
34 write (iout,*) "call secondary2"
36 call secondary2(.true.,print_secondary,ncont_pept_ref(iprot),
37 & icont_pept_ref(1,1,iprot),isec_ref(1,iprot),iprot)
39 do ib=1,nclass(iprot)-1
40 if (print_contact) then
41 write (iout,'(a,i2)') "Structural level",ib+1
42 write (iout,'(80(1h=))')
43 write (iout,*) "Electrostatic contacts"
45 call contacts_between_fragments(print_contact,0,
46 & ncont_pept_ref(iprot),
47 & icont_pept_ref(1,1,iprot),ncont_frag_ref(1,ib,iprot),
48 & icont_frag_ref(1,1,1,ib,iprot),mask_p(1,ib,iprot),ib,iprot)
49 if (print_contact) then
50 write (iout,'(80(1h=))')
51 write (iout,*) "Side chain contacts"
53 call contacts_between_fragments(print_contact,0,
55 & icont_ref(1,1,iprot),nsccont_frag_ref(1,ib,iprot),
56 & isccont_frag_ref(1,1,1,ib,iprot),mask_sc(1,ib,iprot),ib,iprot)
58 if (nlevel(iprot).lt.0) then
60 write(iout,*) "rmscut_base_up",
61 & (rmscut_base_up(ib),ib=1,nclass(iprot)-1),
62 & " rmscut_base_low",(rmscut_base_low(ib),ib=1,nclass(iprot)-1),
63 & " rmsup_lim",(rmsup_lim(ib),ib=1,nclass(iprot)-1)
65 do ib=1,nclass(iprot)-1
69 if (istruct(i,ib,iprot).le.1) then
70 len_cut=max0(len_frag(i,1,ib,iprot)*4/5,3)
71 else if (istruct(i,ib,iprot).eq.2.or.istruct(i,ib,iprot).eq.4)
73 len_cut=max0(len_frag(i,1,ib,iprot)*2/5,3)
76 write (iout,*) "i",i," istruct",istruct(i,ib,iprot),
77 & " ncont_frag",ncont_frag_ref(ind,ib,iprot)," len_cut",
79 & " icont_single",icont_single(ib)," iloc_single",
80 & iloc_single(ib)," isig_match_single",isig_match_single(ib)
82 iloc(i,ib,iprot)=iloc_single(ib)
83 if (istruct(i,ib,iprot).eq.1)
84 & isig_match(i,ib,iprot)=isig_match_single(ib)
86 if (iloc(i,ib,iprot).gt.0) write (iout,*)
87 & "Local structure used to compare structure of fragment",i,
88 & " of protein",iprot," to native."
90 if (istruct(i,ib,iprot).ne.3 .and. istruct(i,ib,iprot).ne.0
91 & .and. icont_single(ib).gt.0 .and. icontsc_single(ib).eq.0
92 & .and. ncont_frag_ref(ind,ib,iprot).ge.len_cut .or.
93 & icontp_single(ib).gt.0 .and. ncont_frag_ref(ind,ib,iprot)
96 write (iout,*) "Electrostatic contacts used to compare",
97 & " structure of fragment",i," of protein",iprot," to native."
99 ielecont(i,1,ib,iprot)=1
100 isccont(i,1,ib,iprot)=0
101 else if (icont_single(ib).gt.0 .and.
102 & nsccont_frag_ref(ind,ib,iprot).ge.len_cut .or.
103 & icontsc_single(ib).gt.0 .and.
104 & nsccont_frag_ref(ind,ib,iprot).gt.0) then
106 write (iout,*) "Side chain contacts used to compare",
107 & " structure of fragment",i," of protein",iprot," to native."
109 isccont(i,1,ib,iprot)=1
110 ielecont(i,1,ib,iprot)=0
113 write (iout,*) "Contacts not used to compare",
114 & " structure of fragment",i," of protein",iprot," to native."
116 ielecont(i,1,ib,iprot)=0
117 isccont(i,1,ib,iprot)=0
118 nc_req_setf(i,1,ib,iprot)=0
120 if (iqwol_single(ib).gt.0 .or. isccont(i,1,ib,iprot).eq.0
121 & .and. ielecont(i,1,ib,iprot).eq.0) then
123 write (iout,*) "Q used to compare",
124 & " structure of fragment",i," of protein",iprot," to native."
126 iqwol(i,1,ib,iprot)=1
127 qcutfrag(i,1,ib,iprot)=qcut_single(ib)
128 write (iout,*) "qcut_single",qcut_single(ib),
129 & "qcutfrag",qcutfrag(i,1,ib,iprot)
132 write (iout,*) "Q not used to compare",
133 & " structure of fragment",i," of protein",iprot," to native."
135 iqwol(i,1,ib,iprot)=0
137 if (irms_single(ib).gt.0 .or. isccont(i,1,ib,iprot).eq.0
138 & .and. ielecont(i,1,ib,iprot).eq.0 .and.
139 & iqwol_single(ib).eq.0) then
141 write (iout,*) "RMSD used to compare",
142 & " structure of fragment",i," of protein",iprot," to native."
147 write (iout,*) "RMSD not used to compare",
148 & " structure of fragment",i," of protein",iprot," to native."
155 if (nlevel(iprot).lt.-1) then
156 call define_pairs(iprot)
157 nlevel(iprot) = -nlevel(iprot)
158 if (nlevel(iprot).gt.3) nlevel(iprot)=3
159 if (nlevel(iprot).eq.3) then
161 do ib=1,nclass(iprot)-1
162 npiece(1,3,ib,iprot)=nfrag(1,iprot)
163 do i=1,nfrag(1,iprot)
164 ipiece(i,1,3,ib,iprot)=i
166 ielecont(1,3,ib,iprot)=0
167 isccont(1,3,ib,iprot)=0
169 n_shift(1,1,3,ib,iprot)=0
170 n_shift(2,1,3,ib,iprot)=0
173 else if (nlevel(iprot).eq.-1) then
178 isnfrag(i+1,iprot)=isnfrag(i,iprot)+nfrag(i,iprot)
181 write (iout,*) "nfrag",(nfrag(i,iprot),i=1,nlevel(iprot))
182 write (iout,*) "isnfrag",(isnfrag(i,iprot),i=1,nlevel(iprot)+1)
184 ndigit=3*nfrag(1,iprot)
186 ndigit=ndigit+2*nfrag(i,iprot)
189 write (iout,*) "ndigit",ndigit
191 if (ndigit.ne.nn) then
192 write (iout,*) "Error - length of the class mask of protein",
193 & iprot," is ",nn," but",ndigit,
194 & " fields found in the class template."
197 if (.not.binary(iprot) .and. ndigit.gt.30) then
198 write (iout,*) "Highest class too large for protein",iprot,
199 & " ; switching to binary representation."
203 write (iout,'(/80(1h=)/a,i3,1h(,1x,a,2h)./80(1h-))')
204 & "Specification of fragments and cut-off criteria of protein",
205 & iprot,protname(iprot)(:ilen(protname(iprot)))
206 write (iout,"(a)") "Secondary-structure codes are as follows:"
208 & "und - undefined; hel - helix; har - beta-hairpin;"
209 write (iout,'(a)') "std - single strand; stp - pair of strands."
210 do ib=1,nclass(iprot)-1
211 write (iout,'(80(1h-)/a,i3)') "Structural level",ib
213 do j=1,nfrag(i,iprot)
216 do k=1,npiece(j,i,ib,iprot)
217 length_frag=length_frag+ifrag(2,k,j,ib,iprot)
218 & -ifrag(1,k,j,ib,iprot)+1
221 do k=1,npiece(j,i,ib,iprot)
222 length_frag=length_frag
223 & +len_frag(ipiece(k,j,i,ib,iprot),1,ib,iprot)
226 len_frag(j,i,ib,iprot)=length_frag
227 rmscutfrag(1,j,i,ib,iprot)=rmscut_base_up(ib)*length_frag
228 rmscutfrag(2,j,i,ib,iprot)=rmscut_base_low(ib)*length_frag
229 if (rmscutfrag(1,j,i,ib,iprot).lt.rmsup_lim(ib))
230 & rmscutfrag(1,j,i,ib,iprot)=rmsup_lim(ib)
231 if (rmscutfrag(1,j,i,ib,iprot).gt.rmsupup_lim(ib))
232 & rmscutfrag(1,j,i,ib,iprot)=rmsupup_lim(ib)
235 write (iout,'(80(1h-)/a,i3,a,i3/)')
236 & "Level",1," number of fragments:",nfrag(1,iprot)
237 write (iout,'(2a5,6a4,a5,a7,a7,a12,2a5,a5,a4,a4,2x,a)')
238 & 'frag','len','loc','sig','eC','scC','Q','rms','qcut','rmscut',
239 & 'shifts','angcut','frS','frC','nC','str',
240 & 'np','specification'
241 do j=1,nfrag(1,iprot)
242 write (iout,'(2i5,6i4,1x,3f4.1,2i3,2f6.1,2f5.2,i5,a4,i4,$)') j,
243 & len_frag(j,1,ib,iprot),iloc(j,ib,iprot),
244 & isig_match(j,ib,iprot),ielecont(j,1,ib,iprot),
245 & isccont(j,1,ib,iprot),iqwol(j,1,ib,iprot),irms(j,1,ib,iprot),
246 & qcutfrag(j,1,ib,iprot),rmscutfrag(1,j,1,ib,iprot),
247 & rmscutfrag(2,j,1,ib,iprot),n_shift(1,j,1,ib,iprot),
248 & n_shift(2,j,1,ib,iprot),ang_cut(j,ib,iprot)*rad2deg,
249 & ang_cut1(j,ib,iprot)*rad2deg,frac_min(j,ib,iprot),
250 & nc_fragm(j,1,ib,iprot),nc_req_setf(j,1,ib,iprot),
251 & strstr(istruct(j,ib,iprot)),npiece(j,1,ib,iprot)
252 do k=1,npiece(j,1,ib,iprot)
253 if1=ifrag(1,k,j,ib,iprot)
255 if2=ifrag(2,k,j,ib,iprot)
257 write (iout,'(2x,a1,i3,1h-,a1,i3,$)') onelet(it1),if1,
263 write (iout,'(80(1h-)/a,i3,a,i3/)')
264 & "Level",i," number of fragments:",nfrag(i,iprot)
265 write (iout,'(2a5,4a4,a5,a7,a7,2a5,a4,2x,a)')
266 & 'frag','len','eC','scC','Q','rms','Qcut','rmscut','shifts',
267 & 'frC','nC','np','specification'
268 do j=1,nfrag(i,iprot)
269 write (iout,'(2i5,4i4,1x,3f4.1,2i3,f5.2,i5,i4,$)')
270 & j,len_frag(j,i,ib,iprot),ielecont(j,i,ib,iprot),
271 & isccont(j,i,ib,iprot),iqwol(j,i,ib,iprot),
272 & irms(j,i,ib,iprot),qcutfrag(j,i,ib,iprot),
273 & rmscutfrag(1,j,i,ib,iprot),rmscutfrag(2,j,i,ib,iprot),
274 & n_shift(1,j,i,ib,iprot),n_shift(2,j,i,ib,iprot),
275 & nc_fragm(j,i,ib,iprot),nc_req_setf(j,i,ib,iprot),
276 & npiece(j,i,ib,iprot)
277 do k=1,npiece(j,i,ib,iprot)
278 write (iout,'(i3,$)') ipiece(k,j,i,ib,iprot)
284 write (iout,'(80(1h=))')