X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?p=unres.git;a=blobdiff_plain;f=source%2Funres%2Fsrc_CSA_DiL%2Fbank.F;fp=source%2Funres%2Fsrc_CSA_DiL%2Fbank.F;h=0000000000000000000000000000000000000000;hp=fc365e3726406d29b092e41ae6de06cd07eac192;hb=2a226bfc86eabc6e4eae0c3ad1cbc3cb5417a05a;hpb=a0e685f844163003749ba91dfbf4644bcc8cfa30 diff --git a/source/unres/src_CSA_DiL/bank.F b/source/unres/src_CSA_DiL/bank.F deleted file mode 100644 index fc365e3..0000000 --- a/source/unres/src_CSA_DiL/bank.F +++ /dev/null @@ -1,1353 +0,0 @@ -#ifdef MPI -cc--------------------------------- - subroutine refresh_bank(ntrial) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - character chacc - integer iaccn - double precision l_diff(mxio),denep - - do i=0,mxmv - do j=1,3 - nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j) - nstatnx(i,j)=0 - enddo - enddo - -c loop over all newly obtained conformations - do n=1,ntrial - chacc=' ' - iaccn=0 - nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1 -cccccccccccccccccccccccccccccccccccccccccccc -cjlee - if(iref.ne.0) then - if(rmsn(n).gt.rmscut.or.pncn(n).lt.pnccut) goto 100 - endif -cjlee - if(etot(n).gt.ebmax) goto 100 -c Find the conformation closest to the conformation n in the bank - difmin=9.d9 - do m=1,nbank - call get_diff12(dihang(1,1,1,n),bvar(1,1,1,m),l_diff(m)) - if(l_diff(m).lt.difmin) then - difmin=l_diff(m) - idmin=m - endif - enddo - - if(difmin.lt.cutdif) then -c n is redundant to idmin - if(etot(n).lt.bene(idmin)) then - if(etot(n).lt.bene(idmin)-0.01d0) then - ibank(idmin)=0 - jbank(idmin)=0 - endif - denep=bene(idmin)-etot(n) - 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-etot(n) - 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 - if(del_ene.lt.0.0001) then - write (iout,*) 'ERROR in refresh_bank: ' - write (iout,*) 'ebmax: ',ebmax - write (iout,*) 'ebmin: ',ebmin - write (iout,*) 'del_ene: ',del_ene -crc call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -cjp nbmax is never defined so condition below is always false -c if(nbank.lt.nbmax) then -c nbank=nbank+1 -c call replace_bvar(nbank,n) -c ibank(nbank)=0 -c jbank(nbank)=0 -c else - call replace_bvar(ibmax,n) - ibank(ibmax)=0 - jbank(ibmax)=0 - call find_max -c endif - endif - endif -cccccccccccccccccccccccccccccccccccccccccccc - 100 continue - 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 ',etot(n),' 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 ',etot(n),' 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.1,0pf8.1)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' 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.1,0pf8.1)') - & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' 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 - enddo -c end of loop over all newly obtained conformations - call print_mv_stat -crc Update dij -crc moved up, saves some get_diff12 calls -crc -crc do i1=1,nbank-1 -crc do i2=i1+1,nbank -crc if(jbank(i1).eq.0.or.jbank(i2).eq.0) then -crc call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff) -crc dij(i1,i2)=diff -crc dij(i2,i1)=diff -crc endif -crc enddo -crc enddo - - do i=1,nbank - jbank(i)=1 - enddo - - return - end -c--------------------------------- - subroutine replace_bvar(iold,inew) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - - if (iold.gt.mxio .or. iold.lt.1 .or. inew.gt.mxio .or. inew.lt.1) - & then - write (iout,*) 'Dimension ERROR in REPLACE_BVAR: IOLD',iold, - & ' INEW',inew - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - bvar(i,j,k,iold)=dihang(i,j,k,inew) - enddo - enddo - enddo - bene(iold)=etot(inew) - brmsn(iold)=rmsn(inew) - bpncn(iold)=pncn(inew) - - if(bene(iold).lt.ebmin) then - ebmin=bene(iold) - ibmin=iold - endif - - if(vdisulf) then - bvar_nss(iold)=nss_out(inew) -cd write(iout,*) 'SS BANK',iold,bvar_nss(iold) - do i=1,bvar_nss(iold) - bvar_ss(1,i,iold)=iss_out(i,inew) - bvar_ss(2,i,iold)=jss_out(i,inew) -cd write(iout,*) 'SS',bvar_ss(1,i,iold)-nres, -cd & bvar_ss(2,i,iold)-nres - enddo - - bvar_ns(iold)=ns-2*bvar_nss(iold) -cd write(iout,*) 'CYS #free ', bvar_ns(iold) - k=0 - do i=1,ns - j=1 - do while( iss(i).ne.iss_out(j,inew)-nres .and. - & iss(i).ne.jss_out(j,inew)-nres .and. - & j.le.nss_out(inew)) - j=j+1 - enddo - if (j.gt.nss_out(inew)) then - k=k+1 - bvar_s(k,iold)=iss(i) - endif - enddo -cd write(iout,*) 'CYS free',(bvar_s(k,iold),k=1,bvar_ns(iold)) - endif - - return - end -c--------------------------------------- - subroutine write_rbank(jlee,adif,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - - open(icsa_rbank,file=csa_rbank,status="unknown") - write (icsa_rbank,900) jlee,nbank,nstep,nft,icycle,adif - do k=1,nbank - write (icsa_rbank,952) k,rene(k),rrmsn(k),rpncn(k) - do j=1,numch - do l=2,nres-1 - write (icsa_rbank,850) (rad2deg*rvar(i,l,j,k),i=1,4) - enddo - enddo - enddo - close(icsa_rbank) - - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2) - - return - end -c--------------------------------------- - subroutine read_rbank(jlee,adif) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SETUP' - character*80 karta - - open(icsa_rbank,file=csa_rbank,status="old") - read (icsa_rbank,901) jleer,nbankr,nstepr,nftr,icycler,adif - print *,jleer,nbankr,nstepr,nftr,icycler,adif -c print *, 'adif from read_rbank ',adif - if(nbankr.ne.nbank) then - write (iout,*) 'ERROR in READ_BANK: NBANKR',nbankr, - & ' NBANK',nbank - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - if(jleer.ne.jlee) then - write (iout,*) 'ERROR in READ_BANK: JLEER',jleer, - & ' JLEE',jlee - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - - kk=0 - do k=1,nbankr - read (icsa_rbank,'(a80)') karta - write(iout,*) "READ_RBANK: kk=",kk - write(iout,*) karta -c if (index(karta,"*").gt.0) then -c write (iout,*) "***** Stars in bankr ***** k=",k, -c & " skipped" -c do j=1,numch -c do l=2,nres-1 -c read (30,850) (rdummy,i=1,4) -c enddo -c enddo -c else - kk=kk+1 - call reada(karta,"total E",rene(kk),1.0d20) - call reada(karta,"rmsd from N",rrmsn(kk),0.0d0) - call reada(karta,"%NC",rpncn(kk),0.0d0) - write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk), - & "%NC",bpncn(kk),ibank(kk) -c read (icsa_rbank,953) kdummy,rene(kk),rrmsn(kk),rpncn(kk) - do j=1,numch - do l=2,nres-1 - read (icsa_rbank,850) (rvar(i,l,j,kk),i=1,4) -c write (iout,850) (rvar(i,l,j,kk),i=1,4) - do i=1,4 - rvar(i,l,j,kk)=deg2rad*rvar(i,l,j,kk) - enddo - enddo - enddo -c endif - enddo -cd write (*,*) "read_rbank ******************* kk",kk, -cd & "nbankr",nbankr - if (kk.lt.nbankr) nbankr=kk -cd do kk=1,nbankr -cd print *,"kk=",kk -cd do j=1,numch -cd do l=2,nres-1 -cd write (*,850) (rvar(i,l,j,kk),i=1,4) -cd enddo -cd enddo -cd enddo - close(icsa_rbank) - - 850 format (10f8.3) - 901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5) - 953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2) - - return - end -c--------------------------------------- - subroutine write_bank(jlee,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - character*7 chtmp - character*40 chfrm - external ilen - - open(icsa_bank,file=csa_bank,status="unknown") - write (icsa_bank,900) jlee,nbank,nstep,nft,icycle,cutdif - write (icsa_bank,902) nglob_csa, eglob_csa - open (igeom,file=intname,status='UNKNOWN') - do k=1,nbank - write (icsa_bank,952) k,bene(k),brmsn(k),bpncn(k),ibank(k) - if (vdisulf) write (icsa_bank,'(101i4)') - & bvar_nss(k),((bvar_ss(j,i,k),j=1,2),i=1,bvar_nss(k)) - do j=1,numch - do l=2,nres-1 - write (icsa_bank,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - if (bvar_nss(k).le.9) then - write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k)) - else - write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9) - write (igeom,'(3X,11(1X,2I3))') (bvar_ss(1,i,k), - & bvar_ss(2,i,k),i=10,bvar_nss(k)) - endif - write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_bank) - close(igeom) - - if (nstep/200.gt.ilastnstep) then - - ilastnstep=(ilastnstep+1)*1.5 - write(chfrm,'(a2,i1,a1)') '(i',int(dlog10(dble(nstep))+1),')' - write(chtmp,chfrm) nstep - open(icsa_int,file=prefix(:ilen(prefix)) - & //'_'//chtmp(:ilen(chtmp))//'.int',status='UNKNOWN') - do k=1,nbank - if (bvar_nss(k).le.9) then - write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k)) - else - write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k), - & bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9) - write (icsa_int,'(3X,11(1X,2I3))') (bvar_ss(1,i,k), - & bvar_ss(2,i,k),i=10,bvar_nss(k)) - endif - write (icsa_int,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (icsa_int,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (icsa_int,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (icsa_int,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_int) - endif - - - 200 format (8f10.4) - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 902 format (1x,'nglob_csa =',i4,' eglob_csa =',1pe14.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3, - & ' %NC ',0pf5.2,i5) - - return - end -c--------------------------------------- - subroutine write_bank_reminimized(jlee,nft) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' - - open(icsa_bank_reminimized,file=csa_bank_reminimized, - & status="unknown") - write (icsa_bank_reminimized,900) - & jlee,nbank,nstep,nft,icycle,cutdif - open (igeom,file=intname,status='UNKNOWN') - do k=1,nbank - write (icsa_bank_reminimized,952) k,bene(k),brmsn(k), - & bpncn(k),ibank(k) - do j=1,numch - do l=2,nres-1 - write (icsa_bank_reminimized,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - if (nss.le.9) then - write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k), - & nss,(ihpb(i),jhpb(i),i=1,nss) - else - write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k), - & nss,(ihpb(i),jhpb(i),i=1,9) - write (igeom,'(3X,11(1X,2I3))') (ihpb(i),jhpb(i),i=10,nss) - endif - write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2) - write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1) - write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1) - enddo - close(icsa_bank_reminimized) - close(igeom) - - 200 format (8f10.4) - 850 format (10f8.3) - 900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =", - & i8,i10,i2,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2,i5) - - return - end -c--------------------------------- - subroutine read_bank(jlee,nft,cutdifr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - character*80 karta - integer ilen - external ilen - - open(icsa_bank,file=csa_bank,status="old") - read (icsa_bank,901) jlee,nbank,nstep,nft,icycle,cutdifr - read (icsa_bank,902) nglob_csa, eglob_csa -c if(jleer.ne.jlee) then -c write (iout,*) 'ERROR in READ_BANK: JLEER',jleer, -c & ' JLEE',jlee -c call mpi_abort(mpi_comm_world,ierror,ierrcode) -c endif - - kk=0 - do k=1,nbank - read (icsa_bank,'(a80)') karta - write(iout,*) "READ_BANK: kk=",kk - write(iout,*) karta -c if (index(karta,"*").gt.0) then -c write (iout,*) "***** Stars in bank ***** k=",k, -c & " skipped" -c do j=1,numch -c do l=2,nres-1 -c read (33,850) (rdummy,i=1,4) -c enddo -c enddo -c else - kk=kk+1 - call reada(karta,"total E",bene(kk),1.0d20) - call reada(karta,"rmsd from N",brmsn(kk),0.0d0) - call reada(karta,"%NC",bpncn(kk),0.0d0) - read (karta(ilen(karta)-1:),*,end=111,err=111) ibank(kk) - goto 112 - 111 ibank(kk)=0 - 112 continue - write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk), - & "%NC",bpncn(kk),ibank(kk) -c read (icsa_bank,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k) - if (vdisulf) then - read (icsa_bank,'(101i4)') - & bvar_nss(kk),((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk)) - bvar_ns(kk)=ns-2*bvar_nss(kk) - write(iout,*) 'read SSBOND',bvar_nss(kk), - & ((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk)) -cd write(iout,*) 'read CYS #free ', bvar_ns(kk) - l=0 - do i=1,ns - j=1 - do while( iss(i).ne.bvar_ss(1,j,kk)-nres .and. - & iss(i).ne.bvar_ss(2,j,kk)-nres .and. - & j.le.bvar_nss(kk)) - j=j+1 - enddo - if (j.gt.bvar_nss(kk)) then - l=l+1 - bvar_s(l,kk)=iss(i) - endif - enddo -cd write(iout,*)'read CYS free',(bvar_s(l,kk),l=1,bvar_ns(kk)) - endif - do j=1,numch - do l=2,nres-1 - read (icsa_bank,850) (bvar(i,l,j,kk),i=1,4) -c write (iout,850) (bvar(i,l,j,kk),i=1,4) - do i=1,4 - bvar(i,l,j,kk)=deg2rad*bvar(i,l,j,kk) - enddo ! l - enddo ! l - enddo ! j -c endif - enddo ! k - - if (kk.lt.nbank) nbank=kk -cd write (*,*) "read_bank ******************* kk",kk, -cd & "nbank",nbank -cd do kk=1,nbank -cd print *,"kk=",kk -cd do j=1,numch -cd do l=2,nres-1 -cd write (*,850) (bvar(i,l,j,kk),i=1,4) -cd enddo -cd enddo -cd enddo - -c do k=1,nbank -c read (33,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k) -c do j=1,numch -c do l=2,nres-1 -c read (33,850) (bvar(i,l,j,k),i=1,4) -c do i=1,4 -c bvar(i,l,j,k)=deg2rad*bvar(i,l,j,k) -c enddo -c enddo -c enddo -c enddo - close(icsa_bank) - - 850 format (10f8.3) - 952 format (1x,'#',i4,' total E ',f12.3,' rmsd from N ',f8.3,i5) - 901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5) - 902 format (1x,11x,i4,12x,1pe14.5) - 953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2,i5) - - return - end -c--------------------------------------- - subroutine write_bank1(jlee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - -#if defined(AIX) || defined(PGI) - open(icsa_bank1,file=csa_bank1,position="append") -#else - open(icsa_bank1,file=csa_bank1,access="append") -#endif - write (icsa_bank1,900) jlee,nbank,nstep,cutdif - do k=1,nbank - write (icsa_bank1,952) k,bene(k),brmsn(k),bpncn(k),ibank(k) - do j=1,numch - do l=2,nres-1 - write (icsa_bank1,850) (rad2deg*bvar(i,l,j,k),i=1,4) - enddo - enddo - enddo - close(icsa_bank1) - 850 format (10f8.3) - 900 format (4x,"jlee =",i5,3x,"nbank =",i5,3x,"nstep =",i10,f15.5) - 952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3 - & ,' %NC ',0pf5.2,i5) - - return - end -c--------------------------------- - subroutine save_is(ind) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - - index=nbank+ind -c print *, "nbank,ind,index,is(ind) ",nbank,ind,index,is(ind) - if (index.gt.mxio .or. index.lt.1 .or. - & is(ind).gt.mxio .or. is(ind).lt.1) then - write (iout,*) 'Dimension ERROR in SAVE_IS: INDEX',index, - & ' IND',ind,' IS',is(ind) - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - bvar(i,j,k,index)=bvar(i,j,k,is(ind)) - enddo - enddo - enddo - bene(index)=bene(is(ind)) - ibank(is(ind))=1 - - return - end -c--------------------------------- - subroutine select_is(n,ifar,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - do i=1,nbank - if(ibank(i).eq.0) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iusesv=iuse - - if(iuse.eq.0) then - icycle=icycle+1 - do i=1,nbank - if(ibank(i).eq.2) then - ibank(i)=1 - else - ibank(i)=0 - endif - enddo - imade=0 - call get_is(idum,ifar,n,imade,0) -ctest3 call get_is_max(idum,ifar,n,imade,0) - else if(iuse.eq.n) then - do i=1,iuse - is(i)=itag(i) - call save_is(i) - enddo - else if(iuse.lt.n) then -c if(icycle.eq.0) then -c do i=1,n -c ind=mod(i-1,iuse)+1 -c is(i)=itag(ind) -c call save_is(i) -c enddo -c else -c endif - do i=1,iuse - is(i)=itag(i) - call save_is(i) - enddo - imade=iuse -c call get_is_ran(idum,n,imade,1) - call get_is(idum,ifar,n,imade,1) -ctest3 call get_is_max(idum,ifar,n,imade,1) -c if(iusesv.le.n/10) then - if(iusesv.le.0) then - icycle=icycle+1 - do i=1,nbank -c if(ibank(i).eq.2) then -c ibank(i)=1 - if(ibank(i).ge.2) then - ibank(i)=ibank(i)-1 - else - ibank(i)=0 - endif - enddo - endif - else - imade=0 - call get_is(idum,ifar,n,imade,0) -ctest3 call get_is_max(idum,ifar,n,imade,0) - endif - iuse=iusesv - - if (iuse.le.iucut) then - icycle=icycle+1 - do i=1, nbank - ibank(i)=0 - enddo - endif - - - return - end -c--------------------------------- - subroutine get_is_ran(idum,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - real ran1,ran2 - dimension itag(mxio),adiff(mxio) - - do j=imade+1,n - iuse=0 - do i=1,nbank - if(ibank(i).eq.k) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iran=iuse* ran1(idum)+1 - is(j)=itag(iran) - call save_is(j) - enddo - - return - end -c--------------------------------- - subroutine get_is(idum,ifar,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - real ran1,ran2 - dimension itag(mxio),adiff(mxio) - - iuse=0 - do i=1,nbank - if(ibank(i).eq.k) then - iuse=iuse+1 - itag(iuse)=i - endif - enddo - iran=iuse* ran1(idum)+1 - imade=imade+1 - is(imade)=itag(iran) - call save_is(imade) - - do i=imade+1,ifar-1 - if(icycle.eq.-1) then - call select_iseed_max(i,k) - else - call select_iseed_min(i,k) -ctest4 call select_iseed_max(i,k) - endif - call save_is(i) - enddo - - do i=ifar,n - call select_iseed_far(i,k) - call save_is(i) - enddo - - return - end -c--------------------------------- - subroutine select_iseed_max(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - avedif=0.d0 - difmax=0.d0 - do n=1,nbank - if(ibank(n).eq.ik) then - iuse=iuse+1 - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - if(diffmn.gt.difmax) difmax=diffmn - adiff(iuse)=diffmn - itag(iuse)=n - avedif=avedif+diffmn - endif - enddo - - avedif=avedif/iuse -c avedif=(avedif+difmax)/2 - emax=-9.d190 - do i=1,iuse - if(adiff(i).ge.avedif) then - itagi=itag(i) - benei=bene(itagi) - if(benei.gt.emax) then - emax=benei - is(imade1)=itagi - endif - endif - enddo - - if(ik.eq.0) iuse=iuse-1 - - return - end -c--------------------------------- - subroutine select_iseed_min(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - dimension itag(mxio),adiff(mxio) - - iuse=0 - avedif=0.d0 - difmax=0.d0 - do n=1,nbank - if(ibank(n).eq.ik) then - iuse=iuse+1 - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - if(diffmn.gt.difmax) difmax=diffmn - adiff(iuse)=diffmn - itag(iuse)=n - avedif=avedif+diffmn - endif - enddo - - avedif=avedif/iuse -c avedif=(avedif+difmax)/2 - emin=9.d190 - do i=1,iuse -c print *,"i, adiff(i),avedif : ",i,adiff(i),avedif - if(adiff(i).ge.avedif) then - itagi=itag(i) - benei=bene(itagi) -c print *,"i, benei,emin : ",i,benei,emin - if(benei.lt.emin) then - emin=benei - is(imade1)=itagi - endif - endif - enddo - - if(ik.eq.0) iuse=iuse-1 - -c print *, "exiting select_iseed_min",is(imade1) - - return - end -c--------------------------------- - subroutine select_iseed_far(imade1,ik) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - dmax=-9.d190 - do n=1,nbank - if(ibank(n).eq.ik) then - diffmn=9.d190 - do imade=1,imade1-1 -c m=nbank+imade -c call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff) - m=is(imade) - diff=dij(n,m) - if(diff.lt.diffmn) diffmn=diff - enddo - endif - if(diffmn.gt.dmax) then - dmax=diffmn - is(imade1)=n - endif - enddo - - return - end -c--------------------------------- - subroutine find_min - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ebmin=9.d190 - - do i=1,nbank - benei=bene(i) - if(benei.lt.ebmin) then - ebmin=benei - ibmin=i - endif - enddo - - return - end -c--------------------------------- - subroutine write_csa_pdb(var,ene,nft,ik,iw_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - integer lenpre,lenpot,ilen - external ilen - dimension var(maxvar) - character*50 titelloc - character*3 zahl - - nmin_csa=nmin_csa+1 - if(ene.lt.eglob_csa) then - eglob_csa=ene - nglob_csa=nglob_csa+1 - call numstr(nglob_csa,zahl) - - call var_to_geom(nvar,var) - call chainbuild - call secondary2(.false.) - - lenpre=ilen(prefix) - open(icsa_pdb,file=prefix(:lenpre)//'@'//zahl//'.pdb') - - if (iw_pdb.eq.1) then - write(titelloc,'(a2,i3,a3,i9,a3,i6)') - & 'GM',nglob_csa,' e ',nft,' m ',nmin_csa - else - write(titelloc,'(a2,i3,a3,i9,a3,i6,a5,f5.2,a5,f5.1)') - & 'GM',nglob_csa,' e ',nft,' m ',nmin_csa,' rms ' - & ,rmsn(ik),' %NC ',pncn(ik)*100 - endif - call pdbout(eglob_csa,titelloc,icsa_pdb) - close(icsa_pdb) - endif - - return - end -c--------------------------------- - subroutine find_max - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ebmax=-9.d190 - - do i=1,nbank - benei=bene(i) - if(benei.gt.ebmax) then - ebmax=benei - ibmax=i - endif - enddo - - return - end -c--------------------------------- - subroutine get_diff - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - - tdiff=0.d0 - difmin=9.d190 - do i1=1,nbank-1 - do i2=i1+1,nbank - 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(i1,i2)=diff - dij(i2,i1)=diff - else - diff=dij(i1,i2) - endif - tdiff=tdiff+diff - if(diff.lt.difmin) difmin=diff - enddo - dij(i1,i1)=0.0 - enddo - - do i=1,nbank - jbank(i)=1 - enddo - - avedif=tdiff/nbank/(nbank-1)*2 - - 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' - include 'COMMON.CSA' - include 'COMMON.BANK' - - ctdif1=adif/cut2 - - exponent = cutdifr*cut1/adif - exponent = dlog(exponent)/dlog(xct) - - nexp=exponent+0.25 - cutdif= adif/cut1*xct**nexp - if(cutdif.lt.ctdif1) cutdif=ctdif1 - - return - end -c--------------------------------- - subroutine get_is_max(idum,ifar,n,imade,k) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - double precision emax - - do i=imade+1,n - emax=-9.d190 - do j=1,nbank - if(ibank(j).eq.k .and. bene(j).gt.emax) then - emax=bene(j) - is(i)=j - endif - enddo - call save_is(i) - enddo - - 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 -#endif