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