--- /dev/null
+ subroutine contacts_between_fragments(lprint,is,ncont,icont,
+ & ncont_interfrag,icont_interfrag)
+ include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
+ include 'DIMENSIONS.COMPAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.COMPAR'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.CHAIN'
+ include 'COMMON.NAMES'
+ integer icont(2,maxcont),ncont_interfrag(mmaxfrag),
+ & icont_interfrag(2,maxcont,mmaxfrag)
+ logical OK1,OK2,lprint
+c Determine the contacts that occur within a fragment and between fragments.
+ do i=1,nfrag(1)
+ do j=1,i
+ ind = icant(i,j)
+ nc=0
+c write (iout,*) "i",i,(ifrag(1,k,i),ifrag(2,k,i)
+c & ,k=1,npiece(i,1))
+c write (iout,*) "j",j,(ifrag(1,k,j),ifrag(2,k,j)
+c & ,k=1,npiece(j,1))
+c write (iout,*) "ncont",ncont
+ do k=1,ncont
+ ic1=icont(1,k)
+ ic2=icont(2,k)
+ OK1=.false.
+ l=0
+ do while (.not.OK1 .and. l.lt.npiece(j,1))
+ l=l+1
+ OK1=ic1.ge.ifrag(1,l,j)-is .and.
+ & ic1.le.ifrag(2,l,j)+is
+ enddo
+ OK2=.false.
+ l=0
+ do while (.not.OK2 .and. l.lt.npiece(i,1))
+ l=l+1
+ OK2=ic2.ge.ifrag(1,l,i)-is .and.
+ & ic2.le.ifrag(2,l,i)+is
+ enddo
+c write(iout,*) "k",k," ic1",ic1," ic2",ic2," OK1",OK1,
+c & " OK2",OK2
+ if (OK1.and.OK2) then
+ nc=nc+1
+ icont_interfrag(1,nc,ind)=ic1
+ icont_interfrag(2,nc,ind)=ic2
+c write (iout,*) "nc",nc," ic1",ic1," ic2",ic2
+ endif
+ enddo
+ ncont_interfrag(ind)=nc
+c do k=1,ncont_interfrag(ind)
+c i1=icont_interfrag(1,k,ind)
+c i2=icont_interfrag(2,k,ind)
+c it1=itype(i1)
+c it2=itype(i2)
+c write (iout,'(i3,2x,a,i4,2x,a,i4)')
+c & i,restyp(it1),i1,restyp(it2),i2
+c enddo
+ enddo
+ enddo
+ if (lprint) then
+ write (iout,*) "Contacts within fragments:"
+ do i=1,nfrag(1)
+ write (iout,*) "Fragment",i," (",(ifrag(1,k,i),
+ & ifrag(2,k,i),k=1,npiece(i,1)),")"
+ ind=icant(i,i)
+ do k=1,ncont_interfrag(ind)
+ i1=icont_interfrag(1,k,ind)
+ i2=icont_interfrag(2,k,ind)
+ it1=itype(i1)
+ it2=itype(i2)
+ write (iout,'(i3,2x,a,i4,2x,a,i4)')
+ & i,restyp(it1),i1,restyp(it2),i2
+ enddo
+ enddo
+ write (iout,*)
+ write (iout,*) "Contacts between fragments:"
+ do i=1,nfrag(1)
+ do j=1,i-1
+ ind = icant(i,j)
+ write (iout,*) "Fragments",i," (",(ifrag(1,k,i),
+ & ifrag(2,k,i),k=1,npiece(i,1)),") and",j," (",
+ & (ifrag(1,k,j),ifrag(2,k,j),k=1,npiece(j,1)),")"
+ write (iout,*) "Number of contacts",
+ & ncont_interfrag(ind)
+ ind=icant(i,j)
+ do k=1,ncont_interfrag(ind)
+ i1=icont_interfrag(1,k,ind)
+ i2=icont_interfrag(2,k,ind)
+ it1=itype(i1)
+ it2=itype(i2)
+ write (iout,'(i3,2x,a,i4,2x,a,i4)')
+ & i,restyp(it1),i1,restyp(it2),i2
+ enddo
+ enddo
+ enddo
+ endif
+ return
+ end