X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_CSA%2Fbank.F;h=38723ba236a6643f7c88a29b0e53f0bbcc0073d3;hb=b857abb01fa60639bf244ffdd5082987dae11529;hp=980c8d23375709d87b2fe96cee86912adc513009;hpb=5e649e8ed333841acd808e370bd9dd017d79bcae;p=unres.git

diff --git a/source/unres/src_CSA/bank.F b/source/unres/src_CSA/bank.F
index 980c8d2..38723ba 100644
--- a/source/unres/src_CSA/bank.F
+++ b/source/unres/src_CSA/bank.F
@@ -136,34 +136,7 @@ cccccccccccccccccccccccccccccccccccccccccccc
        endif
       enddo
 c end of loop over all newly obtained conformations
-      do i=0,mxmv
-        if(nstatnx(i,1).ne.0) then
-         if (i.le.9) then
-         write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
-     &          '## N',i,' total=',nstatnx(i,1),
-     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
-     &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
-         else
-         write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
-     &          '##N',i,' total=',nstatnx(i,1),
-     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
-     &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
-         endif
-        else
-         if (i.le.9) then        
-         write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
-     &          '## N',i,' total=',nstatnx(i,1),
-     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
-     &          ' %acc',0.0
-         else
-         write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
-     &          '##N',i,' total=',nstatnx(i,1),
-     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
-     &          ' %acc',0.0
-         endif
-        endif
-      enddo
-      call flush(iout)
+      call print_mv_stat
 crc Update dij
 crc moved up, saves some get_diff12 calls 
 crc
@@ -1052,6 +1025,88 @@ c---------------------------------
       return
       end
 c---------------------------------
+      subroutine get_diff_p
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.CSA'
+      include 'COMMON.BANK'
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      include 'mpif.h'      
+      integer ij(mxio*mxio/2,2)
+      double precision dij_local(mxio,mxio)
+
+c      write (iout,*) 'Processor ',me,' broadcasting'
+      call mpi_bcast(nbank,1,mpi_integer,0,CG_COMM,ierr)
+      call mpi_bcast(numch,1,mpi_integer,0,CG_COMM,ierr)
+      call mpi_bcast(bvar,mxang*maxres*mxch*nbank,
+     &           mpi_double_precision,0,CG_COMM,ierr)
+      call mpi_bcast(jbank,nbank,mpi_integer,0,CG_COMM,ierr)
+c      write (iout,*) 'Processor ',me,' after broadcasting'
+c      call flush(iout)
+
+      k=0
+      do i1=1,nbank-1
+       do i2=i1+1,nbank
+        k=k+1
+        ij(k,1)=i1
+        ij(k,2)=i2
+        dij_local(i1,i2)=0.0
+        dij_local(i2,i1)=0.0
+        if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
+         dij(i1,i2)=0.0
+         dij(i2,i1)=0.0
+        else
+         if(me.eq.king) then
+           dij_local(i1,i2)=dij(i1,i2)
+           dij_local(i2,i1)=dij(i2,i1)
+         endif
+        endif
+       enddo
+       dij(i1,i1)=0.0
+       dij_local(i1,i1)=0.0
+      enddo
+
+      do i12=me+1,nbank*(nbank-1)/2,nodes
+        i1=ij(i12,1)
+        i2=ij(i12,2)
+        if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
+         call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
+         dij_local(i1,i2)=diff
+         dij_local(i2,i1)=diff
+        endif
+      enddo
+
+      call mpi_reduce(dij_local,dij,mxio*nbank,
+     &           mpi_double_precision,mpi_sum,0,CG_COMM,ierr)
+
+
+      if (me.eq.king) then
+
+       tdiff=0.d0
+       difmin=9.d190
+       do i1=1,nbank-1
+        do i2=i1+1,nbank
+cd         write (iout,*) "!!!ppp",i1,i2,dij(i1,i2)
+cd         call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
+cd         write (iout,*) "!!!",i1,i2,diff
+         tdiff=tdiff+dij(i1,i2)
+         if(diff.lt.difmin) difmin=diff
+        enddo
+       enddo
+
+       do i=1,nbank
+        jbank(i)=1
+       enddo
+
+       avedif=tdiff/nbank/(nbank-1)*2
+      
+      endif
+       
+      return
+      end
+
+c---------------------------------
       subroutine estimate_cutdif(adif,xct,cutdifr)
       implicit real*8 (a-h,o-z)
       include 'DIMENSIONS'
@@ -1090,3 +1145,207 @@ c---------------------------------
 
       return
       end
