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