X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?p=unres.git;a=blobdiff_plain;f=source%2Fcluster%2Fwham%2Fsrc-M%2Freadrtns.F;h=06777ec96681579c450704d1d1303b25b341cea2;hp=6e88ef3e1d109eee5fc0d72ffc737a98e36a0732;hb=c9dddd7cdc2cbf55f6fa8df9404eea7ecfe59605;hpb=eb99e7324e8d488f1fc782e2fbd3f1fb41e53f99

diff --git a/source/cluster/wham/src-M/readrtns.F b/source/cluster/wham/src-M/readrtns.F
index 6e88ef3..06777ec 100644
--- a/source/cluster/wham/src-M/readrtns.F
+++ b/source/cluster/wham/src-M/readrtns.F
@@ -35,6 +35,11 @@ C
       pdbref=(index(controlcard,'PDBREF').gt.0)
       iscode=index(controlcard,'ONE_LETTER')
       tree=(index(controlcard,'MAKE_TREE').gt.0)
+      with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
+      call readi(controlcard,'CONSTR_DIST',constr_dist,0)
+      write (iout,*) "with_dihed_constr ",with_dihed_constr,
+     & " CONSTR_DIST",constr_dist
+      call flush(iout)
       min_var=(index(controlcard,'MINVAR').gt.0)
       plot_tree=(index(controlcard,'PLOT_TREE').gt.0)
       punch_dist=(index(controlcard,'PUNCH_DIST').gt.0)
@@ -87,6 +92,7 @@ C
       include 'COMMON.CONTROL'
       include 'COMMON.CONTACTS'
       include 'COMMON.TIME1'
+      include 'COMMON.TORCNSTR'
 #ifdef MPL
       include 'COMMON.INFO'
 #endif
@@ -278,6 +284,26 @@ C Convert sequence to numeric code
 
       print *,'Call Read_Bridge.'
       call read_bridge
+C this fragment reads diheadral constrains
+      if (with_dihed_constr) then
+
+      read (inp,*) ndih_constr
+      if (ndih_constr.gt.0) then
+        read (inp,*) ftors
+        write (iout,*) 'FTORS',ftors
+C ftors is the force constant for torsional quartic constrains
+        read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr)
+        write (iout,*)
+     &   'There are',ndih_constr,' constraints on phi angles.'
+        do i=1,ndih_constr
+          write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i)
+        enddo
+        do i=1,ndih_constr
+          phi0(i)=deg2rad*phi0(i)
+          drange(i)=deg2rad*drange(i)
+        enddo
+      endif ! endif ndif_constr.gt.0
+      endif ! with_dihed_constr
       nnt=1
       nct=nres
       print *,'NNT=',NNT,' NCT=',NCT
@@ -391,6 +417,11 @@ C     &  'The chain contains',ns,' disulfide-bridging cysteines.'
             dyn_ss_mask(iss(i))=.true.
           enddo
       endif
+c Read distance restraints
+      if (constr_dist.gt.0) then
+        call read_dist_constr
+        call hpb_partition
+      endif
       return
       end
 c-----------------------------------------------------------------------------
@@ -563,6 +594,25 @@ c----------------------------------------------------------------------------
       read (rekord(iread:),*) wartosc
       return
       end
