+++ /dev/null
-#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
projects / unres.git / blobdiff