3 c feeds tasks for parallel processing
4 implicit real*8 (a-h,o-z)
10 include 'COMMON.IOUNITS'
11 include 'COMMON.CHAIN'
12 include 'COMMON.TIME1'
13 include 'COMMON.SETUP'
16 include 'COMMON.CONTROL'
17 include 'COMMON.SBRIDGE'
19 double precision time_start,time_start_c,time0f,time0i
20 logical ovrtim,sync_iter,timeout,flag,timeout1
21 dimension muster(mpi_status_size)
22 dimension t100(0:100),indx(mxio)
23 dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9)
25 parameter (rad=1.745329252d-2)
27 cccccccccccccccccccccccccccccccccccccccccccccccc
41 if(iref.ne.0) call from_int(1,0,idum)
43 c To minimize input conformation (bank conformation)
44 c Output to $mol.reminimized
45 if (irestart.lt.0) then
46 call read_bank(0,nft,cutdifr)
47 if (irestart.lt.-10) then
49 call prune_bank(p_cut)
56 if (irestart.eq.0) then
60 if (ntbankm.eq.0) ntbank=0
69 c!bankt call read_bankt(jlee,nft,cutdifr)
70 call read_bank(jlee,nft,cutdifr)
71 call read_rbank(jlee,adif)
72 if(iref.ne.0) call from_int(1,0,idum)
76 ntrial=n1+n2+n3+n4+n5+n6+n7+n8
80 c ntrial : number of trial conformations per seed.
81 c ntry : total number of trial conformations including seed conformations.
91 call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
92 cccccccccccccccccccccccccccccccccccccccc
94 cccccccccccccccccccccccccccccccccccccccc
97 if(sync_iter) goto 333
98 idum=- ran2(idum2)*imax
99 if(jlee.lt.jstart) goto 300
101 C Restart the random number generator for conformation generation
103 if(irestart.gt.0) then
105 if(idum2.le.0) idum2=-idum2+1
106 idum=- ran2(idum2)*imax
112 open(icsa_seed,file=csa_seed,status="old")
113 write(icsa_seed,*) "jlee : ",jlee
117 write(icsa_history,*) "number of procs is ",nodes
118 write(icsa_history,*) jlee,idum,idum2
121 cccccccccccccccccccccccccccccccccccccccccccccccc
125 write(icsa_history,*) "nbank is ",nbank
128 if(irestart.eq.1) goto 111
129 if(irestart.eq.2) then
134 do i=nbank+1,nbank+nconf
139 c start energy minimization
140 nconfr=max0(nconf+nadd,nodes-1)
141 if (sync_iter) nconf_in=0
142 c king-emperor - feed input and sort output
143 write (iout,*) "NCONF_IN",nconf_in
145 if (nconf_in.gt.0) then
146 c al 7/2/00 - added possibility to read in some of the initial conformations
148 read (intin,'(i5)',end=11,err=12) iconf
150 write (iout,*) "write READ_ANGLES",iconf,m
151 call read_angles(intin,*11)
158 dihang_in(1,j,1,mm)=theta(j+1)
159 dihang_in(2,j,1,mm)=phi(j+2)
160 dihang_in(3,j,1,mm)=alph(j)
161 dihang_in(4,j,1,mm)=omeg(j)
165 11 write (iout,*) nconf_in," conformations requested, but only",
166 & m-1," found in the angle file."
170 write (iout,*) nconf_in,
171 & " initial conformations have been read in."
174 if (nconfr.gt.nconf_in) then
175 call make_ranvar(nconfr,m,idum)
176 write (iout,*) nconfr-nconf_in,
177 & " conformations have been generated randomly."
181 call from_int(nconfr,m,idum)
182 c call from_pdb(nconfr,idum)
184 write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
185 write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
187 write (iout,*) 'Initial conformation',m
188 write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
189 write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
190 write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
191 write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
193 write(iout,*)'Calling FEEDIN NCONF',nconfr
195 call feedin(nconfr,nft)
196 write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
198 write(icsa_history,*) jlee,nft,nbank
199 write(icsa_history,851) (etot(i),i=1,nconfr)
200 write(icsa_history,850) (rmsn(i),i=1,nconfr)
201 write(icsa_history,850) (pncn(i),i=1,nconfr)
202 write(icsa_history,*)
205 c To minimize input conformation (bank conformation)
206 c Output to $mol.reminimized
207 if (irestart.lt.0) then
208 call reminimize(jlee)
211 if (irestart.eq.1) goto 111
212 c soldier - perform energy minimization
218 ccccccccccccccccccccccccccccccccccc
219 c need to syncronize all procs
220 call mpi_barrier(CG_COMM,ierr)
222 print *, ' cannot synchronize MPI'
225 ccccccccccccccccccccccccccccccccccc
229 c print *,"ok after minim"
231 if(irestart.eq.2) then
233 c ntbank=ntbank+nconf
234 if(ntbank.gt.ntbankm) ntbank=ntbankm
236 c print *,"ok before indexx"
238 call indexx(nconfr,etot,indx)
244 call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
245 do k=nconf_in+1,nconfr
246 indx(k)=indx(k)+nconf_in
249 c call indexx(nconfr,rmsn,indx)
251 c print *,"ok after indexx"
254 if (m.gt.mxio .or. m.lt.1) then
255 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
256 call mpi_abort(mpi_comm_world,ierror,ierrcode)
258 jbank(im+nbank-nconf)=0
259 bene(im+nbank-nconf)=etot(m)
260 rene(im+nbank-nconf)=etot(m)
261 c!bankt btene(im)=etot(m)
263 brmsn(im+nbank-nconf)=rmsn(m)
264 bpncn(im+nbank-nconf)=pncn(m)
265 rrmsn(im+nbank-nconf)=rmsn(m)
266 rpncn(im+nbank-nconf)=pncn(m)
267 if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
268 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,
269 & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
270 call mpi_abort(mpi_comm_world,ierror,ierrcode)
275 bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
276 rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
277 c!bankt btvar(i,j,k,im)=dihang(i,j,k,m)
283 if(brmsn(im+nbank-nconf).gt.rmscut.or.
284 & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
287 bvar_ns(im+nbank-nconf)=ns-2*nss
291 do while( iss(i).ne.ihpb(j)-nres .and.
292 & iss(i).ne.jhpb(j)-nres .and. j.le.nss)
297 bvar_s(k,im+nbank-nconf)=iss(i)
301 bvar_nss(im+nbank-nconf)=nss
303 bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
304 bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
321 if(nbank.eq.nconf.and.irestart.eq.0) then
325 write (iout,*) "AVEDIF",avedif
329 cd print *,"adif,xctdif,cutdifr"
330 cd print *,adif,xctdif,cutdifr
331 nst=ntotal/ntrial/nseed
332 xctdif=(cutdif/ctdif1)**(-1.0/nst)
333 if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
334 c print *,"ok after estimate"
338 call write_rbank(jlee,adif,nft)
339 call write_bank(jlee,nft)
340 c!bankt call write_bankt(jlee,nft)
341 c call write_bank1(jlee)
343 write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
344 write(icsa_history,851) (bene(i),i=1,nbank)
345 write(icsa_history,850) (brmsn(i),i=1,nbank)
346 write(icsa_history,850) (bpncn(i),i=1,nbank)
364 if (.not.sync_iter) then
372 ccccccccccccccccccccccccccccccccccccccc
373 do while (.not. finished)
374 ccccccccccccccccccccccccccccccccccccccc
375 crc print *,"iter ", iter,' isent=',isent
378 c start energy minimization
381 c king-emperor - select seeds & make var & feed input
382 cd print *,'generating new conf',ntrial,MPI_WTIME()
383 call select_is(nseed,ifar,idum)
385 open(icsa_seed,file=csa_seed,status="old")
387 & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
390 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
391 * ebmin,ebmax,nft,iuse,nbank,ntbank
396 call make_var(ntry,idum,iter)
397 cd print *,'new trial generated',ntrial,MPI_WTIME()
399 write (iout,'(a20,i4,f12.2)')
400 & 'Time for make trial',iter+1,time2i-time1i
403 crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
404 crc call feedin(ntry,nft)
407 if (isent.ge.nodes.or.iter.gt.0) then
408 ct print *,'waiting ',MPI_WTIME()
410 call recv(0,ifrom,xout,eout,ind,timeout)
411 ct print *,' ',irecv,' received from',ifrom,MPI_WTIME()
415 movernx(irecv)=iabs(ind(5))
416 call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
420 iss_out(i,irecv)=ihpb(i)
421 jss_out(i,irecv)=jhpb(i)
425 & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
428 if(tm_score.and.eout(1).lt.ebmax) then
430 & (rmsn(irecv).le.rmscut.and.pncn(irecv).ge.pnccut))
431 & call refresh_bank_master_tmscore(ifrom,eout(1),irecv)
437 ct print *,'sending to',ifrom,MPI_WTIME()
438 call send(isent,ifrom,iter)
439 ct print *,isent,' sent ',MPI_WTIME()
441 c store results -----------------------------------------------
442 if ((isent.ge.nodes.or.iter.gt.0).and..not.tm_score) then
444 movernx(irecv)=iabs(ind(5))
445 call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
449 iss_out(i,irecv)=ihpb(i)
450 jss_out(i,irecv)=jhpb(i)
454 & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
456 c--------------------------------------------------------------
457 if (isent.eq.ntry) then
459 write (iout,'(a18,f12.2,a14,f10.2)')
460 & 'Nonsetup time ',time1i-time_start_c,
461 & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
462 write (iout,'(a14,i4,f12.2,a14,f10.2)')
463 & 'Time for iter ',iter+1,time1i-time0i,
464 & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
468 if(cutdif.lt.ctdif1) cutdif=ctdif1
470 print *,'UPDATING ',ntry-nodes+1,irecv
471 write(iout,*) 'UPDATING ',ntry-nodes+1
473 c----------------- call update(ntry-nodes+1) -------------------
474 nstep=nstep+ntry-nseed-(nodes-1)
476 ctm call refresh_bank(ntry)
480 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
485 call refresh_bank(ntry-nodes+1)
487 c!bankt call refresh_bankt(ntry-nodes+1)
489 c----------------- call update(ntry) ---------------------------
491 print *,'UPDATING ',ntry,irecv
492 write(iout,*) 'UPDATING ',ntry
493 nstep=nstep+ntry-nseed
495 ctm call refresh_bank(ntry)
499 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
504 call refresh_bank(ntry)
506 c!bankt call refresh_bankt(ntry)
508 c-----------------------------------------------------------------
510 call write_bank(jlee,nft)
511 c!bankt call write_bankt(jlee,nft)
515 write (iout,'(a20,i4,f12.2)')
516 & 'Time for refresh ',iter,time1i-time0i
518 if(ebmin.lt.estop) finished=.true.
519 if(icycle.gt.icmax) then
520 call write_bank1(jlee)
526 if(nbank.gt.nbankm) then
534 if(nstep.gt.nstmax) finished=.true.
536 if(finished.or.sync_iter) then
538 call recv(1,ifrom,xout,eout,ind,timeout)
541 print *,'ERROR worker is not responding'
542 write(iout,*) 'ERROR worker is not responding'
543 time1i=MPI_WTIME()-time_start_c
544 print *,'End of cycle, master time for ',iter,' iters ',
545 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
546 write (iout,*) 'End of cycle, master time for ',iter,
547 & ' iters ',time1i,' sec'
548 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
549 print *,'UPDATING ',ij-1
550 write(iout,*) 'UPDATING ',ij-1
552 call refresh_bank(ij-1)
553 c!bankt call refresh_bankt(ij-1)
556 c print *,'node ',ifrom,' finished ',ij,nft
557 write(iout,*) 'node ',ifrom,' finished ',ij,nft
560 movernx(ij)=iabs(ind(5))
561 call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
565 iss_out(i,ij)=ihpb(i)
566 jss_out(i,ij)=jhpb(i)
570 & call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
573 crc print *,'---------bcast finished--------',finished
574 time1i=MPI_WTIME()-time_start_c
575 print *,'End of cycle, master time for ',iter,' iters ',
576 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
577 write (iout,*) 'End of cycle, master time for ',iter,
578 & ' iters ',time1i,' sec'
579 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
581 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
582 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,
583 ctimeout & CG_COMM,ierr)
586 call mpi_issend(finished,1,mpi_logical,ij,idchar,
588 call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,
589 & CG_COMM,ireq2,ierr)
592 do while(.not. (flag .or. timeout1))
593 call MPI_TEST(ireq2,flag,muster,ierr)
595 if(tend1-tstart.gt.60) then
596 print *,'ERROR worker ',ij,' is not responding'
597 write(iout,*) 'ERROR worker ',ij,' is not responding'
602 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
605 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
608 print *,'UPDATING ',nodes-1,ij
609 write(iout,*) 'UPDATING ',nodes-1
610 call refresh_bank(nodes-1)
611 c!bankt call refresh_bankt(nodes-1)
613 call write_bank(jlee,nft)
614 c!bankt call write_bankt(jlee,nft)
619 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
624 write(iout,*)'### Total stats:'
626 if(nstatnx_tot(i,1).ne.0) then
628 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
629 & '### N',i,' total=',nstatnx_tot(i,1),
630 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
631 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
633 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
634 & '###N',i,' total=',nstatnx_tot(i,1),
635 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
636 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
640 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
641 & '### N',i,' total=',nstatnx_tot(i,1),
642 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
645 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
646 & '###N',i,' total=',nstatnx_tot(i,1),
647 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
654 if(sync_iter) goto 331
656 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
657 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
659 44 format('jlee =',i3,':',4f10.1,' E =',f15.5,i7,i10)
668 c soldier - perform energy minimization
670 print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
671 write (iout,*) 'End of minim, proc',me,'time ',
672 & MPI_WTIME()-time_start
674 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
675 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
676 call mpi_recv(finished,1,mpi_logical,0,idchar,
677 * CG_COMM,muster,ierr)
678 call mpi_recv(sync_iter,1,mpi_logical,0,idchar,
679 * CG_COMM,muster,ierr)
680 if(sync_iter) goto 331
683 ccccccccccccccccccccccccccccccccccccccc
685 ccccccccccccccccccccccccccccccccccccccc
689 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
690 * ebmin,ebmax,nft,iuse,nbank,ntbank
692 write(icsa_history,44) jlee,0.0,0.0,0.0,
693 & 0.0,ebmin,nstep,nft
694 write(icsa_history,*)
697 time1i=MPI_WTIME()-time_start
698 print *,'End of RUN, master time ',
699 & time1i,'sec, Eval/s ',(nft-nft00)/time1i
700 write (iout,*) 'End of RUN, master time ',
702 write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
705 write(iout,*) '!!!! ERROR worker was not responding'
706 write(iout,*) '!!!! cannot finish work normally'
707 write(iout,*) 'Processor0 is calling MPI_ABORT'
708 print *,'!!!! ERROR worker was not responding'
709 print *,'!!!! cannot finish work normally'
710 print *,'Processor0 is calling MPI_ABORT'
712 call mpi_abort(mpi_comm_world, 111, ierr)
716 cccccccccccccccccccccccccccccc
718 cccccccccccccccccccccccccccccc
724 c feeds tasks for parallel processing
725 implicit real*8 (a-h,o-z)
727 include 'COMMON.IOUNITS'
728 write (iout,*) "Unsupported option for the serial version"
733 c-------------------------------------------------
734 subroutine feedin(nconf,nft)
735 c sends out starting conformations and receives results of energy minimization
736 implicit real*8 (a-h,o-z)
739 include 'COMMON.IOUNITS'
740 include 'COMMON.CONTROL'
742 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
743 * cout(2),ind(9),info(12)
744 dimension muster(mpi_status_size)
745 include 'COMMON.SETUP'
746 parameter (rad=1.745329252d-2)
748 print *,'FEEDIN: NCONF=',nconf
750 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
751 if (nconf .lt. nodes-1) then
752 write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
754 write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
756 call mpi_abort(mpi_comm_world,ierror,ierrcode)
760 c pull out external and internal variables for next start
762 ! write (iout,*) 'XIN from FEEDIN N=',n
763 ! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
765 if (mm.lt.nodes) then
766 c feed task to soldier
767 ! print *, ' sending input for start # ',n
774 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
776 call mpi_send(xin,nvar,mpi_double_precision,mm,
777 * idreal,CG_COMM,ierr)
779 c find an available soldier
780 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
781 * CG_COMM,muster,ierr)
782 ! print *, ' receiving output from start # ',ind(1)
783 man=muster(mpi_source)
784 c receive final energies and variables
786 call mpi_recv(eout,1,mpi_double_precision,
787 * man,idreal,CG_COMM,muster,ierr)
790 call mpi_recv(co,1,mpi_double_precision,
791 * man,idreal,CG_COMM,muster,ierr)
792 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
794 call mpi_recv(xout,nvar,mpi_double_precision,
795 * man,idreal,CG_COMM,muster,ierr)
796 ! print *,nvar , ierr
797 c feed next task to soldier
798 ! print *, ' sending input for start # ',n
808 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
810 call mpi_send(xin,nvar,mpi_double_precision,man,
811 * idreal,CG_COMM,ierr)
812 c retrieve latest results
813 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
815 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
817 print *,"koniec petli n=",n
819 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
821 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
824 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
825 * CG_COMM,muster,ierr)
826 crc if (ierr.ne.0) go to 30
827 ! print *, ' receiving output from start # ',ind(1)
828 man=muster(mpi_source)
829 c receive final energies and variables
831 call mpi_recv(eout,1,
832 * mpi_double_precision,man,idreal,
833 * CG_COMM,muster,ierr)
836 call mpi_recv(co,1,mpi_double_precision,
837 * man,idreal,CG_COMM,muster,ierr)
838 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
840 crc if (ierr.ne.0) go to 30
841 call mpi_recv(xout,nvar,mpi_double_precision,
842 * man,idreal,CG_COMM,muster,ierr)
843 ! print *,nvar , ierr
844 crc if (ierr.ne.0) go to 30
852 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
855 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
857 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
859 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
861 10 print *, ' dispatching error'
862 call mpi_abort(mpi_comm_world,ierror,ierrcode)
864 20 print *, ' communication error'
865 call mpi_abort(mpi_comm_world,ierror,ierrcode)
867 30 print *, ' receiving error'
868 call mpi_abort(mpi_comm_world,ierror,ierrcode)
871 cccccccccccccccccccccccccccccccccccccccccccccccccc
872 subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
873 c receives and stores data from soldiers
874 implicit real*8 (a-h,o-z)
876 include 'COMMON.IOUNITS'
878 include 'COMMON.BANK'
880 include 'COMMON.CHAIN'
881 include 'COMMON.CONTACTS'
882 dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1)
884 double precision przes(3),obr(3,3)
888 if (k.gt.mxio .or. k.lt.1) then
890 & 'ERROR - dimensions of ANGMIN have been exceeded K=',k
891 call mpi_abort(mpi_comm_world,ierror,ierrcode)
899 c retrieve dihedral angles etc
900 call var_to_geom(nvar,xout)
902 dihang(1,j,1,k)=theta(j+1)
903 dihang(2,j,1,k)=phi(j+2)
904 dihang(3,j,1,k)=alph(j)
905 dihang(4,j,1,k)=omeg(j)
907 dihang(2,nres-1,1,k)=0.0d0
911 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
912 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
917 c call dihang_to_c(dihang(1,1,1,k))
918 c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
919 c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
920 c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
921 c & nsup,przes,obr,non_conv)
924 call rmsd_csa(rmsn(k))
925 call contact(.false.,ncont,icont,co)
926 pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
928 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
929 cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
930 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
931 cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
935 if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
938 cccccccccccccccccccccccccccccccccccccccccccccccccc
939 subroutine putx(xin,n,rad)
940 c gets starting variables
941 implicit real*8 (a-h,o-z)
944 include 'COMMON.BANK'
946 include 'COMMON.CHAIN'
947 include 'COMMON.IOUNITS'
948 dimension xin(maxvar)
950 c pull out starting values for variables
951 ! write (iout,*)'PUTX: N=',n
953 ! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
954 ! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
955 ! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
956 ! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
958 theta(j+1)=dihang_in(1,j,m,n)
959 phi(j+2)=dihang_in(2,j,m,n)
960 alph(j)=dihang_in(3,j,m,n)
961 omeg(j)=dihang_in(4,j,m,n)
964 c set up array of variables
965 call geom_to_var(nvar,xin)
966 ! write (iout,*) 'xin in PUTX N=',n
968 ! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
971 c--------------------------------------------------------
972 subroutine putx2(xin,iff,n)
973 c gets starting variables
974 implicit real*8 (a-h,o-z)
977 include 'COMMON.BANK'
979 include 'COMMON.CHAIN'
980 include 'COMMON.IOUNITS'
981 dimension xin(maxvar),iff(maxres)
983 c pull out starting values for variables
986 theta(j+1)=dihang_in2(1,j,m,n)
987 phi(j+2)=dihang_in2(2,j,m,n)
988 alph(j)=dihang_in2(3,j,m,n)
989 omeg(j)=dihang_in2(4,j,m,n)
992 c set up array of variables
993 call geom_to_var(nvar,xin)
1001 c-------------------------------------------------------
1002 subroutine prune_bank(p_cut)
1003 implicit real*8 (a-h,o-z)
1004 include 'DIMENSIONS'
1006 include 'COMMON.CSA'
1007 include 'COMMON.BANK'
1008 include 'COMMON.IOUNITS'
1009 include 'COMMON.CHAIN'
1010 include 'COMMON.TIME1'
1011 include 'COMMON.SETUP'
1012 c---------------------------
1013 c This subroutine prunes bank conformations using p_cut
1014 c---------------------------
1022 dihang(i,j,k,nprune)=bvar(i,j,k,m)
1026 bene(nprune)=bene(m)
1027 brmsn(nprune)=brmsn(m)
1028 bpncn(nprune)=bpncn(m)
1033 call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
1034 if(diff.lt.p_cut) goto 100
1035 if(diff.lt.ddmin) ddmin=diff
1041 dihang(i,j,k,nprune)=bvar(i,j,k,m)
1045 bene(nprune)=bene(m)
1046 brmsn(nprune)=brmsn(m)
1047 bpncn(nprune)=bpncn(m)
1049 write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
1052 print *, 'Pruning :',m,nprune,p_cut
1053 call write_bank(0,0)
1057 c-------------------------------------------------------
1059 subroutine reminimize(jlee)
1060 implicit real*8 (a-h,o-z)
1061 include 'DIMENSIONS'
1063 include 'COMMON.CSA'
1064 include 'COMMON.BANK'
1065 include 'COMMON.IOUNITS'
1066 include 'COMMON.CHAIN'
1067 include 'COMMON.TIME1'
1068 include 'COMMON.SETUP'
1069 c---------------------------
1070 c This subroutine re-minimizes bank conformations:
1071 c---------------------------
1078 if (me.eq.king) then
1079 open(icsa_history,file=csa_history,status="old")
1080 write(icsa_history,*) "Re-minimization",nodes,"nodes"
1081 write(icsa_history,851) (bene(i),i=1,nbank)
1082 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1083 * ebmin,ebmax,nft,iuse,nbank,ntbank
1089 dihang_in(i,j,k,index)=bvar(i,j,k,index)
1095 call feedin(ntry,nft)
1103 if (me.eq.king) then
1105 call replace_bvar(i,i)
1107 open(icsa_history,file=csa_history,status="old")
1108 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1109 * ebmin,ebmax,nft,iuse,nbank,ntbank
1110 write(icsa_history,851) (bene(i),i=1,nbank)
1112 call write_bank_reminimized(jlee,nft)
1115 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
1118 c 850 format(10f8.3)
1122 c-------------------------------------------------------
1123 subroutine send(n,mm,it)
1124 c sends out starting conformation for minimization
1125 implicit real*8 (a-h,o-z)
1126 include 'DIMENSIONS'
1127 include 'COMMON.VAR'
1128 include 'COMMON.IOUNITS'
1129 include 'COMMON.CONTROL'
1130 include 'COMMON.BANK'
1131 include 'COMMON.CHAIN'
1133 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1134 * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12)
1135 dimension muster(mpi_status_size)
1136 include 'COMMON.SETUP'
1137 parameter (rad=1.745329252d-2)
1139 if (isend2(n).eq.0) then
1140 c pull out external and internal variables for next start
1141 call putx(xin,n,rad)
1149 if (movenx(n).eq.14.or.movenx(n).eq.17) then
1152 else if (movenx(n).eq.16) then
1166 if (movenx(n).eq.15) then
1171 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1173 call mpi_send(xin,nvar,mpi_double_precision,mm,
1174 * idreal,CG_COMM,ierr)
1176 c distfit & minimization for n7 move
1186 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1188 call putx2(xin,iff,isend2(n))
1189 call mpi_send(xin,nvar,mpi_double_precision,mm,
1190 * idreal,CG_COMM,ierr)
1191 call mpi_send(iff,nres,mpi_integer,mm,
1192 * idint,CG_COMM,ierr)
1193 call putx(xin2,n,rad)
1194 call mpi_send(xin2,nvar,mpi_double_precision,mm,
1195 * idreal,CG_COMM,ierr)
1197 if (vdisulf.and.nss_in(n).ne.0) then
1198 call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,
1199 * idint,CG_COMM,ierr)
1200 call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,
1201 * idint,CG_COMM,ierr)
1205 c-------------------------------------------------
1207 subroutine recv(ihalt,man,xout,eout,ind,tout)
1208 c receives results of energy minimization
1209 implicit real*8 (a-h,o-z)
1210 include 'DIMENSIONS'
1211 include 'COMMON.VAR'
1212 include 'COMMON.IOUNITS'
1213 include 'COMMON.CONTROL'
1214 include 'COMMON.SBRIDGE'
1215 include 'COMMON.BANK'
1216 include 'COMMON.CHAIN'
1218 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1219 * cout(2),ind(9),info(12)
1220 dimension muster(mpi_status_size)
1221 include 'COMMON.SETUP'
1223 double precision twait,tstart,tend1
1224 parameter(twait=600.0d0)
1226 c find an available soldier
1230 do while(.not. (flag .or. tout))
1231 call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag,
1234 if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
1235 c_error if(tend1-tstart.gt.twait) tout=.true.
1238 write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
1242 man=muster(mpi_source)
1244 ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
1245 ctimeout * CG_COMM,muster,ierr)
1246 ! print *, ' receiving output from start # ',ind(1)
1247 ct print *,'receiving ',MPI_WTIME()
1248 ctimeout man=muster(mpi_source)
1249 call mpi_recv(ind,9,mpi_integer,man,idint,
1250 * CG_COMM,muster,ierr)
1252 c receive final energies and variables
1253 call mpi_recv(eout,1,mpi_double_precision,
1254 * man,idreal,CG_COMM,muster,ierr)
1257 call mpi_recv(co,1,mpi_double_precision,
1258 * man,idreal,CG_COMM,muster,ierr)
1259 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
1261 call mpi_recv(xout,nvar,mpi_double_precision,
1262 * man,idreal,CG_COMM,muster,ierr)
1263 ! print *,nvar , ierr
1264 if(vdisulf) nss=ind(6)
1265 if(vdisulf.and.nss.ne.0) then
1266 call mpi_recv(ihpb,nss,mpi_integer,
1267 * man,idint,CG_COMM,muster,ierr)
1268 call mpi_recv(jhpb,nss,mpi_integer,
1269 * man,idint,CG_COMM,muster,ierr)
1273 c print *,'sending halt to ',man
1274 write(iout,*) 'sending halt to ',man
1277 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
1282 c----------------------------------------------------------
1283 subroutine history_append
1284 implicit real*8 (a-h,o-z)
1285 include 'DIMENSIONS'
1286 include 'COMMON.IOUNITS'
1288 #if defined(AIX) || defined(PGI)
1289 open(icsa_history,file=csa_history,position="append")
1291 open(icsa_history,file=csa_history,access="append")