+C----------------------------------------------------------------------
+      subroutine multreadi(rekord,lancuch,tablica,dim,default)
+      implicit none
+      integer dim,i
+      integer tablica(dim),default
+      character*(*) rekord,lancuch
+      character*80 aux
+      integer ilen,iread
+      external ilen
+      do i=1,dim
+        tablica(i)=default
+      enddo
+      iread=index(rekord,lancuch(:ilen(lancuch))//"=")
+      if (iread.eq.0) return
+      iread=iread+ilen(lancuch)+1
+      read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
+   10 return
+      end
+
 c----------------------------------------------------------------------------
       subroutine card_concat(card)
       include 'DIMENSIONS'
@@ -664,3 +714,131 @@ C
 #endif
       return
       end
+      subroutine read_dist_constr
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+#ifdef MPI
+      include 'mpif.h'
+#endif
+      include 'COMMON.CONTROL'
+      include 'COMMON.CHAIN'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.SBRIDGE'
+      integer ifrag_(2,100),ipair_(2,100)
+      double precision wfrag_(100),wpair_(100)
+      character*500 controlcard
+      logical lprn /.true./
+      write (iout,*) "Calling read_dist_constr"
+C      write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
+C      call flush(iout)
+      write(iout,*) "TU sie wywalam?"
+      call card_concat(controlcard)
+      write (iout,*) controlcard
+      call flush(iout)
+      call readi(controlcard,"NFRAG",nfrag_,0)
+      call readi(controlcard,"NPAIR",npair_,0)
+      call readi(controlcard,"NDIST",ndist_,0)
+      call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
+      call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
+      call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
+      call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
+      call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
+      write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
+      write (iout,*) "IFRAG"
+      do i=1,nfrag_
+        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
+      enddo
+      write (iout,*) "IPAIR"
+      do i=1,npair_
+        write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
+      enddo
+      call flush(iout)
+      do i=1,nfrag_
+        if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
+        if (ifrag_(2,i).gt.nstart_sup+nsup-1)
+     &    ifrag_(2,i)=nstart_sup+nsup-1
+c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
+        call flush(iout)
+        if (wfrag_(i).gt.0.0d0) then
+        do j=ifrag_(1,i),ifrag_(2,i)-1
+          do k=j+1,ifrag_(2,i)
+            write (iout,*) "j",j," k",k
+            ddjk=dist(j,k)
+            if (constr_dist.eq.1) then
+              nhpb=nhpb+1
+              ihpb(nhpb)=j
+              jhpb(nhpb)=k
+              dhpb(nhpb)=ddjk
+              forcon(nhpb)=wfrag_(i) 
+            else if (constr_dist.eq.2) then
+              if (ddjk.le.dist_cut) then
+                nhpb=nhpb+1
+                ihpb(nhpb)=j
+                jhpb(nhpb)=k
+                dhpb(nhpb)=ddjk
+                forcon(nhpb)=wfrag_(i) 
+              endif
+            else
+              nhpb=nhpb+1
+              ihpb(nhpb)=j
+              jhpb(nhpb)=k
+              dhpb(nhpb)=ddjk
+              forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
+            endif
+            if (lprn)
+     &      write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
+     &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+          enddo
+        enddo
+        endif
+      enddo
+      do i=1,npair_
+        if (wpair_(i).gt.0.0d0) then
+        ii = ipair_(1,i)
+        jj = ipair_(2,i)
+        if (ii.gt.jj) then
+          itemp=ii
+          ii=jj
+          jj=itemp
+        endif
+        do j=ifrag_(1,ii),ifrag_(2,ii)
+          do k=ifrag_(1,jj),ifrag_(2,jj)
+            nhpb=nhpb+1
+            ihpb(nhpb)=j
+            jhpb(nhpb)=k
+            forcon(nhpb)=wpair_(i)
+            dhpb(nhpb)=dist(j,k)
+            write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+     &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+          enddo
+        enddo
+        endif
+      enddo 
+      do i=1,ndist_
+        if (constr_dist.eq.11) then
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+     &     ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1)
+        fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1)
+C        write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+C     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+        else
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+        endif
+        if (forcon(nhpb+1).gt.0.0d0) then
+          nhpb=nhpb+1
+          if (ibecarb(i).gt.0) then
+            ihpb(i)=ihpb(i)+nres
+            jhpb(i)=jhpb(i)+nres
+          endif
+          if (dhpb(nhpb).eq.0.0d0)
+     &       dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+C          dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+          write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
+     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+        endif
+C      endif
+      enddo
+      call hpb_partition
+      call flush(iout)
+      return
+      end