saxs and adam's corrections to multichain
[unres.git] / source / wham / src / define_pairs.f
1       subroutine define_pairs
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'DIMENSIONS.ZSCOPT'
5       include 'DIMENSIONS.COMPAR'
6       include 'DIMENSIONS.FREE'
7       include 'COMMON.IOUNITS'
8       include 'COMMON.TIME1'
9       include 'COMMON.SBRIDGE'
10       include 'COMMON.CONTROL'
11       include 'COMMON.COMPAR'
12       include 'COMMON.FRAG'
13       include 'COMMON.CHAIN'
14       include 'COMMON.HEADER'
15       include 'COMMON.GEO'
16       include 'COMMON.CONTACTS1'
17       include 'COMMON.PEPTCONT'
18       do j=1,nfrag(1)
19         length_frag = 0
20         do k=1,npiece(j,1)
21           length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1
22         enddo
23         len_frag(j,1)=length_frag
24         write (iout,*) "Fragment",j," length",len_frag(j,1)
25       enddo
26       nfrag(2)=0
27       do i=1,nfrag(1)
28         do j=i+1,nfrag(1)
29           ind = icant(i,j)
30           if (istruct(i).le.1 .or. istruct(j).le.1) then
31             if (istruct(i).le.1) then
32               ll1=len_frag(i,1)
33             else
34               ll1=len_frag(i,1)/2
35             endif
36             if (istruct(j).le.1) then
37               ll2=len_frag(j,1)
38             else
39               ll2=len_frag(j,1)/2
40             endif
41             len_cut=max0(min0(ll1*2/3,ll2*4/5),3)
42           else
43             if (istruct(i).eq.2 .or. istruct(i).eq.4) then
44               ll1=len_frag(i,1)/2
45             else
46               ll1=len_frag(i,1) 
47             endif
48             if (istruct(j).eq.2 .or. istruct(j).eq.4) then
49               ll2=len_frag(j,1)/2
50             else
51               ll2=len_frag(j,1) 
52             endif
53             len_cut=max0(min0(ll1*4/5,ll2)*4/5,3)
54           endif
55           write (iout,*) "Fragments",i,j," structure",istruct(i),
56      &       istruct(j)," # contacts",
57      &       ncont_frag_ref(ind),nsccont_frag_ref(ind),
58      &       " lengths",len_frag(i,1),len_frag(j,1),
59      &       " ll1",ll1," ll2",ll2," len_cut",len_cut
60           if ((istruct(i).eq.1 .or. istruct(j).eq.1) .and.
61      &      nsccont_frag_ref(ind).ge.len_cut ) then
62             if (istruct(i).eq.1 .and. istruct(j).eq.1) then
63               write (iout,*) "Adding pair of helices",i,j,
64      &        " based on SC contacts"
65             else
66               write (iout,*) "Adding helix+strand/sheet pair",i,j,
67      &        " based on SC contacts"
68             endif
69             nfrag(2)=nfrag(2)+1
70             if (icont_pair.gt.0) then
71               write (iout,*)  "# SC contacts will be used",
72      &        " in comparison."
73               isccont(nfrag(2),2)=1
74             endif
75             if (irms_pair.gt.0) then
76               write (iout,*)  "Fragment RMSD will be used",
77      &        " in comparison."
78               irms(nfrag(2),2)=1
79             endif
80             npiece(nfrag(2),2)=2
81             ipiece(1,nfrag(2),2)=i
82             ipiece(2,nfrag(2),2)=j
83             ielecont(nfrag(2),2)=0
84             n_shift(1,nfrag(2),2)=nshift_pair
85             n_shift(2,nfrag(2),2)=nshift_pair
86             nc_fragm(nfrag(2),2)=ncfrac_pair
87             nc_req_setf(nfrag(2),2)=ncreq_pair
88           else if ((istruct(i).ge.2 .and. istruct(i).le.4)
89      &       .and. (istruct(j).ge.2 .and. istruct(i).le.4)
90      &       .and. ncont_frag_ref(ind).ge.len_cut ) then
91             nfrag(2)=nfrag(2)+1
92             write (iout,*) "Adding pair strands/sheets",i,j,
93      &        " based on pp contacts"
94             if (icont_pair.gt.0) then
95               write (iout,*) "# pp contacts will be used",
96      &        " in comparison."
97               ielecont(nfrag(2),2)=1
98             endif
99             if (irms_pair.gt.0) then
100               write (iout,*)  "Fragment RMSD will be used",
101      &        " in comparison."
102               irms(nfrag(2),2)=1
103             endif
104             npiece(nfrag(2),2)=2
105             ipiece(1,nfrag(2),2)=i
106             ipiece(2,nfrag(2),2)=j
107             ielecont(nfrag(2),2)=1
108             isccont(nfrag(2),2)=0
109             n_shift(1,nfrag(2),2)=nshift_pair
110             n_shift(2,nfrag(2),2)=nshift_pair
111             nc_fragm(nfrag(2),2)=ncfrac_bet
112             nc_req_setf(nfrag(2),2)=ncreq_bet
113           endif
114         enddo
115       enddo
116       write (iout,*) "Pairs found"
117       do i=1,nfrag(2)
118         write (iout,*) ipiece(1,i,2),ipiece(2,i,2)
119       enddo
120       return
121       end