subroutine define_pairs implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'COMMON.IOUNITS' include 'COMMON.TIME1' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.COMPAR' include 'COMMON.FRAG' include 'COMMON.CHAIN' include 'COMMON.HEADER' include 'COMMON.GEO' include 'COMMON.CONTACTS1' include 'COMMON.PEPTCONT' do j=1,nfrag(1) length_frag = 0 do k=1,npiece(j,1) length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1 enddo len_frag(j,1)=length_frag write (iout,*) "Fragment",j," length",len_frag(j,1) enddo nfrag(2)=0 do i=1,nfrag(1) do j=i+1,nfrag(1) ind = icant(i,j) if (istruct(i).le.1 .or. istruct(j).le.1) then if (istruct(i).le.1) then ll1=len_frag(i,1) else ll1=len_frag(i,1)/2 endif if (istruct(j).le.1) then ll2=len_frag(j,1) else ll2=len_frag(j,1)/2 endif len_cut=max0(min0(ll1*2/3,ll2*4/5),3) else if (istruct(i).eq.2 .or. istruct(i).eq.4) then ll1=len_frag(i,1)/2 else ll1=len_frag(i,1) endif if (istruct(j).eq.2 .or. istruct(j).eq.4) then ll2=len_frag(j,1)/2 else ll2=len_frag(j,1) endif len_cut=max0(min0(ll1*4/5,ll2)*4/5,3) endif write (iout,*) "Fragments",i,j," structure",istruct(i), & istruct(j)," # contacts", & ncont_frag_ref(ind),nsccont_frag_ref(ind), & " lengths",len_frag(i,1),len_frag(j,1), & " ll1",ll1," ll2",ll2," len_cut",len_cut if ((istruct(i).eq.1 .or. istruct(j).eq.1) .and. & nsccont_frag_ref(ind).ge.len_cut ) then if (istruct(i).eq.1 .and. istruct(j).eq.1) then write (iout,*) "Adding pair of helices",i,j, & " based on SC contacts" else write (iout,*) "Adding helix+strand/sheet pair",i,j, & " based on SC contacts" endif nfrag(2)=nfrag(2)+1 if (icont_pair.gt.0) then write (iout,*) "# SC contacts will be used", & " in comparison." isccont(nfrag(2),2)=1 endif if (irms_pair.gt.0) then write (iout,*) "Fragment RMSD will be used", & " in comparison." irms(nfrag(2),2)=1 endif npiece(nfrag(2),2)=2 ipiece(1,nfrag(2),2)=i ipiece(2,nfrag(2),2)=j ielecont(nfrag(2),2)=0 n_shift(1,nfrag(2),2)=nshift_pair n_shift(2,nfrag(2),2)=nshift_pair nc_fragm(nfrag(2),2)=ncfrac_pair nc_req_setf(nfrag(2),2)=ncreq_pair else if ((istruct(i).ge.2 .and. istruct(i).le.4) & .and. (istruct(j).ge.2 .and. istruct(i).le.4) & .and. ncont_frag_ref(ind).ge.len_cut ) then nfrag(2)=nfrag(2)+1 write (iout,*) "Adding pair strands/sheets",i,j, & " based on pp contacts" if (icont_pair.gt.0) then write (iout,*) "# pp contacts will be used", & " in comparison." ielecont(nfrag(2),2)=1 endif if (irms_pair.gt.0) then write (iout,*) "Fragment RMSD will be used", & " in comparison." irms(nfrag(2),2)=1 endif npiece(nfrag(2),2)=2 ipiece(1,nfrag(2),2)=i ipiece(2,nfrag(2),2)=j ielecont(nfrag(2),2)=1 isccont(nfrag(2),2)=0 n_shift(1,nfrag(2),2)=nshift_pair n_shift(2,nfrag(2),2)=nshift_pair nc_fragm(nfrag(2),2)=ncfrac_bet nc_req_setf(nfrag(2),2)=ncreq_bet endif enddo enddo write (iout,*) "Pairs found" do i=1,nfrag(2) write (iout,*) ipiece(1,i,2),ipiece(2,i,2) enddo return end