subroutine contact(lprint,ncont,icont,co)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.FFIELD'
      include 'COMMON.NAMES'
      real*8 facont /1.569D0/  ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
      integer ncont,icont(2,maxcont)
      logical lprint
      ncont=0
      kkk=3
      do i=nnt+kkk,nct
        iti=itype(i)
        do j=nnt,i-kkk
          itj=itype(j)
          if (ipot.ne.4) then
c           rcomp=sigmaii(iti,itj)+1.0D0
            rcomp=facont*sigmaii(iti,itj)
          else 
c           rcomp=sigma(iti,itj)+1.0D0
            rcomp=facont*sigma(iti,itj)
          endif
c         rcomp=6.5D0
c         print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j)
	  if (dist(nres+i,nres+j).lt.rcomp) then
            ncont=ncont+1
            icont(1,ncont)=i
            icont(2,ncont)=j
          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)') 
     &     i,restyp(it1),i1,restyp(it2),i2 
        enddo
      endif
      co = 0.0d0
      do i=1,ncont
        co = co + dfloat(iabs(icont(1,i)-icont(2,i)))
      enddo 
      co = co / (nres*ncont)
      return
      end
c----------------------------------------------------------------------------
      double precision function contact_fract(ncont,ncont_ref,
     &                                     icont,icont_ref)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      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----------------------------------------------------------------------------
      double precision function contact_fract_nn(ncont,ncont_ref,
     &                                     icont,icont_ref)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      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_nn=dfloat(ncont-nmatch)/dfloat(ncont)
      return
      end
c----------------------------------------------------------------------------
      subroutine hairpin(lprint,nharp,iharp)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.FFIELD'
      include 'COMMON.NAMES'
      integer ncont,icont(2,maxcont)
      integer nharp,iharp(4,maxres/3)
      logical lprint,not_done
      real*8 rcomp /6.0d0/ 
      ncont=0
      kkk=0
c     print *,'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
c finding hairpins
      nharp=0
      do i=1,ncont
        i1=icont(1,i)
        j1=icont(2,i)
        if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then
c          write (iout,*) "found turn at ",i1,j1
          ii1=i1
          jj1=j1
          not_done=.true.
          do while (not_done)
            i1=i1-1
            j1=j1+1
            do j=1,ncont
              if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
            enddo
            not_done=.false.
  10        continue
c            write (iout,*) i1,j1,not_done  
          enddo
          i1=i1+1
          j1=j1-1
          if (j1-i1.gt.4) then
            nharp=nharp+1
            iharp(1,nharp)=i1
            iharp(2,nharp)=j1
            iharp(3,nharp)=ii1
            iharp(4,nharp)=jj1 
c            write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4)
          endif
        endif
      enddo
c      do i=1,nharp
c            write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4)
c      enddo
      if (lprint) then
      write (iout,*) "Hairpins:"
      do i=1,nharp
        i1=iharp(1,i)
        j1=iharp(2,i)
        ii1=iharp(3,i)
        jj1=iharp(4,i)
        write (iout,*)
        write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1)
        write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1)
c        do k=jj1,j1,-1
c         write (iout,'(a,i3,$)') restyp(itype(k)),k
c        enddo
      enddo
      endif
      return
      end
c----------------------------------------------------------------------------