2 c feeds tasks for parallel processing
3 implicit real*8 (a-h,o-z)
9 include 'COMMON.IOUNITS'
10 include 'COMMON.CHAIN'
11 include 'COMMON.TIME1'
12 include 'COMMON.SETUP'
15 include 'COMMON.CONTROL'
16 include 'COMMON.SBRIDGE'
18 double precision time_start,time_start_c,time0f,time0i
19 logical ovrtim,sync_iter,timeout,flag,timeout1
20 dimension muster(mpi_status_size)
21 dimension t100(0:100),indx(mxio)
22 dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9)
24 parameter (rad=1.745329252d-2)
26 cccccccccccccccccccccccccccccccccccccccccccccccc
40 if(iref.ne.0) call from_int(1,0,idum)
42 c To minimize input conformation (bank conformation)
43 c Output to $mol.reminimized
44 if (irestart.lt.0) then
45 call read_bank(0,nft,cutdifr)
46 if (irestart.lt.-10) then
48 call prune_bank(p_cut)
55 if (irestart.eq.0) then
59 if (ntbankm.eq.0) ntbank=0
68 c!bankt call read_bankt(jlee,nft,cutdifr)
69 call read_bank(jlee,nft,cutdifr)
70 call read_rbank(jlee,adif)
71 if(iref.ne.0) call from_int(1,0,idum)
75 ntrial=n1+n2+n3+n4+n5+n6+n7+n8
79 c ntrial : number of trial conformations per seed.
80 c ntry : total number of trial conformations including seed conformations.
87 call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
88 cccccccccccccccccccccccccccccccccccccccc
90 cccccccccccccccccccccccccccccccccccccccc
93 if(sync_iter) goto 333
94 idum=- ran2(idum2)*imax
95 if(jlee.lt.jstart) goto 300
97 C Restart the random number generator for conformation generation
99 if(irestart.gt.0) then
101 if(idum2.le.0) idum2=-idum2+1
102 idum=- ran2(idum2)*imax
108 open(icsa_seed,file=csa_seed,status="old")
109 write(icsa_seed,*) "jlee : ",jlee
113 write(icsa_history,*) "number of procs is ",nodes
114 write(icsa_history,*) jlee,idum,idum2
117 cccccccccccccccccccccccccccccccccccccccccccccccc
121 write(icsa_history,*) "nbank is ",nbank
124 if(irestart.eq.1) goto 111
125 if(irestart.eq.2) then
130 do i=nbank+1,nbank+nconf
135 c start energy minimization
136 nconfr=max0(nconf+nadd,nodes-1)
137 if (sync_iter) nconf_in=0
138 c king-emperor - feed input and sort output
139 write (iout,*) "NCONF_IN",nconf_in
141 if (nconf_in.gt.0) then
142 c al 7/2/00 - added possibility to read in some of the initial conformations
144 read (intin,'(i5)',end=11,err=12) iconf
146 write (iout,*) "write READ_ANGLES",iconf,m
147 call read_angles(intin,*11)
154 dihang_in(1,j,1,mm)=theta(j+1)
155 dihang_in(2,j,1,mm)=phi(j+2)
156 dihang_in(3,j,1,mm)=alph(j)
157 dihang_in(4,j,1,mm)=omeg(j)
161 11 write (iout,*) nconf_in," conformations requested, but only",
162 & m-1," found in the angle file."
166 write (iout,*) nconf_in,
167 & " initial conformations have been read in."
170 if (nconfr.gt.nconf_in) then
171 call make_ranvar(nconfr,m,idum)
172 write (iout,*) nconfr-nconf_in,
173 & " conformations have been generated randomly."
177 call from_int(nconfr,m,idum)
178 c call from_pdb(nconfr,idum)
180 write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
181 write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
183 write (iout,*) 'Initial conformation',m
184 write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
185 write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
186 write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
187 write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
189 write(iout,*)'Calling FEEDIN NCONF',nconfr
191 call feedin(nconfr,nft)
192 write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
194 write(icsa_history,*) jlee,nft,nbank
195 write(icsa_history,851) (etot(i),i=1,nconfr)
196 write(icsa_history,850) (rmsn(i),i=1,nconfr)
197 write(icsa_history,850) (pncn(i),i=1,nconfr)
198 write(icsa_history,*)
201 c To minimize input conformation (bank conformation)
202 c Output to $mol.reminimized
203 if (irestart.lt.0) then
204 call reminimize(jlee)
207 if (irestart.eq.1) goto 111
208 c soldier - perform energy minimization
212 ccccccccccccccccccccccccccccccccccc
213 c need to syncronize all procs
214 call mpi_barrier(CG_COMM,ierr)
216 print *, ' cannot synchronize MPI'
219 ccccccccccccccccccccccccccccccccccc
223 c print *,"ok after minim"
225 if(irestart.eq.2) then
227 c ntbank=ntbank+nconf
228 if(ntbank.gt.ntbankm) ntbank=ntbankm
230 c print *,"ok before indexx"
232 call indexx(nconfr,etot,indx)
238 call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
239 do k=nconf_in+1,nconfr
240 indx(k)=indx(k)+nconf_in
243 c call indexx(nconfr,rmsn,indx)
245 c print *,"ok after indexx"
248 if (m.gt.mxio .or. m.lt.1) then
249 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
250 call mpi_abort(mpi_comm_world,ierror,ierrcode)
252 jbank(im+nbank-nconf)=0
253 bene(im+nbank-nconf)=etot(m)
254 rene(im+nbank-nconf)=etot(m)
255 c!bankt btene(im)=etot(m)
257 brmsn(im+nbank-nconf)=rmsn(m)
258 bpncn(im+nbank-nconf)=pncn(m)
259 rrmsn(im+nbank-nconf)=rmsn(m)
260 rpncn(im+nbank-nconf)=pncn(m)
261 if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
262 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,
263 & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
264 call mpi_abort(mpi_comm_world,ierror,ierrcode)
269 bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
270 rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
271 c!bankt btvar(i,j,k,im)=dihang(i,j,k,m)
277 if(brmsn(im+nbank-nconf).gt.rmscut.or.
278 & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
281 bvar_ns(im+nbank-nconf)=ns-2*nss
285 do while( iss(i).ne.ihpb(j)-nres .and.
286 & iss(i).ne.jhpb(j)-nres .and. j.le.nss)
291 bvar_s(k,im+nbank-nconf)=iss(i)
295 bvar_nss(im+nbank-nconf)=nss
297 bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
298 bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
311 if(nbank.eq.nconf.and.irestart.eq.0) then
318 cd print *,"adif,xctdif,cutdifr"
319 cd print *,adif,xctdif,cutdifr
320 nst=ntotal/ntrial/nseed
321 xctdif=(cutdif/ctdif1)**(-1.0/nst)
322 if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
323 c print *,"ok after estimate"
327 call write_rbank(jlee,adif,nft)
328 call write_bank(jlee,nft)
329 c!bankt call write_bankt(jlee,nft)
330 c call write_bank1(jlee)
332 write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
333 write(icsa_history,851) (bene(i),i=1,nbank)
334 write(icsa_history,850) (brmsn(i),i=1,nbank)
335 write(icsa_history,850) (bpncn(i),i=1,nbank)
353 if (.not.sync_iter) then
361 ccccccccccccccccccccccccccccccccccccccc
362 do while (.not. finished)
363 ccccccccccccccccccccccccccccccccccccccc
364 crc print *,"iter ", iter,' isent=',isent
367 c start energy minimization
370 c king-emperor - select seeds & make var & feed input
371 cd print *,'generating new conf',ntrial,MPI_WTIME()
372 call select_is(nseed,ifar,idum)
374 open(icsa_seed,file=csa_seed,status="old")
376 & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
379 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
380 * ebmin,ebmax,nft,iuse,nbank,ntbank
385 call make_var(ntry,idum,iter)
386 cd print *,'new trial generated',ntrial,MPI_WTIME()
388 write (iout,'(a20,i4,f12.2)')
389 & 'Time for make trial',iter+1,time2i-time1i
392 crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
393 crc call feedin(ntry,nft)
396 if (isent.ge.nodes.or.iter.gt.0) then
397 ct print *,'waiting ',MPI_WTIME()
399 call recv(0,ifrom,xout,eout,ind,timeout)
400 ct print *,' ',irecv,' received from',ifrom,MPI_WTIME()
405 ct print *,'sending to',ifrom,MPI_WTIME()
406 call send(isent,ifrom,iter)
407 ct print *,isent,' sent ',MPI_WTIME()
409 c store results -----------------------------------------------
410 if (isent.ge.nodes.or.iter.gt.0) then
412 movernx(irecv)=iabs(ind(5))
413 call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
417 iss_out(i,irecv)=ihpb(i)
418 jss_out(i,irecv)=jhpb(i)
422 & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
424 c--------------------------------------------------------------
425 if (isent.eq.ntry) then
427 write (iout,'(a18,f12.2,a14,f10.2)')
428 & 'Nonsetup time ',time1i-time_start_c,
429 & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
430 write (iout,'(a14,i4,f12.2,a14,f10.2)')
431 & 'Time for iter ',iter+1,time1i-time0i,
432 & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
436 if(cutdif.lt.ctdif1) cutdif=ctdif1
438 print *,'UPDATING ',ntry-nodes+1,irecv
439 write(iout,*) 'UPDATING ',ntry-nodes+1
441 c----------------- call update(ntry-nodes+1) -------------------
442 nstep=nstep+ntry-nseed-(nodes-1)
443 call refresh_bank(ntry-nodes+1)
444 c!bankt call refresh_bankt(ntry-nodes+1)
446 c----------------- call update(ntry) ---------------------------
448 print *,'UPDATING ',ntry,irecv
449 write(iout,*) 'UPDATING ',ntry
450 nstep=nstep+ntry-nseed
451 call refresh_bank(ntry)
452 c!bankt call refresh_bankt(ntry)
454 c-----------------------------------------------------------------
456 call write_bank(jlee,nft)
457 c!bankt call write_bankt(jlee,nft)
461 write (iout,'(a20,i4,f12.2)')
462 & 'Time for refresh ',iter,time1i-time0i
464 if(ebmin.lt.estop) finished=.true.
465 if(icycle.gt.icmax) then
466 call write_bank1(jlee)
472 if(nbank.gt.1000) then
479 if(nstep.gt.nstmax) finished=.true.
481 if(finished.or.sync_iter) then
483 call recv(1,ifrom,xout,eout,ind,timeout)
486 print *,'ERROR worker is not responding'
487 write(iout,*) 'ERROR worker is not responding'
488 time1i=MPI_WTIME()-time_start_c
489 print *,'End of cycle, master time for ',iter,' iters ',
490 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
491 write (iout,*) 'End of cycle, master time for ',iter,
492 & ' iters ',time1i,' sec'
493 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
494 print *,'UPDATING ',ij-1
495 write(iout,*) 'UPDATING ',ij-1
497 call refresh_bank(ij-1)
498 c!bankt call refresh_bankt(ij-1)
501 c print *,'node ',ifrom,' finished ',ij,nft
502 write(iout,*) 'node ',ifrom,' finished ',ij,nft
505 movernx(ij)=iabs(ind(5))
506 call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
510 iss_out(i,ij)=ihpb(i)
511 jss_out(i,ij)=jhpb(i)
515 & call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
518 crc print *,'---------bcast finished--------',finished
519 time1i=MPI_WTIME()-time_start_c
520 print *,'End of cycle, master time for ',iter,' iters ',
521 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
522 write (iout,*) 'End of cycle, master time for ',iter,
523 & ' iters ',time1i,' sec'
524 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
526 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
527 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,
528 ctimeout & CG_COMM,ierr)
531 call mpi_issend(finished,1,mpi_logical,ij,idchar,
533 call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,
534 & CG_COMM,ireq2,ierr)
537 do while(.not. (flag .or. timeout1))
538 call MPI_TEST(ireq2,flag,muster,ierr)
540 if(tend1-tstart.gt.60) then
541 print *,'ERROR worker ',ij,' is not responding'
542 write(iout,*) 'ERROR worker ',ij,' is not responding'
547 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
550 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
553 print *,'UPDATING ',nodes-1,ij
554 write(iout,*) 'UPDATING ',nodes-1
555 call refresh_bank(nodes-1)
556 c!bankt call refresh_bankt(nodes-1)
558 call write_bank(jlee,nft)
559 c!bankt call write_bankt(jlee,nft)
564 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
569 write(iout,*)'### Total stats:'
571 if(nstatnx_tot(i,1).ne.0) then
573 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
574 & '### N',i,' total=',nstatnx_tot(i,1),
575 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
576 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
578 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
579 & '###N',i,' total=',nstatnx_tot(i,1),
580 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
581 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
585 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
586 & '### N',i,' total=',nstatnx_tot(i,1),
587 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
590 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
591 & '###N',i,' total=',nstatnx_tot(i,1),
592 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
599 if(sync_iter) goto 331
601 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
602 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
604 44 format('jlee =',i3,':',4f10.1,' E =',f8.3,i7,i10)
610 c soldier - perform energy minimization
612 print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
613 write (iout,*) 'End of minim, proc',me,'time ',
614 & MPI_WTIME()-time_start
616 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
617 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
618 call mpi_recv(finished,1,mpi_logical,0,idchar,
619 * CG_COMM,muster,ierr)
620 call mpi_recv(sync_iter,1,mpi_logical,0,idchar,
621 * CG_COMM,muster,ierr)
622 if(sync_iter) goto 331
625 ccccccccccccccccccccccccccccccccccccccc
627 ccccccccccccccccccccccccccccccccccccccc
631 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
632 * ebmin,ebmax,nft,iuse,nbank,ntbank
634 write(icsa_history,44) jlee,0.0,0.0,0.0,
635 & 0.0,ebmin,nstep,nft
636 write(icsa_history,*)
639 time1i=MPI_WTIME()-time_start
640 print *,'End of RUN, master time ',
641 & time1i,'sec, Eval/s ',(nft-nft00)/time1i
642 write (iout,*) 'End of RUN, master time ',
644 write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
647 write(iout,*) '!!!! ERROR worker was not responding'
648 write(iout,*) '!!!! cannot finish work normally'
649 write(iout,*) 'Processor0 is calling MPI_ABORT'
650 print *,'!!!! ERROR worker was not responding'
651 print *,'!!!! cannot finish work normally'
652 print *,'Processor0 is calling MPI_ABORT'
654 call mpi_abort(mpi_comm_world, 111, ierr)
658 cccccccccccccccccccccccccccccc
660 cccccccccccccccccccccccccccccc
664 c-------------------------------------------------
665 subroutine feedin(nconf,nft)
666 c sends out starting conformations and receives results of energy minimization
667 implicit real*8 (a-h,o-z)
670 include 'COMMON.IOUNITS'
671 include 'COMMON.CONTROL'
673 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
674 * cout(2),ind(9),info(12)
675 dimension muster(mpi_status_size)
676 include 'COMMON.SETUP'
677 parameter (rad=1.745329252d-2)
679 print *,'FEEDIN: NCONF=',nconf
681 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
682 if (nconf .lt. nodes-1) then
683 write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
685 write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
687 call mpi_abort(mpi_comm_world,ierror,ierrcode)
690 c pull out external and internal variables for next start
692 ! write (iout,*) 'XIN from FEEDIN N=',n
693 ! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
695 if (mm.lt.nodes) then
696 c feed task to soldier
697 ! print *, ' sending input for start # ',n
704 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
706 call mpi_send(xin,nvar,mpi_double_precision,mm,
707 * idreal,CG_COMM,ierr)
709 c find an available soldier
710 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
711 * CG_COMM,muster,ierr)
712 ! print *, ' receiving output from start # ',ind(1)
713 man=muster(mpi_source)
714 c receive final energies and variables
716 call mpi_recv(eout,1,mpi_double_precision,
717 * man,idreal,CG_COMM,muster,ierr)
720 call mpi_recv(co,1,mpi_double_precision,
721 * man,idreal,CG_COMM,muster,ierr)
722 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
724 call mpi_recv(xout,nvar,mpi_double_precision,
725 * man,idreal,CG_COMM,muster,ierr)
726 ! print *,nvar , ierr
727 c feed next task to soldier
728 ! print *, ' sending input for start # ',n
738 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
740 call mpi_send(xin,nvar,mpi_double_precision,man,
741 * idreal,CG_COMM,ierr)
742 c retrieve latest results
743 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
745 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
748 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
750 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
753 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
754 * CG_COMM,muster,ierr)
755 crc if (ierr.ne.0) go to 30
756 ! print *, ' receiving output from start # ',ind(1)
757 man=muster(mpi_source)
758 c receive final energies and variables
760 call mpi_recv(eout,1,
761 * mpi_double_precision,man,idreal,
762 * CG_COMM,muster,ierr)
765 call mpi_recv(co,1,mpi_double_precision,
766 * man,idreal,CG_COMM,muster,ierr)
767 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
769 crc if (ierr.ne.0) go to 30
770 call mpi_recv(xout,nvar,mpi_double_precision,
771 * man,idreal,CG_COMM,muster,ierr)
772 ! print *,nvar , ierr
773 crc if (ierr.ne.0) go to 30
781 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
784 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
786 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
788 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
790 10 print *, ' dispatching error'
791 call mpi_abort(mpi_comm_world,ierror,ierrcode)
793 20 print *, ' communication error'
794 call mpi_abort(mpi_comm_world,ierror,ierrcode)
796 30 print *, ' receiving error'
797 call mpi_abort(mpi_comm_world,ierror,ierrcode)
800 cccccccccccccccccccccccccccccccccccccccccccccccccc
801 subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
802 c receives and stores data from soldiers
803 implicit real*8 (a-h,o-z)
805 include 'COMMON.IOUNITS'
807 include 'COMMON.BANK'
809 include 'COMMON.CHAIN'
810 include 'COMMON.CONTACTS'
811 dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1)
813 double precision przes(3),obr(3,3)
817 if (k.gt.mxio .or. k.lt.1) then
819 & 'ERROR - dimensions of ANGMIN have been exceeded K=',k
820 call mpi_abort(mpi_comm_world,ierror,ierrcode)
828 c retrieve dihedral angles etc
829 call var_to_geom(nvar,xout)
831 dihang(1,j,1,k)=theta(j+1)
832 dihang(2,j,1,k)=phi(j+2)
833 dihang(3,j,1,k)=alph(j)
834 dihang(4,j,1,k)=omeg(j)
836 dihang(2,nres-1,1,k)=0.0d0
840 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
841 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
846 c call dihang_to_c(dihang(1,1,1,k))
847 c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
848 c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
849 c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
850 c & nsup,przes,obr,non_conv)
853 call rmsd_csa(rmsn(k))
854 call contact(.false.,ncont,icont,co)
855 pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
857 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
858 cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
859 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
860 cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
864 if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
867 cccccccccccccccccccccccccccccccccccccccccccccccccc
868 subroutine putx(xin,n,rad)
869 c gets starting variables
870 implicit real*8 (a-h,o-z)
873 include 'COMMON.BANK'
875 include 'COMMON.CHAIN'
876 include 'COMMON.IOUNITS'
877 dimension xin(maxvar)
879 c pull out starting values for variables
880 ! write (iout,*)'PUTX: N=',n
882 ! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
883 ! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
884 ! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
885 ! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
887 theta(j+1)=dihang_in(1,j,m,n)
888 phi(j+2)=dihang_in(2,j,m,n)
889 alph(j)=dihang_in(3,j,m,n)
890 omeg(j)=dihang_in(4,j,m,n)
893 c set up array of variables
894 call geom_to_var(nvar,xin)
895 ! write (iout,*) 'xin in PUTX N=',n
897 ! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
900 c--------------------------------------------------------
901 subroutine putx2(xin,iff,n)
902 c gets starting variables
903 implicit real*8 (a-h,o-z)
906 include 'COMMON.BANK'
908 include 'COMMON.CHAIN'
909 include 'COMMON.IOUNITS'
910 dimension xin(maxvar),iff(maxres)
912 c pull out starting values for variables
915 theta(j+1)=dihang_in2(1,j,m,n)
916 phi(j+2)=dihang_in2(2,j,m,n)
917 alph(j)=dihang_in2(3,j,m,n)
918 omeg(j)=dihang_in2(4,j,m,n)
921 c set up array of variables
922 call geom_to_var(nvar,xin)
930 c-------------------------------------------------------
931 subroutine prune_bank(p_cut)
932 implicit real*8 (a-h,o-z)
936 include 'COMMON.BANK'
937 include 'COMMON.IOUNITS'
938 include 'COMMON.CHAIN'
939 include 'COMMON.TIME1'
940 include 'COMMON.SETUP'
941 c---------------------------
942 c This subroutine prunes bank conformations using p_cut
943 c---------------------------
951 dihang(i,j,k,nprune)=bvar(i,j,k,m)
956 brmsn(nprune)=brmsn(m)
957 bpncn(nprune)=bpncn(m)
962 call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
963 if(diff.lt.p_cut) goto 100
964 if(diff.lt.ddmin) ddmin=diff
970 dihang(i,j,k,nprune)=bvar(i,j,k,m)
975 brmsn(nprune)=brmsn(m)
976 bpncn(nprune)=bpncn(m)
978 write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
981 print *, 'Pruning :',m,nprune,p_cut
986 c-------------------------------------------------------
988 subroutine reminimize(jlee)
989 implicit real*8 (a-h,o-z)
993 include 'COMMON.BANK'
994 include 'COMMON.IOUNITS'
995 include 'COMMON.CHAIN'
996 include 'COMMON.TIME1'
997 include 'COMMON.SETUP'
998 c---------------------------
999 c This subroutine re-minimizes bank conformations:
1000 c---------------------------
1007 if (me.eq.king) then
1008 open(icsa_history,file=csa_history,status="old")
1009 write(icsa_history,*) "Re-minimization",nodes,"nodes"
1010 write(icsa_history,851) (bene(i),i=1,nbank)
1011 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1012 * ebmin,ebmax,nft,iuse,nbank,ntbank
1018 dihang_in(i,j,k,index)=bvar(i,j,k,index)
1024 call feedin(ntry,nft)
1032 if (me.eq.king) then
1034 call replace_bvar(i,i)
1036 open(icsa_history,file=csa_history,status="old")
1037 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1038 * ebmin,ebmax,nft,iuse,nbank,ntbank
1039 write(icsa_history,851) (bene(i),i=1,nbank)
1041 call write_bank_reminimized(jlee,nft)
1044 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
1047 c 850 format(10f8.3)
1051 c-------------------------------------------------------
1052 subroutine send(n,mm,it)
1053 c sends out starting conformation for minimization
1054 implicit real*8 (a-h,o-z)
1055 include 'DIMENSIONS'
1056 include 'COMMON.VAR'
1057 include 'COMMON.IOUNITS'
1058 include 'COMMON.CONTROL'
1059 include 'COMMON.BANK'
1060 include 'COMMON.CHAIN'
1062 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1063 * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12)
1064 dimension muster(mpi_status_size)
1065 include 'COMMON.SETUP'
1066 parameter (rad=1.745329252d-2)
1068 if (isend2(n).eq.0) then
1069 c pull out external and internal variables for next start
1070 call putx(xin,n,rad)
1078 if (movenx(n).eq.14.or.movenx(n).eq.17) then
1081 else if (movenx(n).eq.16) then
1095 if (movenx(n).eq.15) then
1100 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1102 call mpi_send(xin,nvar,mpi_double_precision,mm,
1103 * idreal,CG_COMM,ierr)
1105 c distfit & minimization for n7 move
1115 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1117 call putx2(xin,iff,isend2(n))
1118 call mpi_send(xin,nvar,mpi_double_precision,mm,
1119 * idreal,CG_COMM,ierr)
1120 call mpi_send(iff,nres,mpi_integer,mm,
1121 * idint,CG_COMM,ierr)
1122 call putx(xin2,n,rad)
1123 call mpi_send(xin2,nvar,mpi_double_precision,mm,
1124 * idreal,CG_COMM,ierr)
1126 if (vdisulf.and.nss_in(n).ne.0) then
1127 call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,
1128 * idint,CG_COMM,ierr)
1129 call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,
1130 * idint,CG_COMM,ierr)
1134 c-------------------------------------------------
1136 subroutine recv(ihalt,man,xout,eout,ind,tout)
1137 c receives results of energy minimization
1138 implicit real*8 (a-h,o-z)
1139 include 'DIMENSIONS'
1140 include 'COMMON.VAR'
1141 include 'COMMON.IOUNITS'
1142 include 'COMMON.CONTROL'
1143 include 'COMMON.SBRIDGE'
1144 include 'COMMON.BANK'
1145 include 'COMMON.CHAIN'
1147 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1148 * cout(2),ind(9),info(12)
1149 dimension muster(mpi_status_size)
1150 include 'COMMON.SETUP'
1152 double precision twait,tstart,tend1
1153 parameter(twait=600.0d0)
1155 c find an available soldier
1159 do while(.not. (flag .or. tout))
1160 call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag,
1163 if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
1164 c_error if(tend1-tstart.gt.twait) tout=.true.
1167 write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
1171 man=muster(mpi_source)
1173 ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
1174 ctimeout * CG_COMM,muster,ierr)
1175 ! print *, ' receiving output from start # ',ind(1)
1176 ct print *,'receiving ',MPI_WTIME()
1177 ctimeout man=muster(mpi_source)
1178 call mpi_recv(ind,9,mpi_integer,man,idint,
1179 * CG_COMM,muster,ierr)
1181 c receive final energies and variables
1182 call mpi_recv(eout,1,mpi_double_precision,
1183 * man,idreal,CG_COMM,muster,ierr)
1186 call mpi_recv(co,1,mpi_double_precision,
1187 * man,idreal,CG_COMM,muster,ierr)
1188 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
1190 call mpi_recv(xout,nvar,mpi_double_precision,
1191 * man,idreal,CG_COMM,muster,ierr)
1192 ! print *,nvar , ierr
1193 if(vdisulf) nss=ind(6)
1194 if(vdisulf.and.nss.ne.0) then
1195 call mpi_recv(ihpb,nss,mpi_integer,
1196 * man,idint,CG_COMM,muster,ierr)
1197 call mpi_recv(jhpb,nss,mpi_integer,
1198 * man,idint,CG_COMM,muster,ierr)
1202 c print *,'sending halt to ',man
1203 write(iout,*) 'sending halt to ',man
1205 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
1210 c----------------------------------------------------------
1211 subroutine history_append
1212 implicit real*8 (a-h,o-z)
1213 include 'DIMENSIONS'
1214 include 'COMMON.IOUNITS'
1216 #if defined(AIX) || defined(PGI)
1217 open(icsa_history,file=csa_history,position="append")
1219 open(icsa_history,file=csa_history,access="append")