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.
90 call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
91 cccccccccccccccccccccccccccccccccccccccc
93 cccccccccccccccccccccccccccccccccccccccc
96 if(sync_iter) goto 333
97 idum=- ran2(idum2)*imax
98 if(jlee.lt.jstart) goto 300
100 C Restart the random number generator for conformation generation
102 if(irestart.gt.0) then
104 if(idum2.le.0) idum2=-idum2+1
105 idum=- ran2(idum2)*imax
111 open(icsa_seed,file=csa_seed,status="old")
112 write(icsa_seed,*) "jlee : ",jlee
116 write(icsa_history,*) "number of procs is ",nodes
117 write(icsa_history,*) jlee,idum,idum2
120 cccccccccccccccccccccccccccccccccccccccccccccccc
124 write(icsa_history,*) "nbank is ",nbank
127 if(irestart.eq.1) goto 111
128 if(irestart.eq.2) then
133 do i=nbank+1,nbank+nconf
138 c start energy minimization
139 nconfr=max0(nconf+nadd,nodes-1)
140 if (sync_iter) nconf_in=0
141 c king-emperor - feed input and sort output
142 write (iout,*) "NCONF_IN",nconf_in
144 if (nconf_in.gt.0) then
145 c al 7/2/00 - added possibility to read in some of the initial conformations
147 read (intin,'(i5)',end=11,err=12) iconf
149 write (iout,*) "write READ_ANGLES",iconf,m
150 call read_angles(intin,*11)
157 dihang_in(1,j,1,mm)=theta(j+1)
158 dihang_in(2,j,1,mm)=phi(j+2)
159 dihang_in(3,j,1,mm)=alph(j)
160 dihang_in(4,j,1,mm)=omeg(j)
164 11 write (iout,*) nconf_in," conformations requested, but only",
165 & m-1," found in the angle file."
169 write (iout,*) nconf_in,
170 & " initial conformations have been read in."
173 if (nconfr.gt.nconf_in) then
174 call make_ranvar(nconfr,m,idum)
175 write (iout,*) nconfr-nconf_in,
176 & " conformations have been generated randomly."
180 call from_int(nconfr,m,idum)
181 c call from_pdb(nconfr,idum)
183 write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
184 write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
186 write (iout,*) 'Initial conformation',m
187 write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
188 write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
189 write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
190 write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
192 write(iout,*)'Calling FEEDIN NCONF',nconfr
194 call feedin(nconfr,nft)
195 write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
197 write(icsa_history,*) jlee,nft,nbank
198 write(icsa_history,851) (etot(i),i=1,nconfr)
199 write(icsa_history,850) (rmsn(i),i=1,nconfr)
200 write(icsa_history,850) (pncn(i),i=1,nconfr)
201 write(icsa_history,*)
204 c To minimize input conformation (bank conformation)
205 c Output to $mol.reminimized
206 if (irestart.lt.0) then
207 call reminimize(jlee)
210 if (irestart.eq.1) goto 111
211 c soldier - perform energy minimization
215 ccccccccccccccccccccccccccccccccccc
216 c need to syncronize all procs
217 call mpi_barrier(CG_COMM,ierr)
219 print *, ' cannot synchronize MPI'
222 ccccccccccccccccccccccccccccccccccc
226 c print *,"ok after minim"
228 if(irestart.eq.2) then
230 c ntbank=ntbank+nconf
231 if(ntbank.gt.ntbankm) ntbank=ntbankm
233 c print *,"ok before indexx"
235 call indexx(nconfr,etot,indx)
241 call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
242 do k=nconf_in+1,nconfr
243 indx(k)=indx(k)+nconf_in
246 c call indexx(nconfr,rmsn,indx)
248 c print *,"ok after indexx"
251 if (m.gt.mxio .or. m.lt.1) then
252 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
253 call mpi_abort(mpi_comm_world,ierror,ierrcode)
255 jbank(im+nbank-nconf)=0
256 bene(im+nbank-nconf)=etot(m)
257 rene(im+nbank-nconf)=etot(m)
258 c!bankt btene(im)=etot(m)
260 brmsn(im+nbank-nconf)=rmsn(m)
261 bpncn(im+nbank-nconf)=pncn(m)
262 rrmsn(im+nbank-nconf)=rmsn(m)
263 rpncn(im+nbank-nconf)=pncn(m)
264 if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
265 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,
266 & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
267 call mpi_abort(mpi_comm_world,ierror,ierrcode)
272 bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
273 rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
274 c!bankt btvar(i,j,k,im)=dihang(i,j,k,m)
280 if(brmsn(im+nbank-nconf).gt.rmscut.or.
281 & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
284 bvar_ns(im+nbank-nconf)=ns-2*nss
288 do while( iss(i).ne.ihpb(j)-nres .and.
289 & iss(i).ne.jhpb(j)-nres .and. j.le.nss)
294 bvar_s(k,im+nbank-nconf)=iss(i)
298 bvar_nss(im+nbank-nconf)=nss
300 bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
301 bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
314 if(nbank.eq.nconf.and.irestart.eq.0) then
321 cd print *,"adif,xctdif,cutdifr"
322 cd print *,adif,xctdif,cutdifr
323 nst=ntotal/ntrial/nseed
324 xctdif=(cutdif/ctdif1)**(-1.0/nst)
325 if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
326 c print *,"ok after estimate"
330 call write_rbank(jlee,adif,nft)
331 call write_bank(jlee,nft)
332 c!bankt call write_bankt(jlee,nft)
333 c call write_bank1(jlee)
335 write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
336 write(icsa_history,851) (bene(i),i=1,nbank)
337 write(icsa_history,850) (brmsn(i),i=1,nbank)
338 write(icsa_history,850) (bpncn(i),i=1,nbank)
356 if (.not.sync_iter) then
364 ccccccccccccccccccccccccccccccccccccccc
365 do while (.not. finished)
366 ccccccccccccccccccccccccccccccccccccccc
367 crc print *,"iter ", iter,' isent=',isent
370 c start energy minimization
373 c king-emperor - select seeds & make var & feed input
374 cd print *,'generating new conf',ntrial,MPI_WTIME()
375 call select_is(nseed,ifar,idum)
377 open(icsa_seed,file=csa_seed,status="old")
379 & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
382 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
383 * ebmin,ebmax,nft,iuse,nbank,ntbank
388 call make_var(ntry,idum,iter)
389 cd print *,'new trial generated',ntrial,MPI_WTIME()
391 write (iout,'(a20,i4,f12.2)')
392 & 'Time for make trial',iter+1,time2i-time1i
395 crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
396 crc call feedin(ntry,nft)
399 if (isent.ge.nodes.or.iter.gt.0) then
400 ct print *,'waiting ',MPI_WTIME()
402 call recv(0,ifrom,xout,eout,ind,timeout)
403 ct print *,' ',irecv,' received from',ifrom,MPI_WTIME()
408 ct print *,'sending to',ifrom,MPI_WTIME()
409 call send(isent,ifrom,iter)
410 ct print *,isent,' sent ',MPI_WTIME()
412 c store results -----------------------------------------------
413 if (isent.ge.nodes.or.iter.gt.0) then
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)
427 c--------------------------------------------------------------
428 if (isent.eq.ntry) then
430 write (iout,'(a18,f12.2,a14,f10.2)')
431 & 'Nonsetup time ',time1i-time_start_c,
432 & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
433 write (iout,'(a14,i4,f12.2,a14,f10.2)')
434 & 'Time for iter ',iter+1,time1i-time0i,
435 & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
439 if(cutdif.lt.ctdif1) cutdif=ctdif1
441 print *,'UPDATING ',ntry-nodes+1,irecv
442 write(iout,*) 'UPDATING ',ntry-nodes+1
444 c----------------- call update(ntry-nodes+1) -------------------
445 nstep=nstep+ntry-nseed-(nodes-1)
446 call refresh_bank(ntry-nodes+1)
447 c!bankt call refresh_bankt(ntry-nodes+1)
449 c----------------- call update(ntry) ---------------------------
451 print *,'UPDATING ',ntry,irecv
452 write(iout,*) 'UPDATING ',ntry
453 nstep=nstep+ntry-nseed
454 call refresh_bank(ntry)
455 c!bankt call refresh_bankt(ntry)
457 c-----------------------------------------------------------------
459 call write_bank(jlee,nft)
460 c!bankt call write_bankt(jlee,nft)
464 write (iout,'(a20,i4,f12.2)')
465 & 'Time for refresh ',iter,time1i-time0i
467 if(ebmin.lt.estop) finished=.true.
468 if(icycle.gt.icmax) then
469 call write_bank1(jlee)
475 if(nbank.gt.nbankm) then
483 if(nstep.gt.nstmax) finished=.true.
485 if(finished.or.sync_iter) then
487 call recv(1,ifrom,xout,eout,ind,timeout)
490 print *,'ERROR worker is not responding'
491 write(iout,*) 'ERROR worker is not responding'
492 time1i=MPI_WTIME()-time_start_c
493 print *,'End of cycle, master time for ',iter,' iters ',
494 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
495 write (iout,*) 'End of cycle, master time for ',iter,
496 & ' iters ',time1i,' sec'
497 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
498 print *,'UPDATING ',ij-1
499 write(iout,*) 'UPDATING ',ij-1
501 call refresh_bank(ij-1)
502 c!bankt call refresh_bankt(ij-1)
505 c print *,'node ',ifrom,' finished ',ij,nft
506 write(iout,*) 'node ',ifrom,' finished ',ij,nft
509 movernx(ij)=iabs(ind(5))
510 call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
514 iss_out(i,ij)=ihpb(i)
515 jss_out(i,ij)=jhpb(i)
519 & call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
522 crc print *,'---------bcast finished--------',finished
523 time1i=MPI_WTIME()-time_start_c
524 print *,'End of cycle, master time for ',iter,' iters ',
525 & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
526 write (iout,*) 'End of cycle, master time for ',iter,
527 & ' iters ',time1i,' sec'
528 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
530 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
531 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,
532 ctimeout & CG_COMM,ierr)
535 call mpi_issend(finished,1,mpi_logical,ij,idchar,
537 call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,
538 & CG_COMM,ireq2,ierr)
541 do while(.not. (flag .or. timeout1))
542 call MPI_TEST(ireq2,flag,muster,ierr)
544 if(tend1-tstart.gt.60) then
545 print *,'ERROR worker ',ij,' is not responding'
546 write(iout,*) 'ERROR worker ',ij,' is not responding'
551 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
554 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
557 print *,'UPDATING ',nodes-1,ij
558 write(iout,*) 'UPDATING ',nodes-1
559 call refresh_bank(nodes-1)
560 c!bankt call refresh_bankt(nodes-1)
562 call write_bank(jlee,nft)
563 c!bankt call write_bankt(jlee,nft)
568 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
573 write(iout,*)'### Total stats:'
575 if(nstatnx_tot(i,1).ne.0) then
577 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
578 & '### N',i,' total=',nstatnx_tot(i,1),
579 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
580 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
582 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
583 & '###N',i,' total=',nstatnx_tot(i,1),
584 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
585 & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
589 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
590 & '### N',i,' total=',nstatnx_tot(i,1),
591 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
594 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
595 & '###N',i,' total=',nstatnx_tot(i,1),
596 & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
603 if(sync_iter) goto 331
605 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
606 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
608 44 format('jlee =',i3,':',4f10.1,' E =',f15.5,i7,i10)
614 c soldier - perform energy minimization
616 print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
617 write (iout,*) 'End of minim, proc',me,'time ',
618 & MPI_WTIME()-time_start
620 ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
621 ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
622 call mpi_recv(finished,1,mpi_logical,0,idchar,
623 * CG_COMM,muster,ierr)
624 call mpi_recv(sync_iter,1,mpi_logical,0,idchar,
625 * CG_COMM,muster,ierr)
626 if(sync_iter) goto 331
629 ccccccccccccccccccccccccccccccccccccccc
631 ccccccccccccccccccccccccccccccccccccccc
635 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
636 * ebmin,ebmax,nft,iuse,nbank,ntbank
638 write(icsa_history,44) jlee,0.0,0.0,0.0,
639 & 0.0,ebmin,nstep,nft
640 write(icsa_history,*)
643 time1i=MPI_WTIME()-time_start
644 print *,'End of RUN, master time ',
645 & time1i,'sec, Eval/s ',(nft-nft00)/time1i
646 write (iout,*) 'End of RUN, master time ',
648 write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
651 write(iout,*) '!!!! ERROR worker was not responding'
652 write(iout,*) '!!!! cannot finish work normally'
653 write(iout,*) 'Processor0 is calling MPI_ABORT'
654 print *,'!!!! ERROR worker was not responding'
655 print *,'!!!! cannot finish work normally'
656 print *,'Processor0 is calling MPI_ABORT'
658 call mpi_abort(mpi_comm_world, 111, ierr)
662 cccccccccccccccccccccccccccccc
664 cccccccccccccccccccccccccccccc
668 c-------------------------------------------------
669 subroutine feedin(nconf,nft)
670 c sends out starting conformations and receives results of energy minimization
671 implicit real*8 (a-h,o-z)
674 include 'COMMON.IOUNITS'
675 include 'COMMON.CONTROL'
677 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
678 * cout(2),ind(9),info(12)
679 dimension muster(mpi_status_size)
680 include 'COMMON.SETUP'
681 parameter (rad=1.745329252d-2)
683 print *,'FEEDIN: NCONF=',nconf
685 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
686 if (nconf .lt. nodes-1) then
687 write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
689 write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
691 call mpi_abort(mpi_comm_world,ierror,ierrcode)
694 c pull out external and internal variables for next start
696 ! write (iout,*) 'XIN from FEEDIN N=',n
697 ! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
699 if (mm.lt.nodes) then
700 c feed task to soldier
701 ! print *, ' sending input for start # ',n
708 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
710 call mpi_send(xin,nvar,mpi_double_precision,mm,
711 * idreal,CG_COMM,ierr)
713 c find an available soldier
714 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
715 * CG_COMM,muster,ierr)
716 ! print *, ' receiving output from start # ',ind(1)
717 man=muster(mpi_source)
718 c receive final energies and variables
720 call mpi_recv(eout,1,mpi_double_precision,
721 * man,idreal,CG_COMM,muster,ierr)
724 call mpi_recv(co,1,mpi_double_precision,
725 * man,idreal,CG_COMM,muster,ierr)
726 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
728 call mpi_recv(xout,nvar,mpi_double_precision,
729 * man,idreal,CG_COMM,muster,ierr)
730 ! print *,nvar , ierr
731 c feed next task to soldier
732 ! print *, ' sending input for start # ',n
742 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
744 call mpi_send(xin,nvar,mpi_double_precision,man,
745 * idreal,CG_COMM,ierr)
746 c retrieve latest results
747 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
749 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
752 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
754 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
757 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
758 * CG_COMM,muster,ierr)
759 crc if (ierr.ne.0) go to 30
760 ! print *, ' receiving output from start # ',ind(1)
761 man=muster(mpi_source)
762 c receive final energies and variables
764 call mpi_recv(eout,1,
765 * mpi_double_precision,man,idreal,
766 * CG_COMM,muster,ierr)
769 call mpi_recv(co,1,mpi_double_precision,
770 * man,idreal,CG_COMM,muster,ierr)
771 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
773 crc if (ierr.ne.0) go to 30
774 call mpi_recv(xout,nvar,mpi_double_precision,
775 * man,idreal,CG_COMM,muster,ierr)
776 ! print *,nvar , ierr
777 crc if (ierr.ne.0) go to 30
785 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
788 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
790 & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
792 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
794 10 print *, ' dispatching error'
795 call mpi_abort(mpi_comm_world,ierror,ierrcode)
797 20 print *, ' communication error'
798 call mpi_abort(mpi_comm_world,ierror,ierrcode)
800 30 print *, ' receiving error'
801 call mpi_abort(mpi_comm_world,ierror,ierrcode)
804 cccccccccccccccccccccccccccccccccccccccccccccccccc
805 subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
806 c receives and stores data from soldiers
807 implicit real*8 (a-h,o-z)
809 include 'COMMON.IOUNITS'
811 include 'COMMON.BANK'
813 include 'COMMON.CHAIN'
814 include 'COMMON.CONTACTS'
815 dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1)
817 double precision przes(3),obr(3,3)
821 if (k.gt.mxio .or. k.lt.1) then
823 & 'ERROR - dimensions of ANGMIN have been exceeded K=',k
824 call mpi_abort(mpi_comm_world,ierror,ierrcode)
832 c retrieve dihedral angles etc
833 call var_to_geom(nvar,xout)
835 dihang(1,j,1,k)=theta(j+1)
836 dihang(2,j,1,k)=phi(j+2)
837 dihang(3,j,1,k)=alph(j)
838 dihang(4,j,1,k)=omeg(j)
840 dihang(2,nres-1,1,k)=0.0d0
844 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
845 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
850 c call dihang_to_c(dihang(1,1,1,k))
851 c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
852 c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
853 c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
854 c & nsup,przes,obr,non_conv)
857 call rmsd_csa(rmsn(k))
858 call contact(.false.,ncont,icont,co)
859 pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
861 cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
862 cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
863 cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
864 cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
868 if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
871 cccccccccccccccccccccccccccccccccccccccccccccccccc
872 subroutine putx(xin,n,rad)
873 c gets starting variables
874 implicit real*8 (a-h,o-z)
877 include 'COMMON.BANK'
879 include 'COMMON.CHAIN'
880 include 'COMMON.IOUNITS'
881 dimension xin(maxvar)
883 c pull out starting values for variables
884 ! write (iout,*)'PUTX: N=',n
886 ! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
887 ! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
888 ! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
889 ! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
891 theta(j+1)=dihang_in(1,j,m,n)
892 phi(j+2)=dihang_in(2,j,m,n)
893 alph(j)=dihang_in(3,j,m,n)
894 omeg(j)=dihang_in(4,j,m,n)
897 c set up array of variables
898 call geom_to_var(nvar,xin)
899 ! write (iout,*) 'xin in PUTX N=',n
901 ! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
904 c--------------------------------------------------------
905 subroutine putx2(xin,iff,n)
906 c gets starting variables
907 implicit real*8 (a-h,o-z)
910 include 'COMMON.BANK'
912 include 'COMMON.CHAIN'
913 include 'COMMON.IOUNITS'
914 dimension xin(maxvar),iff(maxres)
916 c pull out starting values for variables
919 theta(j+1)=dihang_in2(1,j,m,n)
920 phi(j+2)=dihang_in2(2,j,m,n)
921 alph(j)=dihang_in2(3,j,m,n)
922 omeg(j)=dihang_in2(4,j,m,n)
925 c set up array of variables
926 call geom_to_var(nvar,xin)
934 c-------------------------------------------------------
935 subroutine prune_bank(p_cut)
936 implicit real*8 (a-h,o-z)
940 include 'COMMON.BANK'
941 include 'COMMON.IOUNITS'
942 include 'COMMON.CHAIN'
943 include 'COMMON.TIME1'
944 include 'COMMON.SETUP'
945 c---------------------------
946 c This subroutine prunes bank conformations using p_cut
947 c---------------------------
955 dihang(i,j,k,nprune)=bvar(i,j,k,m)
960 brmsn(nprune)=brmsn(m)
961 bpncn(nprune)=bpncn(m)
966 call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
967 if(diff.lt.p_cut) goto 100
968 if(diff.lt.ddmin) ddmin=diff
974 dihang(i,j,k,nprune)=bvar(i,j,k,m)
979 brmsn(nprune)=brmsn(m)
980 bpncn(nprune)=bpncn(m)
982 write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
985 print *, 'Pruning :',m,nprune,p_cut
990 c-------------------------------------------------------
992 subroutine reminimize(jlee)
993 implicit real*8 (a-h,o-z)
997 include 'COMMON.BANK'
998 include 'COMMON.IOUNITS'
999 include 'COMMON.CHAIN'
1000 include 'COMMON.TIME1'
1001 include 'COMMON.SETUP'
1002 c---------------------------
1003 c This subroutine re-minimizes bank conformations:
1004 c---------------------------
1011 if (me.eq.king) then
1012 open(icsa_history,file=csa_history,status="old")
1013 write(icsa_history,*) "Re-minimization",nodes,"nodes"
1014 write(icsa_history,851) (bene(i),i=1,nbank)
1015 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1016 * ebmin,ebmax,nft,iuse,nbank,ntbank
1022 dihang_in(i,j,k,index)=bvar(i,j,k,index)
1028 call feedin(ntry,nft)
1036 if (me.eq.king) then
1038 call replace_bvar(i,i)
1040 open(icsa_history,file=csa_history,status="old")
1041 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1042 * ebmin,ebmax,nft,iuse,nbank,ntbank
1043 write(icsa_history,851) (bene(i),i=1,nbank)
1045 call write_bank_reminimized(jlee,nft)
1048 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
1051 c 850 format(10f8.3)
1055 c-------------------------------------------------------
1056 subroutine send(n,mm,it)
1057 c sends out starting conformation for minimization
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 include 'COMMON.VAR'
1061 include 'COMMON.IOUNITS'
1062 include 'COMMON.CONTROL'
1063 include 'COMMON.BANK'
1064 include 'COMMON.CHAIN'
1066 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1067 * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12)
1068 dimension muster(mpi_status_size)
1069 include 'COMMON.SETUP'
1070 parameter (rad=1.745329252d-2)
1072 if (isend2(n).eq.0) then
1073 c pull out external and internal variables for next start
1074 call putx(xin,n,rad)
1082 if (movenx(n).eq.14.or.movenx(n).eq.17) then
1085 else if (movenx(n).eq.16) then
1099 if (movenx(n).eq.15) then
1104 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1106 call mpi_send(xin,nvar,mpi_double_precision,mm,
1107 * idreal,CG_COMM,ierr)
1109 c distfit & minimization for n7 move
1119 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1121 call putx2(xin,iff,isend2(n))
1122 call mpi_send(xin,nvar,mpi_double_precision,mm,
1123 * idreal,CG_COMM,ierr)
1124 call mpi_send(iff,nres,mpi_integer,mm,
1125 * idint,CG_COMM,ierr)
1126 call putx(xin2,n,rad)
1127 call mpi_send(xin2,nvar,mpi_double_precision,mm,
1128 * idreal,CG_COMM,ierr)
1130 if (vdisulf.and.nss_in(n).ne.0) then
1131 call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,
1132 * idint,CG_COMM,ierr)
1133 call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,
1134 * idint,CG_COMM,ierr)
1138 c-------------------------------------------------
1140 subroutine recv(ihalt,man,xout,eout,ind,tout)
1141 c receives results of energy minimization
1142 implicit real*8 (a-h,o-z)
1143 include 'DIMENSIONS'
1144 include 'COMMON.VAR'
1145 include 'COMMON.IOUNITS'
1146 include 'COMMON.CONTROL'
1147 include 'COMMON.SBRIDGE'
1148 include 'COMMON.BANK'
1149 include 'COMMON.CHAIN'
1151 dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1152 * cout(2),ind(9),info(12)
1153 dimension muster(mpi_status_size)
1154 include 'COMMON.SETUP'
1156 double precision twait,tstart,tend1
1157 parameter(twait=600.0d0)
1159 c find an available soldier
1163 do while(.not. (flag .or. tout))
1164 call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag,
1167 if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
1168 c_error if(tend1-tstart.gt.twait) tout=.true.
1171 write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
1175 man=muster(mpi_source)
1177 ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
1178 ctimeout * CG_COMM,muster,ierr)
1179 ! print *, ' receiving output from start # ',ind(1)
1180 ct print *,'receiving ',MPI_WTIME()
1181 ctimeout man=muster(mpi_source)
1182 call mpi_recv(ind,9,mpi_integer,man,idint,
1183 * CG_COMM,muster,ierr)
1185 c receive final energies and variables
1186 call mpi_recv(eout,1,mpi_double_precision,
1187 * man,idreal,CG_COMM,muster,ierr)
1190 call mpi_recv(co,1,mpi_double_precision,
1191 * man,idreal,CG_COMM,muster,ierr)
1192 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
1194 call mpi_recv(xout,nvar,mpi_double_precision,
1195 * man,idreal,CG_COMM,muster,ierr)
1196 ! print *,nvar , ierr
1197 if(vdisulf) nss=ind(6)
1198 if(vdisulf.and.nss.ne.0) then
1199 call mpi_recv(ihpb,nss,mpi_integer,
1200 * man,idint,CG_COMM,muster,ierr)
1201 call mpi_recv(jhpb,nss,mpi_integer,
1202 * man,idint,CG_COMM,muster,ierr)
1206 c print *,'sending halt to ',man
1207 write(iout,*) 'sending halt to ',man
1209 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
1214 c----------------------------------------------------------
1215 subroutine history_append
1216 implicit real*8 (a-h,o-z)
1217 include 'DIMENSIONS'
1218 include 'COMMON.IOUNITS'
1220 #if defined(AIX) || defined(PGI)
1221 open(icsa_history,file=csa_history,position="append")
1223 open(icsa_history,file=csa_history,access="append")