Rozgrzebany SCCOR dla wham-M
[unres.git] / source / wham / src-M / cont_frag.f
1       subroutine contacts_between_fragments(lprint,is,ncont,icont,
2      &   ncont_interfrag,icont_interfrag)
3       include 'DIMENSIONS'
4       include 'DIMENSIONS.ZSCOPT'
5       include 'DIMENSIONS.COMPAR'
6       include 'COMMON.INTERACT'
7       include 'COMMON.COMPAR'
8       include 'COMMON.IOUNITS'
9       include 'COMMON.CHAIN'
10       include 'COMMON.NAMES'
11       integer icont(2,maxcont),ncont_interfrag(mmaxfrag),
12      &  icont_interfrag(2,maxcont,mmaxfrag)
13       logical OK1,OK2,lprint
14 c Determine the contacts that occur within a fragment and between fragments.
15       do i=1,nfrag(1)
16         do j=1,i
17           ind = icant(i,j)
18           nc=0
19 c          write (iout,*) "i",i,(ifrag(1,k,i),ifrag(2,k,i)
20 c     &      ,k=1,npiece(i,1))
21 c          write (iout,*) "j",j,(ifrag(1,k,j),ifrag(2,k,j)
22 c     &      ,k=1,npiece(j,1))
23 c          write (iout,*) "ncont",ncont
24           do k=1,ncont
25             ic1=icont(1,k)
26             ic2=icont(2,k)
27             OK1=.false.
28             l=0
29             do while (.not.OK1 .and. l.lt.npiece(j,1)) 
30               l=l+1
31               OK1=ic1.ge.ifrag(1,l,j)-is .and. 
32      &         ic1.le.ifrag(2,l,j)+is
33             enddo
34             OK2=.false.
35             l=0
36             do while (.not.OK2 .and. l.lt.npiece(i,1)) 
37               l=l+1
38               OK2=ic2.ge.ifrag(1,l,i)-is .and. 
39      &         ic2.le.ifrag(2,l,i)+is
40             enddo 
41 c            write(iout,*) "k",k," ic1",ic1," ic2",ic2," OK1",OK1,
42 c     &        " OK2",OK2
43             if (OK1.and.OK2) then
44               nc=nc+1
45               icont_interfrag(1,nc,ind)=ic1 
46               icont_interfrag(2,nc,ind)=ic2 
47 c              write (iout,*) "nc",nc," ic1",ic1," ic2",ic2
48             endif
49           enddo
50           ncont_interfrag(ind)=nc
51 c          do k=1,ncont_interfrag(ind)
52 c              i1=icont_interfrag(1,k,ind)
53 c              i2=icont_interfrag(2,k,ind)
54 c              it1=itype(i1)
55 c              it2=itype(i2)
56 c              write (iout,'(i3,2x,a,i4,2x,a,i4)')
57 c     &          i,restyp(it1),i1,restyp(it2),i2
58 c          enddo
59         enddo
60       enddo
61       if (lprint) then
62         write (iout,*) "Contacts within fragments:"
63         do i=1,nfrag(1)
64           write (iout,*) "Fragment",i," (",(ifrag(1,k,i),
65      &     ifrag(2,k,i),k=1,npiece(i,1)),")"
66           ind=icant(i,i)
67           do k=1,ncont_interfrag(ind)
68             i1=icont_interfrag(1,k,ind)
69             i2=icont_interfrag(2,k,ind)
70             it1=itype(i1)
71             it2=itype(i2)
72             write (iout,'(i3,2x,a,i4,2x,a,i4)')
73      &        i,restyp(it1),i1,restyp(it2),i2
74           enddo
75         enddo
76         write (iout,*)
77         write (iout,*) "Contacts between fragments:"
78         do i=1,nfrag(1)
79         do j=1,i-1
80           ind = icant(i,j)
81           write (iout,*) "Fragments",i," (",(ifrag(1,k,i),
82      &     ifrag(2,k,i),k=1,npiece(i,1)),") and",j," (",
83      &     (ifrag(1,k,j),ifrag(2,k,j),k=1,npiece(j,1)),")"
84           write (iout,*) "Number of contacts",
85      &     ncont_interfrag(ind)
86           ind=icant(i,j)
87           do k=1,ncont_interfrag(ind)
88             i1=icont_interfrag(1,k,ind)
89             i2=icont_interfrag(2,k,ind)
90             it1=itype(i1)
91             it2=itype(i2)
92             write (iout,'(i3,2x,a,i4,2x,a,i4)')
93      &        i,restyp(it1),i1,restyp(it2),i2
94           enddo
95         enddo
96         enddo
97       endif
98       return
99       end