source/wham/src-M-SAXS/proc_cont.f

   1       subroutine proc_cont
   2       implicit real*8 (a-h,o-z)
   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.CONTROL'
  10       include 'COMMON.COMPAR'
  11       include 'COMMON.CHAIN'
  12       include 'COMMON.HEADER'
  13       include 'COMMON.CONTACTS1'
  14       include 'COMMON.PEPTCONT'
  15       include 'COMMON.GEO'
  16       write (iout,*) "proc_cont: nlevel",nlevel
  17       if (nlevel.lt.0) then
  18         write (iout,*) "call define_fragments"
  19         call define_fragments
  20       else
  21         write (iout,*) "call secondary2"
  22         call secondary2(.true.,.false.,ncont_pept_ref,icont_pept_ref,
  23      &     isec_ref)
  24       endif
  25       write (iout,'(80(1h=))')
  26       write (iout,*) "Electrostatic contacts"
  27       call contacts_between_fragments(.true.,0,ncont_pept_ref,
  28      & icont_pept_ref,ncont_frag_ref(1),icont_frag_ref(1,1,1))
  29       write (iout,'(80(1h=))')
  30       write (iout,*) "Side chain contacts"
  31       call contacts_between_fragments(.true.,0,ncont_ref,
  32      & icont_ref,nsccont_frag_ref(1),isccont_frag_ref(1,1,1))
  33       if (nlevel.lt.0) then
  34         do i=1,nfrag(1)
  35           ind=icant(i,i)
  36           len_cut=1000
  37           if (istruct(i).le.1) then
  38             len_cut=max0(len_frag(i,1)*4/5,3)
  39           else if (istruct(i).eq.2 .or. istruct(i).eq.4) then
  40             len_cut=max0(len_frag(i,1)*2/5,3)
  41           endif
  42           write (iout,*) "i",i," istruct",istruct(i)," ncont_frag",
  43      &      ncont_frag_ref(ind)," len_cut",len_cut,
  44      &      " icont_single",icont_single," iloc_single",iloc_single
  45           iloc(i)=iloc_single
  46           if (iloc(i).gt.0) write (iout,*)
  47      &     "Local structure used to compare structure of fragment",i,
  48      &     " to native."
  49           if (istruct(i).ne.3 .and. istruct(i).ne.0
  50      &        .and. icont_single.gt.0 .and.
  51      &        ncont_frag_ref(ind).ge.len_cut) then
  52             write (iout,*) "Electrostatic contacts used to compare",
  53      &       " structure of fragment",i," to native."
  54             ielecont(i,1)=1
  55             isccont(i,1)=0
  56           else if (icont_single.gt.0 .and. nsccont_frag_ref(ind)
  57      &      .ge.len_cut) then
  58             write (iout,*) "Side chain contacts used to compare",
  59      &       " structure of fragment",i," to native."
  60             isccont(i,1)=1
  61             ielecont(i,1)=0
  62           else
  63             write (iout,*) "Contacts not used to compare",
  64      &       " structure of fragment",i," to native."
  65             ielecont(i,1)=0
  66             isccont(i,1)=0
  67             nc_req_setf(i,1)=0
  68           endif
  69           if (irms_single.gt.0 .or. isccont(i,1).eq.0
  70      &         .and. ielecont(i,1).eq.0) then
  71             write (iout,*) "RMSD used to compare",
  72      &       " structure of fragment",i," to native."
  73             irms(i,1)=1
  74           else
  75             write (iout,*) "RMSD not used to compare",
  76      &       " structure of fragment",i," to native."
  77             irms(i,1)=0
  78           endif
  79         enddo
  80       endif
  81       if (nlevel.lt.-1) then
  82         call define_pairs
  83         nlevel = -nlevel
  84         if (nlevel.gt.3) nlevel=3
  85         if (nlevel.eq.3) then
  86           nfrag(3)=1
  87           npiece(1,3)=nfrag(1)
  88           do i=1,nfrag(1)
  89             ipiece(i,1,3)=i
  90           enddo
  91           ielecont(1,3)=0
  92           isccont(1,3)=0
  93           irms(1,3)=1
  94           n_shift(1,1,3)=0
  95           n_shift(2,1,3)=0
  96         endif
  97       else if (nlevel.eq.-1) then
  98         nlevel=1
  99       endif
 100       isnfrag(1)=0
 101       do i=1,nlevel
 102         isnfrag(i+1)=isnfrag(i)+nfrag(i)
 103       enddo
 104       ndigit=3*nfrag(1)
 105       do i=2,nlevel
 106         ndigit=ndigit+2*nfrag(i)
 107       enddo
 108       write (iout,*) "ndigit",ndigit
 109       if (.not.binary .and. ndigit.gt.30) then
 110         write (iout,*) "Highest class too large; switching to",
 111      &    " binary representation."
 112         binary=.true.
 113       endif
 114       write (iout,*) "isnfrag",(isnfrag(i),i=1,nlevel+1)
 115       write(iout,*) "rmscut_base_up",rmscut_base_up,
 116      & " rmscut_base_low",rmscut_base_low," rmsup_lim",rmsup_lim
 117       do i=1,nlevel
 118         do j=1,nfrag(i)
 119           length_frag = 0
 120           if (i.eq.1) then
 121             do k=1,npiece(j,i)
 122               length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1
 123             enddo
 124           else
 125             do k=1,npiece(j,i)
 126               length_frag=length_frag+len_frag(ipiece(k,j,i),1)
 127             enddo
 128           endif
 129           len_frag(j,i)=length_frag
 130           rmscutfrag(1,j,i)=rmscut_base_up*length_frag
 131           rmscutfrag(2,j,i)=rmscut_base_low*length_frag
 132           if (rmscutfrag(1,j,i).lt.rmsup_lim)
 133      &      rmscutfrag(1,j,i)=rmsup_lim
 134           if (rmscutfrag(1,j,i).gt.rmsupup_lim)
 135      &      rmscutfrag(1,j,i)=rmsupup_lim
 136         enddo
 137       enddo
 138       write (iout,*) "Level",1," number of fragments:",nfrag(1)
 139       do j=1,nfrag(1)
 140         write (iout,*) npiece(j,1),(ifrag(1,k,j),ifrag(2,k,j),
 141      &    k=1,npiece(j,1)),len_frag(j,1),rmscutfrag(1,j,1),
 142      &    rmscutfrag(2,j,1),n_shift(1,j,1),n_shift(2,j,1),
 143      &    ang_cut(j)*rad2deg,ang_cut1(j)*rad2deg,frac_min(j),
 144      &    nc_fragm(j,1),nc_req_setf(j,1),istruct(j)
 145       enddo
 146       do i=2,nlevel
 147         write (iout,*) "Level",i," number of fragments:",nfrag(i)
 148         do j=1,nfrag(i)
 149           write (iout,*) npiece(j,i),(ipiece(k,j,i),
 150      &      k=1,npiece(j,i)),len_frag(j,i),rmscutfrag(1,j,i),
 151      &      rmscutfrag(2,j,i),n_shift(1,j,i),n_shift(2,j,i),
 152      &      nc_fragm(j,i),nc_req_setf(j,i)
 153         enddo
 154       enddo
 155       return
 156       end