saxs and adam's corrections to multichain
[unres.git] / source / wham / src / proc_cont.f
1       subroutine proc_cont
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'DIMENSIONS.ZSCOPT'
5       include 'DIMENSIONS.FREE'
6       include 'DIMENSIONS.COMPAR'
7       include 'COMMON.IOUNITS'
8       include 'COMMON.TIME1'
9       include 'COMMON.SBRIDGE'
10       include 'COMMON.CONTROL'
11       include 'COMMON.COMPAR'
12       include 'COMMON.CHAIN'
13       include 'COMMON.HEADER'
14       include 'COMMON.CONTACTS1'
15       include 'COMMON.PEPTCONT'
16       include 'COMMON.GEO'
17       write (iout,*) "proc_cont: nlevel",nlevel
18       if (nlevel.lt.0) then
19         write (iout,*) "call define_fragments"
20         call define_fragments
21       else
22         write (iout,*) "call secondary2"
23         call secondary2(.true.,.false.,ncont_pept_ref,icont_pept_ref,
24      &     isec_ref)
25       endif
26       write (iout,'(80(1h=))')
27       write (iout,*) "Electrostatic contacts"
28       call contacts_between_fragments(.true.,0,ncont_pept_ref,
29      & icont_pept_ref,ncont_frag_ref(1),icont_frag_ref(1,1,1))
30       write (iout,'(80(1h=))')
31       write (iout,*) "Side chain contacts"
32       call contacts_between_fragments(.true.,0,ncont_ref,
33      & icont_ref,nsccont_frag_ref(1),isccont_frag_ref(1,1,1))
34       if (nlevel.lt.0) then
35         do i=1,nfrag(1)
36           ind=icant(i,i)
37           len_cut=1000
38           if (istruct(i).le.1) then
39             len_cut=max0(len_frag(i,1)*4/5,3)
40           else if (istruct(i).eq.2 .or. istruct(i).eq.4) then
41             len_cut=max0(len_frag(i,1)*2/5,3)
42           endif
43           write (iout,*) "i",i," istruct",istruct(i)," ncont_frag",
44      &      ncont_frag_ref(ind)," len_cut",len_cut,
45      &      " icont_single",icont_single," iloc_single",iloc_single
46           iloc(i)=iloc_single
47           if (iloc(i).gt.0) write (iout,*) 
48      &     "Local structure used to compare structure of fragment",i,
49      &     " to native."
50           if (istruct(i).ne.3 .and. istruct(i).ne.0 
51      &        .and. icont_single.gt.0 .and. 
52      &        ncont_frag_ref(ind).ge.len_cut) then
53             write (iout,*) "Electrostatic contacts used to compare",
54      &       " structure of fragment",i," to native."
55             ielecont(i,1)=1
56             isccont(i,1)=0
57           else if (icont_single.gt.0 .and. nsccont_frag_ref(ind)
58      &      .ge.len_cut) then
59             write (iout,*) "Side chain contacts used to compare",
60      &       " structure of fragment",i," to native."
61             isccont(i,1)=1
62             ielecont(i,1)=0
63           else
64             write (iout,*) "Contacts not used to compare",
65      &       " structure of fragment",i," to native."
66             ielecont(i,1)=0
67             isccont(i,1)=0
68             nc_req_setf(i,1)=0
69           endif
70           if (irms_single.gt.0 .or. isccont(i,1).eq.0 
71      &         .and. ielecont(i,1).eq.0) then
72             write (iout,*) "RMSD used to compare",
73      &       " structure of fragment",i," to native."
74             irms(i,1)=1
75           else
76             write (iout,*) "RMSD not used to compare",
77      &       " structure of fragment",i," to native."
78             irms(i,1)=0
79           endif
80         enddo
81       endif
82       if (nlevel.lt.-1) then
83         call define_pairs
84         nlevel = -nlevel
85         if (nlevel.gt.3) nlevel=3
86         if (nlevel.eq.3) then
87           nfrag(3)=1
88           npiece(1,3)=nfrag(1)
89           do i=1,nfrag(1)
90             ipiece(i,1,3)=i
91           enddo
92           ielecont(1,3)=0
93           isccont(1,3)=0
94           irms(1,3)=1
95           n_shift(1,1,3)=0
96           n_shift(2,1,3)=0
97         endif 
98       else if (nlevel.eq.-1) then
99         nlevel=1
100       endif
101       isnfrag(1)=0
102       do i=1,nlevel
103         isnfrag(i+1)=isnfrag(i)+nfrag(i)
104       enddo
105       ndigit=3*nfrag(1)
106       do i=2,nlevel
107         ndigit=ndigit+2*nfrag(i)
108       enddo
109       write (iout,*) "ndigit",ndigit
110       if (.not.binary .and. ndigit.gt.30) then
111         write (iout,*) "Highest class too large; switching to",
112      &    " binary representation."
113         binary=.true.
114       endif
115       write (iout,*) "isnfrag",(isnfrag(i),i=1,nlevel+1)
116       write(iout,*) "rmscut_base_up",rmscut_base_up,
117      & " rmscut_base_low",rmscut_base_low," rmsup_lim",rmsup_lim
118       do i=1,nlevel
119         do j=1,nfrag(i)
120           length_frag = 0
121           if (i.eq.1) then
122             do k=1,npiece(j,i)
123               length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1
124             enddo
125           else
126             do k=1,npiece(j,i)
127               length_frag=length_frag+len_frag(ipiece(k,j,i),1)
128             enddo
129           endif
130           len_frag(j,i)=length_frag
131           rmscutfrag(1,j,i)=rmscut_base_up*length_frag
132           rmscutfrag(2,j,i)=rmscut_base_low*length_frag 
133           if (rmscutfrag(1,j,i).lt.rmsup_lim) 
134      &      rmscutfrag(1,j,i)=rmsup_lim
135           if (rmscutfrag(1,j,i).gt.rmsupup_lim) 
136      &      rmscutfrag(1,j,i)=rmsupup_lim
137         enddo
138       enddo
139       write (iout,*) "Level",1," number of fragments:",nfrag(1)
140       do j=1,nfrag(1)
141         write (iout,*) npiece(j,1),(ifrag(1,k,j),ifrag(2,k,j),
142      &    k=1,npiece(j,1)),len_frag(j,1),rmscutfrag(1,j,1),
143      &    rmscutfrag(2,j,1),n_shift(1,j,1),n_shift(2,j,1),
144      &    ang_cut(j)*rad2deg,ang_cut1(j)*rad2deg,frac_min(j),
145      &    nc_fragm(j,1),nc_req_setf(j,1),istruct(j)
146       enddo
147       do i=2,nlevel
148         write (iout,*) "Level",i," number of fragments:",nfrag(i)
149         do j=1,nfrag(i)
150           write (iout,*) npiece(j,i),(ipiece(k,j,i),
151      &      k=1,npiece(j,i)),len_frag(j,i),rmscutfrag(1,j,i),
152      &      rmscutfrag(2,j,i),n_shift(1,j,i),n_shift(2,j,i),
153      &      nc_fragm(j,i),nc_req_setf(j,i) 
154         enddo
155       enddo
156       return
157       end