+c-----------------------------------------
+      subroutine refresh_bank_master_tmscore(ifrom,econf,n)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.CSA'
+      include 'COMMON.BANK'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.CONTROL'
+      include 'COMMON.SETUP'
+      include 'mpif.h'
+      character chacc
+      integer iaccn
+      double precision l_diff(mxio),denep
+      integer info(12),idmin
+
+cd      write(iout,*) 'refresh_bank_master_tmscore',ifrom
+cd      flush(iout)
+
+      info(1)=0
+      info(2)=-2
+      call mpi_send(info,12,mpi_integer,ifrom,idint,CG_COMM,
+     *                  ierr)
+      call mpi_send(bvar,mxang*maxres*mxch*nbank,mpi_double_precision,
+     *                  ifrom,idreal,CG_COMM,ierr)
+      call mpi_recv(idmin,1,mpi_integer,
+     *             ifrom,idint,CG_COMM,muster,ierr)    
+      call mpi_recv(l_diff,nbank,mpi_double_precision,
+     *             ifrom,idreal,CG_COMM,muster,ierr)    
+
+       chacc=' '
+       iaccn=0
+       nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1
+
+       difmin=l_diff(idmin)
+       if(difmin.lt.cutdif) then
+c n is redundant to idmin
+        if(econf.lt.bene(idmin)) then
+         if(econf.lt.bene(idmin)-0.01d0) then
+          ibank(idmin)=0
+          jbank(idmin)=0
+         endif
+         denep=bene(idmin)-econf
+         call replace_bvar(idmin,n)
+crc Update dij
+         do i1=1,nbank
+           if (i1.ne.idmin) then
+            dij(i1,idmin)=l_diff(i1)
+            dij(idmin,i1)=l_diff(i1)
+           endif
+         enddo
+         chacc='c'
+         iaccn=idmin
+         nstatnx(movernx(n),2)=nstatnx(movernx(n),2)+1
+         if(idmin.eq.ibmax) call find_max
+        endif
+       else
+c got new conformation
+        del_ene=0.0d0
+        if(ebmax-ebmin.gt.del_ene) then
+         denep=ebmax-econf
+         call replace_bvar(ibmax,n)
+crc Update dij
+         do i1=1,nbank
+           if (i1.ne.ibmax) then
+            dij(i1,ibmax)=l_diff(i1)
+            dij(ibmax,i1)=l_diff(i1)
+           endif
+         enddo
+         chacc='f'
+         iaccn=ibmax
+         nstatnx(movernx(n),3)=nstatnx(movernx(n),3)+1
+         ibank(ibmax)=0
+         jbank(ibmax)=0
+         call find_max
+        else
+          call replace_bvar(ibmax,n)
+          ibank(ibmax)=0
+          jbank(ibmax)=0
+          call find_max
+        endif
+       endif
+cccccccccccccccccccccccccccccccccccccccccccc
+       if (iaccn.eq.0) then
+        if (iref.eq.0) then 
+         write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5)') 
+     &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
+     &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9)
+        else
+      write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5
+     &       ,a5,0pf4.1,a5,f3.0)') 
+     &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
+     &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
+     &    ' rms ',rmsn(n),' %NC ',pncn(n)*100
+        endif
+       else
+        if (iref.eq.0) then
+        write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,
+     &         1x,a1,i4,0pf8.2,0pf9.1)') 
+     &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
+     &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
+     &    chacc,iaccn,difmin,denep
+        else
+         write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,
+     &                   0pf4.1,a5,f3.0,1x,a1,i4,0pf8.2,0pf9.1)') 
+     &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
+     &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
+     &    ' rms ',rmsn(n),' %NC ',pncn(n)*100,
+     &     chacc,iaccn,difmin,denep
+        endif
+       endif
+
+      do i=1,nbank
+       jbank(i)=1
+      enddo
+
+      return
+      end
+c-----------------------------------------
+      subroutine refresh_bank_worker_tmscore(var)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.BANK'
+      include 'COMMON.VAR'
+      include 'COMMON.CHAIN'
+      include 'COMMON.SETUP'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CSA'
+      include 'mpif.h'
+      integer muster(mpi_status_size)
+      double precision var(maxvar)
+      double precision dihang_l(mxang,maxres,mxch)
+      double precision l_diff(mxio)
+
+      call mpi_recv(bvar,mxang*maxres*mxch*nbank,mpi_double_precision,
+     *             0,idreal,CG_COMM,muster,ierr)    
+
+      call var_to_geom(nvar,var)
+      do j=2,nres-1
+        dihang_l(1,j,1)=theta(j+1)
+        dihang_l(2,j,1)=phi(j+2)
+        dihang_l(3,j,1)=alph(j)
+        dihang_l(4,j,1)=omeg(j)
+      enddo
+
+       difmin=9.d9
+       do m=1,nbank
+        call get_diff12(dihang_l,bvar(1,1,1,m),l_diff(m))
+        if(l_diff(m).lt.difmin) then
+         difmin=l_diff(m)
+         idmin=m
+        endif
+       enddo
+ 
+      tm_score=.false.
+      call get_diff12(dihang_l,bvar(1,1,1,idmin),a_diff)
+      tm_score=.true.
+
+cd      write(iout,*) idmin,l_diff(idmin),a_diff
+      call mpi_send(idmin,1,mpi_integer,0,idint,CG_COMM,
+     *                  ierr)
+      call mpi_send(l_diff,nbank,mpi_double_precision,
+     *                  0,idreal,CG_COMM,ierr)
+
+      return
+      end
+c------------------------------------------------
+      subroutine print_mv_stat
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.BANK'
+      include 'COMMON.IOUNITS'
+
+      do i=0,mxmv
+        if(nstatnx(i,1).ne.0) then
+         if (i.le.9) then
+         write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
+     &          '## N',i,' total=',nstatnx(i,1),
+     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
+     &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
+         else
+         write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
+     &          '##N',i,' total=',nstatnx(i,1),
+     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
+     &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
+         endif
+        else
+         if (i.le.9) then        
+         write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
+     &          '## N',i,' total=',nstatnx(i,1),
+     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
+     &          ' %acc',0.0
+         else
+         write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
+     &          '##N',i,' total=',nstatnx(i,1),
+     &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
+     &          ' %acc',0.0
+         endif
+        endif
+      enddo
+      call flush(iout)
+      return
+      end