source/maxlik/src-Fmatch/contact.f

   1       subroutine contact(lprint,ncont,icont,ist,ien)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'COMMON.CONTROL'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.CHAIN'
   8       include 'COMMON.INTERACT'
   9       include 'COMMON.FFIELD'
  10       include 'COMMON.NAMES'
  11       include 'COMMON.CALC'
  12       include 'COMMON.CONTPAR'
  13       include 'COMMON.LOCAL'
  14       real*8 cscore(maxcont),omt1(maxcont),omt2(maxcont),omt12(maxcont),
  15      & ddsc(maxcont),ddla(maxcont),ddlb(maxcont)
  16       integer ncont,icont(2,maxcont)
  17       real*8 u,v,a(3),b(3),dla,dlb
  18       logical lprint
  19       ncont=0
  20       kkk=3
  21       if (lprint) then
  22       do i=1,nres
  23         write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i),
  24      &    c(3,i),dc(1,nres+i),dc(2,nres+i),dc(3,nres+i),
  25      &    dc_norm(1,nres+i),dc_norm(2,nres+i),dc_norm(3,nres+i)
  26       enddo
  27       endif
  28   110 format (a,'(',i3,')',9f8.3)
  29       do i=ist,ien-kkk
  30         iti=itype(i)
  31         do j=i+kkk,ien
  32           itj=itype(j)
  33           itypi=iti
  34           itypj=itj
  35           xj = c(1,nres+j)-c(1,nres+i)
  36           yj = c(2,nres+j)-c(2,nres+i)
  37           zj = c(3,nres+j)-c(3,nres+i)
  38           dxi = dc_norm(1,nres+i)
  39           dyi = dc_norm(2,nres+i)
  40           dzi = dc_norm(3,nres+i)
  41           dxj = dc_norm(1,nres+j)
  42           dyj = dc_norm(2,nres+j)
  43           dzj = dc_norm(3,nres+j)
  44           do k=1,3
  45             a(k)=dc(k,nres+i)
  46             b(k)=dc(k,nres+j)
  47           enddo
  48 c          write (iout,*) (a(k),k=1,3),(b(k),k=1,3)
  49           if (icomparfunc.eq.1) then
  50             call contfunc(csc,iti,itj)
  51           else if (icomparfunc.eq.2) then
  52             call scdist(csc,iti,itj)
  53           else if (icomparfunc.eq.3 .or. icomparfunc.eq.5) then
  54             csc = dist(nres+i,nres+j)
  55           else if (icomparfunc.eq.4) then
  56             call odlodc(c(1,i),c(1,j),a,b,u,v,dla,dlb,csc)
  57           else
  58             write (*,*) "Error - Unknown sidechain contact function"
  59             write (iout,*) "Error - Unknown sidechain contact function"
  60           endif
  61           if (csc.lt.sc_cutoff(iti,itj)) then
  62 c            write(iout,*) "i",i," j",j," dla",dla,dsc(iti),
  63 c     &      " dlb",dlb,dsc(itj)," csc",csc,sc_cutoff(iti,itj),
  64 c     &      dxi,dyi,dzi,dxi**2+dyi**2+dzi**2,
  65 c     &      dxj,dyj,dzj,dxj**2+dyj**2+dzj**2,om1,om2,om12,
  66 c     &      xj,yj,zj
  67 c            write(iout,*)'egb',itypi,itypj,chi1,chi2,chip1,chip2,
  68 c     &       sig0ij,rij,rrij,om1,om2,om12,chiom1,chiom2,chiom12,
  69 c     &       chipom1,chipom2,chipom12,sig,eps2rt,rij_shift,e2,evdw,
  70 c     &       csc
  71             ncont=ncont+1
  72             cscore(ncont)=csc
  73             icont(1,ncont)=i
  74             icont(2,ncont)=j
  75             omt1(ncont)=om1
  76             omt2(ncont)=om2
  77             omt12(ncont)=om12
  78             ddsc(ncont)=1.0d0/rij
  79             ddla(ncont)=dla
  80             ddlb(ncont)=dlb
  81           endif
  82         enddo
  83       enddo
  84       if (lprint) then
  85         write (iout,'(a)') 'Contact map:'
  86         do i=1,ncont
  87           i1=icont(1,i)
  88           i2=icont(2,i)
  89           it1=itype(i1)
  90           it2=itype(i2)
  91           write (iout,'(i3,2x,a,i4,2x,a,i4,5f8.3,3f10.5)')
  92      &     i,restyp(it1),i1,restyp(it2),i2,cscore(i),
  93      &     sc_cutoff(it1,it2),ddsc(i),ddla(i),ddlb(i),
  94      &     omt1(i),omt2(i),omt12(i)
  95         enddo
  96       endif
  97       return
  98       end
  99 c----------------------------------------------------------------------------
 100       double precision function contact_fract(ncont,ncont_ref,
 101      &                                     icont,icont_ref)
 102       include 'DIMENSIONS'
 103       include 'COMMON.IOUNITS'
 104       integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont)
 105       nmatch=0
 106 c     print *,'ncont=',ncont,' ncont_ref=',ncont_ref
 107 c     write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
 108 c     write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
 109 c     write (iout,'(20i4)') (icont(1,i),i=1,ncont)
 110 c     write (iout,'(20i4)') (icont(2,i),i=1,ncont)
 111       do i=1,ncont
 112         do j=1,ncont_ref
 113           if (icont(1,i).eq.icont_ref(1,j) .and.
 114      &        icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
 115         enddo
 116       enddo
 117 c     print *,' nmatch=',nmatch
 118 c     contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
 119       contact_fract=dfloat(nmatch)/dfloat(ncont_ref)
 120       return
 121       end
 122 c------------------------------------------------------------------------------
 123       subroutine pept_cont(lprint,ncont,icont)
 124       implicit none
 125       include 'DIMENSIONS'
 126       include 'DIMENSIONS.ZSCOPT'
 127       include 'COMMON.IOUNITS'
 128       include 'COMMON.CHAIN'
 129       include 'COMMON.INTERACT'
 130       include 'COMMON.FFIELD'
 131       include 'COMMON.NAMES'
 132       integer ncont,icont(2,maxcont)
 133       integer i,j,k,i1,i2,it1,it2,kkk
 134       double precision dist
 135       logical lprint
 136       real*8 rcomp /5.5d0/
 137       ncont=0
 138       kkk=0
 139       print *,'Entering pept_cont: nnt=',nnt,' nct=',nct
 140       do i=nnt,nct-3
 141         do k=1,3
 142           c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1))
 143         enddo
 144         do j=i+2,nct-1
 145           do k=1,3
 146             c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1))
 147           enddo
 148           if (dist(2*nres+1,2*nres+2).lt.rcomp) then
 149             ncont=ncont+1
 150             icont(1,ncont)=i
 151             icont(2,ncont)=j
 152           endif
 153         enddo
 154       enddo
 155       if (lprint) then
 156         write (iout,'(a)') 'PP contact map:'
 157         do i=1,ncont
 158           i1=icont(1,i)
 159           i2=icont(2,i)
 160           it1=itype(i1)
 161           it2=itype(i2)
 162           write (iout,'(i3,2x,a,i4,2x,a,i4)')
 163      &     i,restyp(it1),i1,restyp(it2),i2
 164         enddo
 165       endif
 166       return
 167       end