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
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'
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
projects / unres.git / blobdiff