intoduction of quartic restrains in multichain, bugfix in single chain

[unres.git] / source / unres / src_MD / ssMD.F

diff --git a/source/unres/src_MD/ssMD.F b/source/unres/src_MD/ssMD.F
index dc205be..6c7d523 100644 (file)
--- a/source/unres/src_MD/ssMD.F
+++ b/source/unres/src_MD/ssMD.F
@@ -512,9 +512,13 @@ c      implicit none
 
 c     Includes
       include 'DIMENSIONS'
+#ifdef MPI
+      include "mpif.h"
+#endif
       include 'COMMON.SBRIDGE'
       include 'COMMON.CHAIN'
       include 'COMMON.IOUNITS'
+      include 'COMMON.SETUP'
 #ifndef CLUST
 #ifndef WHAM
       include 'COMMON.MD'
@@ -528,7 +532,8 @@ c     Local variables
      &     allihpb(maxdim),alljhpb(maxdim),
      &     newnss,newihpb(maxdim),newjhpb(maxdim)
       logical found
-
+      integer i_newnss(max_fg_procs),displ(max_fg_procs)
+      integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
 
       allnss=0
       do i=1,nres-1
@@ -576,6 +581,37 @@ cmc      write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
           newjhpb(newnss)=alljhpb(i)
         endif
       enddo
+
+#ifdef MPI
+      if (nfgtasks.gt.1)then
+
+        call MPI_Reduce(newnss,g_newnss,1,
+     &    MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
+        call MPI_Gather(newnss,1,MPI_INTEGER,
+     &                  i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
+C        displ(0)=0
+        do i=1,nfgtasks-1,1
+          displ(i)=i_newnss(i-1)+displ(i-1)
+        enddo
+        call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,
+     &                   g_newihpb,i_newnss,displ,MPI_INTEGER,
+     &                   king,FG_COMM,IERR)     
+        call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,
+     &                   g_newjhpb,i_newnss,displ,MPI_INTEGER,
+     &                   king,FG_COMM,IERR)     
+        if(fg_rank.eq.0) then
+c         print *,'g_newnss',g_newnss
+c         print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
+c         print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
+         newnss=g_newnss  
+         do i=1,newnss
+          newihpb(i)=g_newihpb(i)
+          newjhpb(i)=g_newjhpb(i)
+         enddo
+        endif
+      endif
+#endif
+
       diff=newnss-nss
 
 cmc      write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
@@ -588,7 +624,8 @@ cmc      write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
         enddo
 #ifndef CLUST
 #ifndef WHAM
-        if (.not.found) write(iout,'(a15,f12.2,f8.1,2i5)')
+        if (.not.found.and.fg_rank.eq.0) 
+     &      write(iout,'(a15,f12.2,f8.1,2i5)')
      &       "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
 #endif
 #endif
@@ -602,7 +639,8 @@ cmc      write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
         enddo
 #ifndef CLUST
 #ifndef WHAM
-        if (.not.found) write(iout,'(a15,f12.2,f8.1,2i5)')
+        if (.not.found.and.fg_rank.eq.0) 
+     &      write(iout,'(a15,f12.2,f8.1,2i5)')
      &       "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
 #endif
 #endif
@@ -617,41 +655,6 @@ cmc      write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
       return
       end
 
-c----------------------------------------------------------------------------
-
-#ifdef WHAM
-      subroutine read_ssHist
-      implicit none
-
-c     Includes
-      include 'DIMENSIONS'
-      include "DIMENSIONS.FREE"
-      include 'COMMON.FREE'
-
-c     Local variables
-      integer i,j
-      character*80 controlcard
-
-      do i=1,dyn_nssHist
-        call card_concat(controlcard,.true.)
-        read(controlcard,*)
-     &       dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
-      enddo
-
-      return
-      end
-#endif
-
-c----------------------------------------------------------------------------
-
-
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
 
 c$$$c-----------------------------------------------------------------------------
 c$$$