source/maxlik/src-Fmatch/cont_frag1.f

   1       subroutine contacts_in_fragments(lprint,is,ncont,icont,ncont_frag,
   2      &   icont_frag,ib,iprot)
   3       implicit none
   4       include 'DIMENSIONS'
   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_frag(maxfrag),
  12      &  icont_frag(2,maxcont,maxfrag)
  13       logical OK1,OK2,lprint
  14       do j=1,nfrag(1,iprot)
  15         nc=0
  16 c        write (iout,*) "i",1," j",j,(ifrag(1,k,j,ib,iprot),
  17 c     &      ifrag(2,k,j,ib,iprot)
  18 c     &      ,k=1,npiece(j,1,ib,iprot))
  19         do k=1,ncont
  20           ic1=icont(1,k)
  21           ic2=icont(2,k)
  22           OK1=.false.
  23           l=0
  24           do while (.not.OK1 .and. l.lt.npiece(j,1,ib,iprot))
  25             l=l+1
  26             OK1=ic1.ge.ifrag(1,l,j,ib,iprot)-is .and.
  27      &       ic1.le.ifrag(2,l,j,ib,iprot)+is
  28           enddo
  29           OK2=.false.
  30           l=0
  31           do while (.not.OK2 .and. l.lt.npiece(j,1,ib,iprot))
  32             l=l+1
  33             OK2=ic2.ge.ifrag(1,l,j,ib,iprot)-is .and.
  34      &       ic2.le.ifrag(2,l,j,ib,iprot)+is
  35           enddo
  36 c          write(iout,*) "k",k," ic1",ic1," ic2",ic2," OK1",OK1,
  37 c     &      " OK2",OK2
  38           if (OK1.and.OK2) then
  39             nc=nc+1
  40             icont_frag(1,nc,j)=ic1
  41             icont_frag(2,nc,j)=ic2
  42 c            write (iout,*) "nc",nc," ic1",ic1," ic2",ic2
  43           endif
  44         enddo
  45         ncont_frag(j)=nc
  46 c        do k=1,ncont_frag(j)
  47 c            i1=icont_frag(1,k,j)
  48 c            i2=icont_frag(2,k,j)
  49 c            it1=itype(i1)
  50 c            it2=itype(i2)
  51 c            write (iout,'(i3,2x,a,i4,2x,a,i4)')
  52 c     &        i,restyp(it1),i1,restyp(it2),i2
  53 c        enddo
  54       enddo
  55       if (lprint) then
  56         write (iout,*) "Electrostatic contacts in fragments:"
  57           write (iout,*) "Level 1"
  58         do j=1,nfrag(1,ib,iprot)
  59           write (iout,*) "Fragment",j,"(",(ifrag(1,k,j,ib,iprot),
  60      &     ifrag(2,k,j,ib,iprot),k=1,npiece(j,1,ib,iprot)),")"
  61           write (iout,*) "Number of contacts",ncont_frag(j)
  62           do k=1,ncont_frag(j)
  63             i1=icont_frag(1,k,j)
  64             i2=icont_frag(2,k,j)
  65             it1=itype(i1)
  66             it2=itype(i2)
  67             write (iout,'(i3,2x,a,i4,2x,a,i4)')
  68      &        i,restyp(it1),i1,restyp(it2),i2
  69           enddo
  70         enddo
  71       endif
  72       return
  73       end