correction for idihconstr_end_homo, no differ in wham now
[unres.git] / source / cluster / wham / src-M / contact.f
1       subroutine contact(lprint,ncont,icont)
2       include 'DIMENSIONS'
3       include 'COMMON.IOUNITS'
4       include 'COMMON.CHAIN'
5       include 'COMMON.INTERACT'
6       include 'COMMON.FFIELD'
7       include 'COMMON.NAMES'
8       real*8 facont /1.569D0/  ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
9       integer ncont,icont(2,maxcont)
10       logical lprint
11       ncont=0
12       kkk=3
13 c     print *,'nnt=',nnt,' nct=',nct
14       do i=nnt+kkk,nct
15         iti=iabs(itype(i))
16         do j=nnt,i-kkk
17           itj=iabs(itype(j))
18           if (ipot.ne.4) then
19 c           rcomp=sigmaii(iti,itj)+1.0D0
20             rcomp=facont*sigmaii(iti,itj)
21           else 
22 c           rcomp=sigma(iti,itj)+1.0D0
23             rcomp=facont*sigma(iti,itj)
24           endif
25 c         rcomp=6.5D0
26 c         print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j)
27           if (dist(nres+i,nres+j).lt.rcomp) then
28             ncont=ncont+1
29             icont(1,ncont)=i
30             icont(2,ncont)=j
31           endif
32         enddo
33       enddo
34       if (lprint) then
35         write (iout,'(a)') 'Contact map:'
36         do i=1,ncont
37           i1=icont(1,i)
38           i2=icont(2,i)
39           it1=itype(i1)
40           it2=itype(i2)
41           write (iout,'(i3,2x,a,i4,2x,a,i4)') 
42      &     i,restyp(it1),i1,restyp(it2),i2 
43         enddo
44       endif
45       return
46       end
47 c----------------------------------------------------------------------------
48       double precision function contact_fract(ncont,ncont_ref,
49      &                                     icont,icont_ref)
50       include 'DIMENSIONS'
51       include 'COMMON.IOUNITS'
52       integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont)
53       nmatch=0
54 c     print *,'ncont=',ncont,' ncont_ref=',ncont_ref 
55 c     write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
56 c     write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
57 c     write (iout,'(20i4)') (icont(1,i),i=1,ncont)
58 c     write (iout,'(20i4)') (icont(2,i),i=1,ncont)
59       do i=1,ncont
60         do j=1,ncont_ref
61           if (icont(1,i).eq.icont_ref(1,j) .and. 
62      &        icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
63         enddo
64       enddo
65 c     print *,' nmatch=',nmatch
66 c     contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
67       contact_fract=dfloat(nmatch)/dfloat(ncont_ref)
68       return
69       end