source/maxlik/src_MD_T_maxlik-NEWCORR-PMF-PDB/define_pairs.F

   1       subroutine define_pairs(iprot)
   2       implicit none
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'DIMENSIONS.COMPAR'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.TIME1'
   8       include 'COMMON.SBRIDGE'
   9       include 'COMMON.COMPAR'
  10       include 'COMMON.FRAG'
  11       include 'COMMON.CHAIN'
  12       include 'COMMON.HEADER'
  13       include 'COMMON.GEO'
  14       include 'COMMON.CONTACTS1'
  15       include 'COMMON.PEPTCONT'
  16       include 'COMMON.CLASSES'
  17       integer i,j,k,ind,ll1,ll2,len_cut,length_frag,ib,iprot,icant
  18 #ifdef DEBUG
  19       write (iout,*) "define_pairs: iprot",iprot," nfrag",nfrag(1,iprot)
  20 #endif
  21       do ib=1,nclass(iprot)-1
  22       do j=1,nfrag(1,iprot)
  23         length_frag = 0
  24         do k=1,npiece(j,1,ib,iprot)
  25           length_frag=length_frag+ifrag(2,k,j,ib,iprot)
  26      &      -ifrag(1,k,j,ib,iprot)+1
  27         enddo
  28         len_frag(j,1,ib,iprot)=length_frag
  29 #ifdef DEBUG
  30         write (iout,*) "Batch",ib," fragment",j,
  31      &    " length",len_frag(j,1,ib,iprot)
  32 #endif
  33       enddo
  34       enddo
  35       nfrag(2,iprot)=0
  36       do i=1,nfrag(1,iprot)
  37         do j=i+1,nfrag(1,iprot)
  38           ind = icant(i,j)
  39           if (istruct(i,1,iprot).le.1 .or. istruct(j,1,iprot).le.1)
  40      &    then
  41             if (istruct(i,1,iprot).le.1) then
  42               ll1=len_frag(i,1,1,iprot)
  43             else
  44               ll1=len_frag(i,1,1,iprot)/2
  45             endif
  46             if (istruct(j,1,iprot).le.1) then
  47               ll2=len_frag(j,1,1,iprot)
  48             else
  49               ll2=len_frag(j,1,1,iprot)/2
  50             endif
  51             len_cut=max0(min0(ll1*2/3,ll2*4/5),3)
  52           else
  53             if (istruct(i,1,iprot).eq.2.or.istruct(i,1,iprot).eq.4)
  54      &      then
  55               ll1=len_frag(i,1,1,iprot)/2
  56             else
  57               ll1=len_frag(i,1,1,iprot)
  58             endif
  59             if (istruct(j,1,iprot).eq.2 .or. istruct(j,1,iprot).eq.4)
  60      &      then
  61               ll2=len_frag(j,1,1,iprot)/2
  62             else
  63               ll2=len_frag(j,1,1,iprot)
  64             endif
  65             len_cut=max0(min0(ll1*4/5,ll2)*4/5,3)
  66           endif
  67 #ifdef DEBUG
  68           write (iout,*) "Fragments",i,j," structure",
  69      &       istruct(i,1,iprot),
  70      &       istruct(j,1,iprot)," # contacts",
  71      &       ncont_frag_ref(ind,1,iprot),
  72      &       nsccont_frag_ref(ind,1,iprot),
  73      &       " lengths",len_frag(i,1,1,iprot),len_frag(j,1,1,iprot),
  74      &       " ll1",ll1," ll2",ll2," len_cut",len_cut
  75 #endif
  76           if ((istruct(i,1,iprot).eq.1 .or. istruct(j,1,iprot).eq.1)
  77      &        .and.nsccont_frag_ref(ind,1,iprot).ge.len_cut) then
  78             if(istruct(i,1,iprot).eq.1 .and. istruct(j,1,iprot).eq.1)
  79      &      then
  80               write (iout,*) "Adding pair of helices",i,j,
  81      &        " based on SC contacts"
  82             else
  83               write (iout,*) "Adding helix+strand/sheet pair",i,j,
  84      &        " based on SC contacts"
  85             endif
  86             nfrag(2,iprot)=nfrag(2,iprot)+1
  87             do ib=1,nclass(iprot)-1
  88 #ifdef DEBUG
  89             write (iout,*) "Batch",ib
  90 #endif
  91             if (icont_pair(ib).gt.0 .and. icontp_pair(ib).eq.0) then
  92 #ifdef DEBUG
  93               write (iout,*)  "# SC contacts will be used",
  94      &        " in comparison."
  95 #endif
  96               isccont(nfrag(2,iprot),2,ib,iprot)=1
  97               ielecont(nfrag(2,iprot),2,ib,iprot)=0
  98             else if (icontp_pair(ib).gt.0) then
  99 #ifdef DEBUG
 100               write (iout,*)  "# pp contacts will be used",
 101      &        " in comparison."
 102 #endif
 103               ielecont(nfrag(2,iprot),2,ib,iprot)=1
 104               isccont(nfrag(2,iprot),2,ib,iprot)=0
 105             else
 106               ielecont(nfrag(2,iprot),2,ib,iprot)=0
 107               isccont(nfrag(2,iprot),2,ib,iprot)=0
 108             endif
 109             if (irms_pair(ib).gt.0) then
 110 #ifdef DEBUG
 111               write (iout,*)  "Fragment RMSD will be used",
 112      &        " in comparison."
 113 #endif
 114               irms(nfrag(2,iprot),2,ib,iprot)=1
 115             endif
 116             if (iqwol_pair(ib).gt.0) then
 117 #ifdef DEBUG
 118               write (iout,*)  "Fragment Q will be used",
 119      &        " in comparison."
 120 #endif
 121               iqwol(nfrag(2,iprot),2,ib,iprot)=1
 122               qcutfrag(nfrag(2,iprot),2,ib,iprot)=qcut_pair(ib)
 123             endif
 124             npiece(nfrag(2,iprot),2,ib,iprot)=2
 125             ipiece(1,nfrag(2,iprot),2,ib,iprot)=i
 126             ipiece(2,nfrag(2,iprot),2,ib,iprot)=j
 127             n_shift(1,nfrag(2,iprot),2,ib,iprot)=nshift_pair(ib)
 128             n_shift(2,nfrag(2,iprot),2,ib,iprot)=nshift_pair(ib)
 129             nc_fragm(nfrag(2,iprot),2,ib,iprot)=ncfrac_pair(ib)
 130             nc_req_setf(nfrag(2,iprot),2,ib,iprot)=ncreq_pair(ib)
 131             enddo
 132           else if ((istruct(i,1,iprot).ge.2
 133      &       .and. istruct(i,1,iprot).le.4)
 134      &       .and. (istruct(j,1,iprot).ge.2
 135      &       .and. istruct(i,1,iprot).le.4)
 136      &       .and. ncont_frag_ref(ind,1,iprot).ge.len_cut ) then
 137             nfrag(2,iprot)=nfrag(2,iprot)+1
 138             write (iout,*) "Adding pair strands/sheets",i,j,
 139      &        " based on pp contacts"
 140             do ib=1,nclass(iprot)-1
 141 #ifdef DEBUG
 142             write (iout,*) "Batch",ib
 143 #endif
 144             if (icont_pair(ib).gt.0 .and. icontsc_pair(ib).eq.0) then
 145 #ifdef DEBUG
 146               write (iout,*) "# pp contacts will be used",
 147      &        " in comparison."
 148 #endif
 149               ielecont(nfrag(2,iprot),2,ib,iprot)=1
 150               isccont(nfrag(2,iprot),2,ib,iprot)=0
 151             else if (icontsc_pair(ib).eq.1) then
 152 #ifdef DEBUG
 153               write (iout,*) "# sc contacts will be used",
 154      &        " in comparison."
 155 #endif
 156               ielecont(nfrag(2,iprot),2,ib,iprot)=0
 157               isccont(nfrag(2,iprot),2,ib,iprot)=1
 158               write (iout,*) nfrag(2,iprot),2,ib,iprot,
 159      &          isccont(nfrag(2,iprot),2,ib,iprot)
 160             else
 161               ielecont(nfrag(2,iprot),2,ib,iprot)=0
 162               isccont(nfrag(2,iprot),2,ib,iprot)=0
 163             endif
 164             if (irms_pair(ib).gt.0) then
 165 #ifdef DEBUG
 166               write (iout,*)  "Fragment RMSD will be used",
 167      &        " in comparison."
 168 #endif
 169               irms(nfrag(2,iprot),2,ib,iprot)=1
 170             else
 171               irms(nfrag(2,iprot),2,ib,iprot)=0
 172             endif
 173             if (iqwol_pair(ib).gt.0) then
 174 #ifdef DEBUG
 175               write (iout,*)  "Fragment Q will be used",
 176      &        " in comparison."
 177 #endif
 178               iqwol(nfrag(2,iprot),2,ib,iprot)=1
 179               qcutfrag(nfrag(2,iprot),2,ib,iprot)=qcut_pair(ib)
 180             endif
 181             npiece(nfrag(2,iprot),2,ib,iprot)=2
 182             ipiece(1,nfrag(2,iprot),2,ib,iprot)=i
 183             ipiece(2,nfrag(2,iprot),2,ib,iprot)=j
 184             n_shift(1,nfrag(2,iprot),2,ib,iprot)=nshift_pair(ib)
 185             n_shift(2,nfrag(2,iprot),2,ib,iprot)=nshift_pair(ib)
 186             nc_fragm(nfrag(2,iprot),2,ib,iprot)=ncfrac_bet(ib)
 187             nc_req_setf(nfrag(2,iprot),2,ib,iprot)=ncreq_bet(ib)
 188             enddo
 189           endif
 190         enddo
 191       enddo
 192 #ifdef DEBUG
 193       write (iout,*) "Pairs found"
 194       do i=1,nfrag(2,iprot)
 195         write (iout,*) ipiece(1,i,2,1,iprot),ipiece(2,i,2,1,iprot)
 196       enddo
 197       write (iout,*) "ielecont"
 198       do ib=1,nclass(iprot)-1
 199         write (iout,*) "structural level",ib
 200         do i=1,iabs(nlevel(iprot))
 201           write (iout,*) "Level",i
 202           write (iout,*) (ielecont(j,i,ib,iprot),j=1,nfrag(i,iprot))
 203         enddo
 204       enddo
 205       write (iout,*) "isccont"
 206       do ib=1,nclass(iprot)-1
 207         write (iout,*) "structural level",ib
 208         do i=1,iabs(nlevel(iprot))
 209           write (iout,*) "Level",i
 210           write (iout,*) (isccont(j,i,ib,iprot),j=1,nfrag(i,iprot))
 211         enddo
 212       enddo
 213 #endif
 214       return
 215       end