Merge branch 'prerelease-3.2.1'

[unres.git] / source / unres / src_CSA / readrtns_csa.F

diff --git a/source/unres/src_CSA/readrtns_csa.F b/source/unres/src_CSA/readrtns_csa.F
index e88a67e..af05ce6 100644 (file)
--- a/source/unres/src_CSA/readrtns_csa.F
+++ b/source/unres/src_CSA/readrtns_csa.F
@@ -665,11 +665,6 @@ czscore          call geom_to_var(nvar,coord_exp_zs(1,1))
           enddo
           call contact(.true.,ncont_ref,icont_ref,co)
         endif
-c        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
-        call flush(iout)
-        if (constr_dist.gt.0) call read_dist_constr
-c        write (iout,*) "After read_dist_constr nhpb",nhpb
-        call hpb_partition
         if(me.eq.king.or..not.out1file)
      &   write (iout,*) 'Contact order:',co
         if (pdbref) then
@@ -686,6 +681,13 @@ c        write (iout,*) "After read_dist_constr nhpb",nhpb
         enddo
         endif
       endif
+c        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
+      if (constr_dist.gt.0) then
+        call read_dist_constr
+      endif
+      if (nhpb.gt.0) call hpb_partition
+c      write (iout,*) "After read_dist_constr nhpb",nhpb
+c      call flush(iout)
       if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4
      &    .and. modecalc.ne.8 .and. modecalc.ne.9 .and. 
      &    modecalc.ne.10) then
@@ -1668,9 +1670,9 @@ c----------------------------------------------------------------------------
       integer ifrag_(2,100),ipair_(2,100)
       double precision wfrag_(100),wpair_(100)
       character*500 controlcard
-      write (iout,*) "Calling read_dist_constr"
-      write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
-      call flush(iout)
+c      write (iout,*) "Calling read_dist_constr"
+c      write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
+c      call flush(iout)
       call card_concat(controlcard)
       call readi(controlcard,"NFRAG",nfrag_,0)
       call readi(controlcard,"NPAIR",npair_,0)
@@ -1689,6 +1691,18 @@ c      write (iout,*) "IPAIR"
 c      do i=1,npair_
 c        write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
 c      enddo
+      if (.not.refstr .and. nfrag.gt.0) then
+        write (iout,*) 
+     &  "ERROR: no reference structure to compute distance restraints"
+        write (iout,*)
+     &  "Restraints must be specified explicitly (NDIST=number)"
+        stop 
+      endif
+      if (nfrag.lt.2 .and. npair.gt.0) then 
+        write (iout,*) "ERROR: Less than 2 fragments specified",
+     &   " but distance restraints between pairs requested"
+        stop 
+      endif 
       call flush(iout)
       do i=1,nfrag_
         if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
@@ -1699,7 +1713,7 @@ c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
         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
+c            write (iout,*) "j",j," k",k
             ddjk=dist(j,k)
             if (constr_dist.eq.1) then
             nhpb=nhpb+1
@@ -1763,21 +1777,29 @@ c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
         endif
       enddo 
       do i=1,ndist_
-        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+     &     ibecarb(i),forcon(nhpb+1)
         if (forcon(nhpb+1).gt.0.0d0) then
           nhpb=nhpb+1
-          dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+          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))
+        endif
+      enddo
 #ifdef MPI
-          if (.not.out1file .or. me.eq.king)
-     &    write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
-     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
-          write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
-     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+      if (.not.out1file .or. me.eq.king) then
 #endif
-        endif
+      do i=1,nhpb
+          write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ",
+     &     i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i)
       enddo
       call flush(iout)
+#ifdef MPI
+      endif
+#endif
       return
       end
 c-------------------------------------------------------------------------------