X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?p=unres.git;a=blobdiff_plain;f=source%2Funres%2Fsrc_CSA_DiL%2Ftogether.F;fp=source%2Funres%2Fsrc_CSA_DiL%2Ftogether.F;h=0000000000000000000000000000000000000000;hp=099c4692b7458b55df740b186a297b57c3bfe57e;hb=de4bc5453ea46e111d936cb85e1758ed21c08fcd;hpb=b75425747e3e2b448ca5e0ef8367712e1f339124 diff --git a/source/unres/src_CSA_DiL/together.F b/source/unres/src_CSA_DiL/together.F deleted file mode 100644 index 099c469..0000000 --- a/source/unres/src_CSA_DiL/together.F +++ /dev/null @@ -1,1294 +0,0 @@ -#ifdef MPI - Subroutine together -c feeds tasks for parallel processing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - real ran1,ran2 - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - real tcpu - double precision time_start,time_start_c,time0f,time0i - logical ovrtim,sync_iter,timeout,flag,timeout1 - dimension muster(mpi_status_size) - dimension t100(0:100),indx(mxio) - dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9) - dimension cout(2) - parameter (rad=1.745329252d-2) - -cccccccccccccccccccccccccccccccccccccccccccccccc - IF (ME.EQ.KING) THEN - - time0f=MPI_WTIME() - ilastnstep=1 - sync_iter=.false. - numch=1 - nrmsdb=0 - nrmsdb1=0 - rmsdbc1c=rmsdbc1 - nstep=0 - call csa_read - call make_array - - if(iref.ne.0) call from_int(1,0,idum) - -c To minimize input conformation (bank conformation) -c Output to $mol.reminimized - if (irestart.lt.0) then - call read_bank(0,nft,cutdifr) - if (irestart.lt.-10) then - p_cut=nres*4.d0 - call prune_bank(p_cut) - return - endif - call reminimize(jlee) - return - endif - - if (irestart.eq.0) then - call initial_write - nbank=nconf - ntbank=nconf - if (ntbankm.eq.0) ntbank=0 - nstep=0 - nft=0 - do i=1,mxio - ibank(i)=0 - jbank(i)=0 - enddo - else - call restart_write -c!bankt call read_bankt(jlee,nft,cutdifr) - call read_bank(jlee,nft,cutdifr) - call read_rbank(jlee,adif) - if(iref.ne.0) call from_int(1,0,idum) - endif - - nstmax=nstmax+nstep - ntrial=n1+n2+n3+n4+n5+n6+n7+n8 - ntry=ntrial+1 - ntry=ntry*nseed - -c ntrial : number of trial conformations per seed. -c ntry : total number of trial conformations including seed conformations. - - idum2=-123 -#ifdef G77 - imax=2**30-1 -#else - imax=2**31-1 -#endif - ENDIF - - call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr) -cccccccccccccccccccccccccccccccccccccccc - do 300 jlee=1,jend -cccccccccccccccccccccccccccccccccccccccc - 331 continue - IF (ME.EQ.KING) THEN - if(sync_iter) goto 333 - idum=- ran2(idum2)*imax - if(jlee.lt.jstart) goto 300 - -C Restart the random number generator for conformation generation - - if(irestart.gt.0) then - idum2=idum2+nstep - if(idum2.le.0) idum2=-idum2+1 - idum=- ran2(idum2)*imax - endif - - idumm=idum - call vrndst(idumm) - - open(icsa_seed,file=csa_seed,status="old") - write(icsa_seed,*) "jlee : ",jlee - close(icsa_seed) - - call history_append - write(icsa_history,*) "number of procs is ",nodes - write(icsa_history,*) jlee,idum,idum2 - close(icsa_history) - -cccccccccccccccccccccccccccccccccccccccccccccccc - 333 icycle=0 - - call history_append - write(icsa_history,*) "nbank is ",nbank - close(icsa_history) - - if(irestart.eq.1) goto 111 - if(irestart.eq.2) then - icycle=0 - do i=1,nbank - ibank(i)=1 - enddo - do i=nbank+1,nbank+nconf - ibank(i)=0 - enddo - endif - -c start energy minimization - nconfr=max0(nconf+nadd,nodes-1) - if (sync_iter) nconf_in=0 -c king-emperor - feed input and sort output - write (iout,*) "NCONF_IN",nconf_in - m=0 - if (nconf_in.gt.0) then -c al 7/2/00 - added possibility to read in some of the initial conformations - do m=1,nconf_in - read (intin,'(i5)',end=11,err=12) iconf - 12 continue - write (iout,*) "write READ_ANGLES",iconf,m - call read_angles(intin,*11) - if (iref.eq.0) then - mm=m - else - mm=m+1 - endif - do j=2,nres-1 - dihang_in(1,j,1,mm)=theta(j+1) - dihang_in(2,j,1,mm)=phi(j+2) - dihang_in(3,j,1,mm)=alph(j) - dihang_in(4,j,1,mm)=omeg(j) - enddo - enddo ! m - goto 13 - 11 write (iout,*) nconf_in," conformations requested, but only", - & m-1," found in the angle file." - nconf_in=m-1 - 13 continue - m=nconf_in - write (iout,*) nconf_in, - & " initial conformations have been read in." - endif - if (iref.eq.0) then - if (nconfr.gt.nconf_in) then - call make_ranvar(nconfr,m,idum) - write (iout,*) nconfr-nconf_in, - & " conformations have been generated randomly." - endif - else - nconfr=nconfr*2 - call from_int(nconfr,m,idum) -c call from_pdb(nconfr,idum) - endif - write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr - write (*,*) 'Exitted from make_ranvar nconfr=',nconfr - do m=1,nconfr - write (iout,*) 'Initial conformation',m - write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1) - enddo - write(iout,*)'Calling FEEDIN NCONF',nconfr - time1i=MPI_WTIME() - call feedin(nconfr,nft) - write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i - call history_append - write(icsa_history,*) jlee,nft,nbank - write(icsa_history,851) (etot(i),i=1,nconfr) - write(icsa_history,850) (rmsn(i),i=1,nconfr) - write(icsa_history,850) (pncn(i),i=1,nconfr) - write(icsa_history,*) - close(icsa_history) - ELSE -c To minimize input conformation (bank conformation) -c Output to $mol.reminimized - if (irestart.lt.0) then - call reminimize(jlee) - return - endif - if (irestart.eq.1) goto 111 -c soldier - perform energy minimization - 334 call minim_jlee - - - ENDIF - -ccccccccccccccccccccccccccccccccccc -c need to syncronize all procs - call mpi_barrier(CG_COMM,ierr) - if (ierr.ne.0) then - print *, ' cannot synchronize MPI' - stop - endif -ccccccccccccccccccccccccccccccccccc - - IF (ME.EQ.KING) THEN - -c print *,"ok after minim" - nstep=nstep+nconf - if(irestart.eq.2) then - nbank=nbank+nconf -c ntbank=ntbank+nconf - if(ntbank.gt.ntbankm) ntbank=ntbankm - endif -c print *,"ok before indexx" - if(iref.eq.0) then - call indexx(nconfr,etot,indx) - else -c cc/al 7/6/00 - do k=1,nconfr - indx(k)=k - enddo - call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1)) - do k=nconf_in+1,nconfr - indx(k)=indx(k)+nconf_in - enddo -c cc/al -c call indexx(nconfr,rmsn,indx) - endif -c print *,"ok after indexx" - do im=1,nconf - m=indx(im) - if (m.gt.mxio .or. m.lt.1) then - write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - jbank(im+nbank-nconf)=0 - bene(im+nbank-nconf)=etot(m) - rene(im+nbank-nconf)=etot(m) -c!bankt btene(im)=etot(m) -c - brmsn(im+nbank-nconf)=rmsn(m) - bpncn(im+nbank-nconf)=pncn(m) - rrmsn(im+nbank-nconf)=rmsn(m) - rpncn(im+nbank-nconf)=pncn(m) - if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then - write (iout,*) 'Dimension ERROR in TOGEHER: IM',im, - & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf - 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,im+nbank-nconf)=dihang(i,j,k,m) - rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m) -c!bankt btvar(i,j,k,im)=dihang(i,j,k,m) -c - enddo - enddo - enddo - if(iref.eq.1) then - if(brmsn(im+nbank-nconf).gt.rmscut.or. - & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9 - endif - if(vdisulf) then - bvar_ns(im+nbank-nconf)=ns-2*nss - k=0 - do i=1,ns - j=1 - do while( iss(i).ne.ihpb(j)-nres .and. - & iss(i).ne.jhpb(j)-nres .and. j.le.nss) - j=j+1 - enddo - if (j.gt.nss) then - k=k+1 - bvar_s(k,im+nbank-nconf)=iss(i) - endif - enddo - endif - bvar_nss(im+nbank-nconf)=nss - do i=1,nss - bvar_ss(1,i,im+nbank-nconf)=ihpb(i) - bvar_ss(2,i,im+nbank-nconf)=jhpb(i) - enddo - enddo - ENDIF - - 111 continue - - IF (ME.EQ.KING) THEN - - call find_max - call find_min - - if (tm_score) then - call get_diff_p - else - call get_diff - endif - if(nbank.eq.nconf.and.irestart.eq.0) then - adif=avedif - endif - - write (iout,*) "AVEDIF",avedif - cutdif=adif/cut1 - ctdif1=adif/cut2 - -cd print *,"adif,xctdif,cutdifr" -cd print *,adif,xctdif,cutdifr - nst=ntotal/ntrial/nseed - xctdif=(cutdif/ctdif1)**(-1.0/nst) - if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr) -c print *,"ok after estimate" - - irestart=0 - - call write_rbank(jlee,adif,nft) - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) -c call write_bank1(jlee) - call history_append - write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1 - write(icsa_history,851) (bene(i),i=1,nbank) - write(icsa_history,850) (brmsn(i),i=1,nbank) - write(icsa_history,850) (bpncn(i),i=1,nbank) - close(icsa_history) - 850 format(10f8.3) - 851 format(5e15.6) - - ifar=nseed/4*3+1 - ifar=nseed+1 - ENDIF - - - finished=.false. - iter = 0 - irecv = 0 - isent =0 - ifrom= 0 - time0i=MPI_WTIME() - time1i=time0i - time_start_c=time0i - if (.not.sync_iter) then - time_start=time0i - nft00=nft - else - sync_iter=.false. - endif - nft00_c=nft - nft0i=nft -ccccccccccccccccccccccccccccccccccccccc - do while (.not. finished) -ccccccccccccccccccccccccccccccccccccccc -crc print *,"iter ", iter,' isent=',isent - - IF (ME.EQ.KING) THEN -c start energy minimization - - if (isent.eq.0) then -c king-emperor - select seeds & make var & feed input -cd print *,'generating new conf',ntrial,MPI_WTIME() - call select_is(nseed,ifar,idum) - - open(icsa_seed,file=csa_seed,status="old") - write(icsa_seed,39) - & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed) - close(icsa_seed) - call history_append - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - close(icsa_history) - - - - call make_var(ntry,idum,iter) -cd print *,'new trial generated',ntrial,MPI_WTIME() - time2i=MPI_WTIME() - write (iout,'(a20,i4,f12.2)') - & 'Time for make trial',iter+1,time2i-time1i - endif - -crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial -crc call feedin(ntry,nft) - - isent=isent+1 - if (isent.ge.nodes.or.iter.gt.0) then -ct print *,'waiting ',MPI_WTIME() - irecv=irecv+1 - call recv(0,ifrom,xout,eout,ind,timeout) -ct print *,' ',irecv,' received from',ifrom,MPI_WTIME() - - if(tm_score) then - nft=nft+ind(3) - movernx(irecv)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,irecv) - if(vdisulf) then - nss_out(irecv)=nss - do i=1,nss - iss_out(i,irecv)=ihpb(i) - jss_out(i,irecv)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb) - endif - - if(tm_score.and.eout(1).lt.ebmax) then - if(iref.eq.0 .or. - & (rmsn(irecv).le.rmscut.and.pncn(irecv).ge.pnccut)) - & call refresh_bank_master_tmscore(ifrom,eout(1),irecv) - endif - else - ifrom=ifrom+1 - endif - -ct print *,'sending to',ifrom,MPI_WTIME() - call send(isent,ifrom,iter) -ct print *,isent,' sent ',MPI_WTIME() - -c store results ----------------------------------------------- - if ((isent.ge.nodes.or.iter.gt.0).and..not.tm_score) then - nft=nft+ind(3) - movernx(irecv)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,irecv) - if(vdisulf) then - nss_out(irecv)=nss - do i=1,nss - iss_out(i,irecv)=ihpb(i) - jss_out(i,irecv)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb) - endif -c-------------------------------------------------------------- - if (isent.eq.ntry) then - time1i=MPI_WTIME() - write (iout,'(a18,f12.2,a14,f10.2)') - & 'Nonsetup time ',time1i-time_start_c, - & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c) - write (iout,'(a14,i4,f12.2,a14,f10.2)') - & 'Time for iter ',iter+1,time1i-time0i, - & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i) - time0i=time1i - nft0i=nft - cutdif=cutdif*xctdif - if(cutdif.lt.ctdif1) cutdif=ctdif1 - if (iter.eq.0) then - print *,'UPDATING ',ntry-nodes+1,irecv - write(iout,*) 'UPDATING ',ntry-nodes+1 - iter=iter+1 -c----------------- call update(ntry-nodes+1) ------------------- - nstep=nstep+ntry-nseed-(nodes-1) - if (tm_score) then -ctm call refresh_bank(ntry) - call print_mv_stat - 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 - else - call refresh_bank(ntry-nodes+1) - endif -c!bankt call refresh_bankt(ntry-nodes+1) - else -c----------------- call update(ntry) --------------------------- - iter=iter+1 - print *,'UPDATING ',ntry,irecv - write(iout,*) 'UPDATING ',ntry - nstep=nstep+ntry-nseed - if (tm_score) then -ctm call refresh_bank(ntry) - call print_mv_stat - 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 - else - call refresh_bank(ntry) - endif -c!bankt call refresh_bankt(ntry) - endif -c----------------------------------------------------------------- - - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) - call find_min - - time1i=MPI_WTIME() - write (iout,'(a20,i4,f12.2)') - & 'Time for refresh ',iter,time1i-time0i - - if(ebmin.lt.estop) finished=.true. - if(icycle.gt.icmax) then - call write_bank1(jlee) - do i=1,nbank -c ibank(i)=2 - ibank(i)=1 - enddo - nbank=nbank+nconf - if(nbank.gt.nbankm) then - nbank=nbank-nconf - finished=.true. - else -crc goto 333 - sync_iter=.true. - endif - endif - if(nstep.gt.nstmax) finished=.true. - - if(finished.or.sync_iter) then - do ij=1,nodes-1 - call recv(1,ifrom,xout,eout,ind,timeout) - if (timeout) then - nstep=nstep+ij-1 - print *,'ERROR worker is not responding' - write(iout,*) 'ERROR worker is not responding' - time1i=MPI_WTIME()-time_start_c - print *,'End of cycle, master time for ',iter,' iters ', - & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i - write (iout,*) 'End of cycle, master time for ',iter, - & ' iters ',time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i - print *,'UPDATING ',ij-1 - write(iout,*) 'UPDATING ',ij-1 - call flush(iout) - call refresh_bank(ij-1) -c!bankt call refresh_bankt(ij-1) - goto 1002 - endif -c print *,'node ',ifrom,' finished ',ij,nft - write(iout,*) 'node ',ifrom,' finished ',ij,nft - call flush(iout) - nft=nft+ind(3) - movernx(ij)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,ij) - if(vdisulf) then - nss_out(ij)=nss - do i=1,nss - iss_out(i,ij)=ihpb(i) - jss_out(i,ij)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ij,iw_pdb) - enddo - nstep=nstep+nodes-1 -crc print *,'---------bcast finished--------',finished - time1i=MPI_WTIME()-time_start_c - print *,'End of cycle, master time for ',iter,' iters ', - & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i - write (iout,*) 'End of cycle, master time for ',iter, - & ' iters ',time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i - -ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr) -ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0, -ctimeout & CG_COMM,ierr) - do ij=1,nodes-1 - tstart=MPI_WTIME() - call mpi_issend(finished,1,mpi_logical,ij,idchar, - & CG_COMM,ireq,ierr) - call mpi_issend(sync_iter,1,mpi_logical,ij,idchar, - & CG_COMM,ireq2,ierr) - flag=.false. - timeout1=.false. - do while(.not. (flag .or. timeout1)) - call MPI_TEST(ireq2,flag,muster,ierr) - tend1=MPI_WTIME() - if(tend1-tstart.gt.60) then - print *,'ERROR worker ',ij,' is not responding' - write(iout,*) 'ERROR worker ',ij,' is not responding' - timeout1=.true. - endif - enddo - if(timeout1) then - write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart - timeout=.true. - else - write(iout,*) 'worker ',ij,' OK ',tend1-tstart - endif - enddo - print *,'UPDATING ',nodes-1,ij - write(iout,*) 'UPDATING ',nodes-1 - call refresh_bank(nodes-1) -c!bankt call refresh_bankt(nodes-1) - 1002 continue - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) - call find_min - - 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 - - write(iout,*)'### Total stats:' - do i=0,mxmv - if(nstatnx_tot(i,1).ne.0) then - if (i.le.9) then - write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '### N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc', - & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1) - else - write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '###N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc', - & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1) - endif - else - if (i.le.9) then - write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '### N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3), - & ' %acc',0.0 - else - write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '###N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3), - & ' %acc',0.0 - endif - endif - enddo - - endif - if(sync_iter) goto 331 - - 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x))) - 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4) - 43 format(10i8) - 44 format('jlee =',i3,':',4f10.1,' E =',f15.5,i7,i10) - - isent=0 - irecv=0 - endif - ELSE - if (tm_score) then - call get_diff_p - endif -c soldier - perform energy minimization - call minim_jlee - print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start - write (iout,*) 'End of minim, proc',me,'time ', - & MPI_WTIME()-time_start - call flush(iout) -ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr) -ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr) - call mpi_recv(finished,1,mpi_logical,0,idchar, - * CG_COMM,muster,ierr) - call mpi_recv(sync_iter,1,mpi_logical,0,idchar, - * CG_COMM,muster,ierr) - if(sync_iter) goto 331 - ENDIF - -ccccccccccccccccccccccccccccccccccccccc - enddo -ccccccccccccccccccccccccccccccccccccccc - - IF (ME.EQ.KING) THEN - call history_append - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - - write(icsa_history,44) jlee,0.0,0.0,0.0, - & 0.0,ebmin,nstep,nft - write(icsa_history,*) - close(icsa_history) - - time1i=MPI_WTIME()-time_start - print *,'End of RUN, master time ', - & time1i,'sec, Eval/s ',(nft-nft00)/time1i - write (iout,*) 'End of RUN, master time ', - & time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00)/time1i - - if(timeout) then - write(iout,*) '!!!! ERROR worker was not responding' - write(iout,*) '!!!! cannot finish work normally' - write(iout,*) 'Processor0 is calling MPI_ABORT' - print *,'!!!! ERROR worker was not responding' - print *,'!!!! cannot finish work normally' - print *,'Processor0 is calling MPI_ABORT' - call flush(iout) - call mpi_abort(mpi_comm_world, 111, ierr) - endif - ENDIF - -cccccccccccccccccccccccccccccc - 300 continue -cccccccccccccccccccccccccccccc - - return - end -#else - Subroutine together -c feeds tasks for parallel processing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - write (iout,*) "Unsupported option for the serial version" - return - end -#endif -#ifdef MPI -c------------------------------------------------- - subroutine feedin(nconf,nft) -c sends out starting conformations and receives results of energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(9),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - parameter (rad=1.745329252d-2) - - print *,'FEEDIN: NCONF=',nconf - mm=0 -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - if (nconf .lt. nodes-1) then - write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1', - & nconf,nodes-1 - write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1', - & nconf,nodes-1 - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do n=1,nconf -c pull out external and internal variables for next start - call putx(xin,n,rad) -! write (iout,*) 'XIN from FEEDIN N=',n -! write(iout,'(8f10.4)') (xin(j),j=1,nvar) - mm=mm+1 - if (mm.lt.nodes) then -c feed task to soldier -! print *, ' sending input for start # ',n - info(1)=n - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - else -c find an available soldier - call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) -! print *, ' receiving output from start # ',ind(1) - man=muster(mpi_source) -c receive final energies and variables - nft=nft+ind(3) - call mpi_recv(eout,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr -c feed next task to soldier -! print *, ' sending input for start # ',n - info(1)=n - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - info(7)=0 - info(8)=0 - info(9)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) -c retrieve latest results - call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1)) - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb) - endif - enddo -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c no more input -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - do j=1,nodes-1 -c wait for a soldier - call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) -crc if (ierr.ne.0) go to 30 -! print *, ' receiving output from start # ',ind(1) - man=muster(mpi_source) -c receive final energies and variables - nft=nft+ind(3) - call mpi_recv(eout,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif -crc if (ierr.ne.0) go to 30 - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr -crc if (ierr.ne.0) go to 30 -c halt soldier - info(1)=0 - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM, - * ierr) -c retrieve results - call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1)) - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb) - enddo -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - return - 10 print *, ' dispatching error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 20 print *, ' communication error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 30 print *, ' receiving error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - end -cccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k) -c receives and stores data from soldiers - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1) - dimension cout(2) -cjlee - double precision przes(3),obr(3,3) - logical non_conv -cjlee - iw_pdb=2 - if (k.gt.mxio .or. k.lt.1) then - write (iout,*) - & 'ERROR - dimensions of ANGMIN have been exceeded K=',k - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -c store ind() - do j=1,9 - indb(k,j)=ind(j) - enddo -c store energies - etot(k)=eout(1) -c retrieve dihedral angles etc - call var_to_geom(nvar,xout) - do j=2,nres-1 - dihang(1,j,1,k)=theta(j+1) - dihang(2,j,1,k)=phi(j+2) - dihang(3,j,1,k)=alph(j) - dihang(4,j,1,k)=omeg(j) - enddo - dihang(2,nres-1,1,k)=0.0d0 -cjlee - if(iref.eq.0) then - iw_pdb=1 -cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)') -cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ', -cd & ind(5),ind(4) - return - endif - call chainbuild -c call dihang_to_c(dihang(1,1,1,k)) -c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv) -c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv) -c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup), -c & nsup,przes,obr,non_conv) -c rmsn(k)=dsqrt(rms) - - call rmsd_csa(rmsn(k)) - call contact(.false.,ncont,icont,co) - pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref) - -cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5 -cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)') -cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ', -cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ', -cd & ind(5),ind(4) - - - if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0 - return - end -cccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine putx(xin,n,rad) -c gets starting variables - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - dimension xin(maxvar) - -c pull out starting values for variables -! write (iout,*)'PUTX: N=',n - do m=1,numch -! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1) - do j=2,nres-1 - theta(j+1)=dihang_in(1,j,m,n) - phi(j+2)=dihang_in(2,j,m,n) - alph(j)=dihang_in(3,j,m,n) - omeg(j)=dihang_in(4,j,m,n) - enddo - enddo -c set up array of variables - call geom_to_var(nvar,xin) -! write (iout,*) 'xin in PUTX N=',n -! call intout -! write (iout,'(8f10.4)') (xin(i),i=1,nvar) - return - end -c-------------------------------------------------------- - subroutine putx2(xin,iff,n) -c gets starting variables - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - dimension xin(maxvar),iff(maxres) - -c pull out starting values for variables - do m=1,numch - do j=2,nres-1 - theta(j+1)=dihang_in2(1,j,m,n) - phi(j+2)=dihang_in2(2,j,m,n) - alph(j)=dihang_in2(3,j,m,n) - omeg(j)=dihang_in2(4,j,m,n) - enddo - enddo -c set up array of variables - call geom_to_var(nvar,xin) - - do i=1,nres - iff(i)=iff_in(i,n) - enddo - return - end - -c------------------------------------------------------- - subroutine prune_bank(p_cut) - 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.TIME1' - include 'COMMON.SETUP' -c--------------------------- -c This subroutine prunes bank conformations using p_cut -c--------------------------- - - nprune=0 - nprune=nprune+1 - m=1 - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang(i,j,k,nprune)=bvar(i,j,k,m) - enddo - enddo - enddo - bene(nprune)=bene(m) - brmsn(nprune)=brmsn(m) - bpncn(nprune)=bpncn(m) - - do m=2,nbank - ddmin=9.d190 - do ip=1,nprune - call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff) - if(diff.lt.p_cut) goto 100 - if(diff.lt.ddmin) ddmin=diff - enddo - nprune=nprune+1 - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang(i,j,k,nprune)=bvar(i,j,k,m) - enddo - enddo - enddo - bene(nprune)=bene(m) - brmsn(nprune)=brmsn(m) - bpncn(nprune)=bpncn(m) - 100 continue - write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin - enddo - nbank=nprune - print *, 'Pruning :',m,nprune,p_cut - call write_bank(0,0) - - return - end -c------------------------------------------------------- - - subroutine reminimize(jlee) - 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.TIME1' - include 'COMMON.SETUP' -c--------------------------- -c This subroutine re-minimizes bank conformations: -c--------------------------- - - ntry=nbank - - call find_max - call find_min - - if (me.eq.king) then - open(icsa_history,file=csa_history,status="old") - write(icsa_history,*) "Re-minimization",nodes,"nodes" - write(icsa_history,851) (bene(i),i=1,nbank) - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - close(icsa_history) - do index=1,ntry - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,index) - enddo - enddo - enddo - enddo - nft=0 - call feedin(ntry,nft) - else - call minim_jlee - endif - - call find_max - call find_min - - if (me.eq.king) then - do i=1,ntry - call replace_bvar(i,i) - enddo - open(icsa_history,file=csa_history,status="old") - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - write(icsa_history,851) (bene(i),i=1,nbank) - close(icsa_history) - call write_bank_reminimized(jlee,nft) - endif - - 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4) - 851 format(5e15.6) - 850 format(5e15.10) -c 850 format(10f8.3) - - return - end -c------------------------------------------------------- - subroutine send(n,mm,it) -c sends out starting conformation for minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - parameter (rad=1.745329252d-2) - - if (isend2(n).eq.0) then -c pull out external and internal variables for next start - call putx(xin,n,rad) - info(1)=n - info(2)=it - info(3)=movenx(n) - info(4)=nss_in(n) - info(5)=parent(1,n) - info(6)=parent(2,n) - - if (movenx(n).eq.14.or.movenx(n).eq.17) then - info(7)=idata(1,n) - info(8)=idata(2,n) - else if (movenx(n).eq.16) then - info(7)=idata(1,n) - info(8)=idata(2,n) - info(10)=idata(3,n) - info(11)=idata(4,n) - info(12)=idata(5,n) - else - info(7)=0 - info(8)=0 - info(10)=0 - info(11)=0 - info(12)=0 - endif - - if (movenx(n).eq.15) then - info(9)=parent(3,n) - else - info(9)=0 - endif - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - else -c distfit & minimization for n7 move - info(1)=-n - info(2)=it - info(3)=movenx(n) - info(4)=nss_in(n) - info(5)=parent(1,n) - info(6)=parent(2,n) - info(7)=0 - info(8)=0 - info(9)=0 - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call putx2(xin,iff,isend2(n)) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(iff,nres,mpi_integer,mm, - * idint,CG_COMM,ierr) - call putx(xin2,n,rad) - call mpi_send(xin2,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - endif - if (vdisulf.and.nss_in(n).ne.0) then - call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm, - * idint,CG_COMM,ierr) - call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm, - * idint,CG_COMM,ierr) - endif - return - end -c------------------------------------------------- - - subroutine recv(ihalt,man,xout,eout,ind,tout) -c receives results of energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(9),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - logical tout,flag - double precision twait,tstart,tend1 - parameter(twait=600.0d0) - -c find an available soldier - tout=.false. - flag=.false. - tstart=MPI_WTIME() - do while(.not. (flag .or. tout)) - call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag, - * muster,ierr) - tend1=MPI_WTIME() - if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true. -c_error if(tend1-tstart.gt.twait) tout=.true. - enddo - if (tout) then - write(iout,*) 'ERROR = timeout for recv ',tend1-tstart - call flush(iout) - return - endif - man=muster(mpi_source) - -ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, -ctimeout * CG_COMM,muster,ierr) -! print *, ' receiving output from start # ',ind(1) -ct print *,'receiving ',MPI_WTIME() -ctimeout man=muster(mpi_source) - call mpi_recv(ind,9,mpi_integer,man,idint, - * CG_COMM,muster,ierr) -ctimeout -c receive final energies and variables - call mpi_recv(eout,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr - if(vdisulf) nss=ind(6) - if(vdisulf.and.nss.ne.0) then - call mpi_recv(ihpb,nss,mpi_integer, - * man,idint,CG_COMM,muster,ierr) - call mpi_recv(jhpb,nss,mpi_integer, - * man,idint,CG_COMM,muster,ierr) - endif -c halt soldier - if(ihalt.eq.1) then -c print *,'sending halt to ',man - write(iout,*) 'sending halt to ',man - info(1)=0 - info(2)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr) - endif - return - end - -c---------------------------------------------------------- - subroutine history_append - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - -#if defined(AIX) || defined(PGI) - open(icsa_history,file=csa_history,position="append") -#else - open(icsa_history,file=csa_history,access="append") -#endif - return - end -#endif