subroutine contact(lprint,ncont,icont,ist,ien)
      implicit none
      include 'DIMENSIONS'
      include 'DIMENSIONS.ZSCOPT'
      include 'COMMON.CONTROL'
      include 'COMMON.IOUNITS'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.FFIELD'
      include 'COMMON.NAMES'
      include 'COMMON.CALC'
      include 'COMMON.CONTPAR'
      include 'COMMON.LOCAL'
      integer ist,ien,kkk,iti,itj,itypi,itypj,i1,i2,it1,it2
      real*8 csc,dist
      real*8 cscore(maxcont),omt1(maxcont),omt2(maxcont),omt12(maxcont),
     & ddsc(maxcont),ddla(maxcont),ddlb(maxcont)
      integer ncont,icont(2,maxcont)
      real*8 u,v,a(3),b(3),dla,dlb
      logical lprint
      ncont=0
      kkk=3
      if (lprint) then
      do i=1,nres
        write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i),
     &    c(3,i),dc(1,nres+i),dc(2,nres+i),dc(3,nres+i),
     &    dc_norm(1,nres+i),dc_norm(2,nres+i),dc_norm(3,nres+i)
      enddo
      endif
  110 format (a,'(',i3,')',9f8.3)
      do i=ist,ien-kkk
        iti=itype(i)
        if (iti.le.0 .or. iti.gt.ntyp) cycle
        do j=i+kkk,ien
          itj=itype(j)
          if (itj.le.0 .or. itj.gt.ntyp) cycle
          itypi=iti
          itypj=itj
          xj = c(1,nres+j)-c(1,nres+i)    
          yj = c(2,nres+j)-c(2,nres+i)    
          zj = c(3,nres+j)-c(3,nres+i)    
          dxi = dc_norm(1,nres+i)
          dyi = dc_norm(2,nres+i)
          dzi = dc_norm(3,nres+i)
          dxj = dc_norm(1,nres+j)
          dyj = dc_norm(2,nres+j)
          dzj = dc_norm(3,nres+j)
          do k=1,3
            a(k)=dc(k,nres+i)
            b(k)=dc(k,nres+j)
          enddo
c          write (iout,*) (a(k),k=1,3),(b(k),k=1,3)
          if (icomparfunc.eq.1) then
            call contfunc(csc,iti,itj)
          else if (icomparfunc.eq.2) then
            call scdist(csc,iti,itj)
          else if (icomparfunc.eq.3 .or. icomparfunc.eq.5) then
            csc = dist(nres+i,nres+j)
          else if (icomparfunc.eq.4) then
            call odlodc(c(1,i),c(1,j),a,b,u,v,dla,dlb,csc)
          else
            write (*,*) "Error - Unknown sidechain contact function"
            write (iout,*) "Error - Unknown sidechain contact function"
          endif
          if (csc.lt.sc_cutoff(iti,itj)) then
c            write(iout,*) "i",i," j",j," dla",dla,dsc(iti),
c     &      " dlb",dlb,dsc(itj)," csc",csc,sc_cutoff(iti,itj),
c     &      dxi,dyi,dzi,dxi**2+dyi**2+dzi**2,
c     &      dxj,dyj,dzj,dxj**2+dyj**2+dzj**2,om1,om2,om12,
c     &      xj,yj,zj
c            write(iout,*)'egb',itypi,itypj,chi1,chi2,chip1,chip2,
c     &       sig0ij,rij,rrij,om1,om2,om12,chiom1,chiom2,chiom12,
c     &       chipom1,chipom2,chipom12,sig,eps2rt,rij_shift,e2,evdw,
c     &       csc
            ncont=ncont+1
            cscore(ncont)=csc
            icont(1,ncont)=i
            icont(2,ncont)=j
            omt1(ncont)=om1
            omt2(ncont)=om2
            omt12(ncont)=om12
            ddsc(ncont)=1.0d0/rij
            ddla(ncont)=dla
            ddlb(ncont)=dlb
          endif
        enddo
      enddo
      if (lprint) then
        write (iout,'(a)') 'Contact map:'
        do i=1,ncont
          i1=icont(1,i)
          i2=icont(2,i)
          it1=itype(i1)
          it2=itype(i2)
          write (iout,'(i3,2x,a,i4,2x,a,i4,5f8.3,3f10.5)') 
     &     i,restyp(it1),i1,restyp(it2),i2,cscore(i),
     &     sc_cutoff(it1,it2),ddsc(i),ddla(i),ddlb(i),
     &     omt1(i),omt2(i),omt12(i)
        enddo
      endif
      return
      end
c----------------------------------------------------------------------------
      double precision function contact_fract(ncont,ncont_ref,
     &                                     icont,icont_ref)
      implicit none
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      integer i,j,nmatch
      integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont)
      nmatch=0
c     print *,'ncont=',ncont,' ncont_ref=',ncont_ref 
c     write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
c     write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
c     write (iout,'(20i4)') (icont(1,i),i=1,ncont)
c     write (iout,'(20i4)') (icont(2,i),i=1,ncont)
      do i=1,ncont
        do j=1,ncont_ref
          if (icont(1,i).eq.icont_ref(1,j) .and. 
     &        icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
        enddo
      enddo
c     print *,' nmatch=',nmatch
c     contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
      contact_fract=dfloat(nmatch)/dfloat(ncont_ref)
      return
      end
c------------------------------------------------------------------------------
      subroutine pept_cont(lprint,ncont,icont)
      implicit none
      include 'DIMENSIONS'
      include 'DIMENSIONS.ZSCOPT'
      include 'COMMON.IOUNITS'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.FFIELD'
      include 'COMMON.NAMES'
      integer ncont,icont(2,maxcont)
      integer i,j,k,kkk,i1,i2,it1,it2
      logical lprint
      real*8 dist
      real*8 rcomp /5.5d0/
      ncont=0
      kkk=0
      print *,'Entering pept_cont: nnt=',nnt,' nct=',nct
      do i=nnt,nct-3
        do k=1,3
          c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1))
        enddo
        do j=i+2,nct-1
          do k=1,3
            c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1))
          enddo
          if (dist(2*nres+1,2*nres+2).lt.rcomp) then
            ncont=ncont+1
            icont(1,ncont)=i
            icont(2,ncont)=j
          endif
        enddo
      enddo
      if (lprint) then
        write (iout,'(a)') 'PP contact map:'
        do i=1,ncont
          i1=icont(1,i)
          i2=icont(2,i)
          it1=itype(i1)
          it2=itype(i2)
          write (iout,'(i3,2x,a,i4,2x,a,i4)')
     &     i,restyp(it1),i1,restyp(it2),i2
        enddo
      endif
      return
      end