source/wham/src/define_pairs.f

   1       subroutine define_pairs
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'DIMENSIONS.COMPAR'
   6       include 'DIMENSIONS.FREE'
   7       include 'COMMON.IOUNITS'
   8       include 'COMMON.TIME1'
   9       include 'COMMON.SBRIDGE'
  10       include 'COMMON.CONTROL'
  11       include 'COMMON.COMPAR'
  12       include 'COMMON.FRAG'
  13       include 'COMMON.CHAIN'
  14       include 'COMMON.HEADER'
  15       include 'COMMON.GEO'
  16       include 'COMMON.CONTACTS1'
  17       include 'COMMON.PEPTCONT'
  18       do j=1,nfrag(1)
  19         length_frag = 0
  20         do k=1,npiece(j,1)
  21           length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1
  22         enddo
  23         len_frag(j,1)=length_frag
  24         write (iout,*) "Fragment",j," length",len_frag(j,1)
  25       enddo
  26       nfrag(2)=0
  27       do i=1,nfrag(1)
  28         do j=i+1,nfrag(1)
  29           ind = icant(i,j)
  30           if (istruct(i).le.1 .or. istruct(j).le.1) then
  31             if (istruct(i).le.1) then
  32               ll1=len_frag(i,1)
  33             else
  34               ll1=len_frag(i,1)/2
  35             endif
  36             if (istruct(j).le.1) then
  37               ll2=len_frag(j,1)
  38             else
  39               ll2=len_frag(j,1)/2
  40             endif
  41             len_cut=max0(min0(ll1*2/3,ll2*4/5),3)
  42           else
  43             if (istruct(i).eq.2 .or. istruct(i).eq.4) then
  44               ll1=len_frag(i,1)/2
  45             else
  46               ll1=len_frag(i,1)
  47             endif
  48             if (istruct(j).eq.2 .or. istruct(j).eq.4) then
  49               ll2=len_frag(j,1)/2
  50             else
  51               ll2=len_frag(j,1)
  52             endif
  53             len_cut=max0(min0(ll1*4/5,ll2)*4/5,3)
  54           endif
  55           write (iout,*) "Fragments",i,j," structure",istruct(i),
  56      &       istruct(j)," # contacts",
  57      &       ncont_frag_ref(ind),nsccont_frag_ref(ind),
  58      &       " lengths",len_frag(i,1),len_frag(j,1),
  59      &       " ll1",ll1," ll2",ll2," len_cut",len_cut
  60           if ((istruct(i).eq.1 .or. istruct(j).eq.1) .and.
  61      &      nsccont_frag_ref(ind).ge.len_cut ) then
  62             if (istruct(i).eq.1 .and. istruct(j).eq.1) then
  63               write (iout,*) "Adding pair of helices",i,j,
  64      &        " based on SC contacts"
  65             else
  66               write (iout,*) "Adding helix+strand/sheet pair",i,j,
  67      &        " based on SC contacts"
  68             endif
  69             nfrag(2)=nfrag(2)+1
  70             if (icont_pair.gt.0) then
  71               write (iout,*)  "# SC contacts will be used",
  72      &        " in comparison."
  73               isccont(nfrag(2),2)=1
  74             endif
  75             if (irms_pair.gt.0) then
  76               write (iout,*)  "Fragment RMSD will be used",
  77      &        " in comparison."
  78               irms(nfrag(2),2)=1
  79             endif
  80             npiece(nfrag(2),2)=2
  81             ipiece(1,nfrag(2),2)=i
  82             ipiece(2,nfrag(2),2)=j
  83             ielecont(nfrag(2),2)=0
  84             n_shift(1,nfrag(2),2)=nshift_pair
  85             n_shift(2,nfrag(2),2)=nshift_pair
  86             nc_fragm(nfrag(2),2)=ncfrac_pair
  87             nc_req_setf(nfrag(2),2)=ncreq_pair
  88           else if ((istruct(i).ge.2 .and. istruct(i).le.4)
  89      &       .and. (istruct(j).ge.2 .and. istruct(i).le.4)
  90      &       .and. ncont_frag_ref(ind).ge.len_cut ) then
  91             nfrag(2)=nfrag(2)+1
  92             write (iout,*) "Adding pair strands/sheets",i,j,
  93      &        " based on pp contacts"
  94             if (icont_pair.gt.0) then
  95               write (iout,*) "# pp contacts will be used",
  96      &        " in comparison."
  97               ielecont(nfrag(2),2)=1
  98             endif
  99             if (irms_pair.gt.0) then
 100               write (iout,*)  "Fragment RMSD will be used",
 101      &        " in comparison."
 102               irms(nfrag(2),2)=1
 103             endif
 104             npiece(nfrag(2),2)=2
 105             ipiece(1,nfrag(2),2)=i
 106             ipiece(2,nfrag(2),2)=j
 107             ielecont(nfrag(2),2)=1
 108             isccont(nfrag(2),2)=0
 109             n_shift(1,nfrag(2),2)=nshift_pair
 110             n_shift(2,nfrag(2),2)=nshift_pair
 111             nc_fragm(nfrag(2),2)=ncfrac_bet
 112             nc_req_setf(nfrag(2),2)=ncreq_bet
 113           endif
 114         enddo
 115       enddo
 116       write (iout,*) "Pairs found"
 117       do i=1,nfrag(2)
 118         write (iout,*) ipiece(1,i,2),ipiece(2,i,2)
 119       enddo
 120       return
 121       end