1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5 ! Program to carry out conformational search of proteins in an united-residue !
8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13 use control, only:tcpu
14 use io_base, only:ilen
15 use geometry, only:chainbuild
16 use control, only:dajczas
19 use compare, only: test
25 ! implicit real*8 (a-h,o-z)
26 ! include 'DIMENSIONS'
28 use MPI_data ! include 'COMMON.SETUP'
33 use MPI_data, only: me,king
36 ! include 'COMMON.TIME1'
37 ! include 'COMMON.INTERACT'
38 ! include 'COMMON.NAMES'
39 ! include 'COMMON.GEO'
40 ! include 'COMMON.HEADER'
41 ! include 'COMMON.CONTROL'
42 ! include 'COMMON.CONTACTS'
43 ! include 'COMMON.CHAIN'
44 ! include 'COMMON.VAR'
45 ! include 'COMMON.IOUNITS'
46 ! include 'COMMON.FFIELD'
47 ! include 'COMMON.REMD'
49 ! include 'COMMON.SBRIDGE'
51 real(kind=8) :: hrtime,mintime,sectime
52 character(len=64) :: text_mode_calc(-2:14)
53 text_mode_calc(-2) = 'test'
54 text_mode_calc(-1) = 'cos'
55 text_mode_calc(0) = 'Energy evaluation or minimization'
56 text_mode_calc(1) = 'Regularization of PDB structure'
57 text_mode_calc(2) = 'Threading of a sequence on PDB structures'
58 text_mode_calc(3) = 'Monte Carlo (with minimization) '
59 text_mode_calc(4) = 'Energy minimization of multiple conformations'
60 text_mode_calc(5) = 'Checking energy gradient'
61 text_mode_calc(6) = 'Entropic sampling Monte Carlo (with minimization)'
62 text_mode_calc(7) = 'Energy map'
63 text_mode_calc(8) = 'CSA calculations'
64 text_mode_calc(9) = 'Not used 9'
65 text_mode_calc(10) = 'Not used 10'
66 text_mode_calc(11) = 'Soft regularization of PDB structure'
67 text_mode_calc(12) = 'Mesoscopic molecular dynamics (MD) '
68 text_mode_calc(13) = 'Not used 13'
69 text_mode_calc(14) = 'Replica exchange molecular dynamics (REMD)'
71 ! call memmon_print_usage()
75 write(iout,*)'### LAST MODIFIED 09/03/15 15:32PM by EL'
76 if (me.eq.king) call cinfo
77 ! Read force field parameters and job setup data
81 if (me.eq.king .or. .not. out1file) then
82 write (iout,'(2a/)') &
83 text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), &
85 if (minim) write (iout,'(a)') &
86 'Conformations will be energy-minimized.'
87 write (iout,'(80(1h*)/)')
91 if (modecalc.eq.-2) then
94 else if (modecalc.eq.-1) then
95 write(iout,*) "call check_sc_map next"
99 !elwrite(iout,*)"!!!!!!!!!!!!!!!!! in unres"
102 if (fg_rank.gt.0) then
103 ! Fine-grain slaves just do energy and gradient components.
104 call ergastulum ! slave workhouse in Latin
107 if (modecalc.eq.0) then
108 call exec_eeval_or_minim
109 else if (modecalc.eq.1) then
111 else if (modecalc.eq.2) then
113 else if (modecalc.eq.3 .or. modecalc .eq.6) then
115 else if (modecalc.eq.4) then
116 call exec_mult_eeval_or_minim
117 else if (modecalc.eq.5) then
119 else if (ModeCalc.eq.7) then
121 else if (ModeCalc.eq.8) then
123 else if (modecalc.eq.11) then
125 else if (modecalc.eq.12) then
127 else if (modecalc.eq.14) then
130 write (iout,'(a)') 'This calculation type is not supported',&
137 if (fg_rank.eq.0) call finish_task
138 ! call memmon_print_usage()
140 call print_detailed_timing
142 call MPI_Finalize(ierr)
145 call dajczas(tcpu(),hrtime,mintime,sectime)
146 stop '********** Program terminated normally.'
150 !-----------------------------------------------------------------------------
152 !-----------------------------------------------------------------------------
154 use MPI_data !include 'COMMON.SETUP'
155 use control_data !include 'COMMON.CONTROL'
156 use geometry, only:chainbuild
158 use io_units !include 'COMMON.IOUNITS'
161 ! include 'DIMENSIONS'
167 ! if (me.eq.king .or. .not. out1file) &
168 ! write (iout,*) "Calling chainbuild"
172 end subroutine exec_MD
173 !---------------------------------------------------------------------------
174 subroutine exec_MREMD
175 use MPI_data !include 'COMMON.SETUP'
176 use control_data !include 'COMMON.CONTROL'
177 use io_units !include 'COMMON.IOUNITS'
179 use REMD_data !include 'COMMON.REMD'
180 use geometry, only:chainbuild
184 ! include 'DIMENSIONS'
191 call alloc_MREMD_arrays
193 ! if (me.eq.king .or. .not. out1file) &
194 ! write (iout,*) "Calling chainbuild"
196 if (me.eq.king .or. .not. out1file) &
197 write (iout,*) "Calling REMD"
207 end subroutine exec_MREMD
208 !-----------------------------------------------------------------------------
209 subroutine exec_eeval_or_minim
210 use MPI_data !include 'COMMON.SETUP'
211 use control_data !include 'COMMON.CONTROL''COMMON.TIME1''COMMON.NAMES''COMMON.HEADER'
212 use io_units !include 'COMMON.IOUNITS'
214 ! use energy !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE'
215 use geometry_data !include 'COMMON.GEO''COMMON.CHAIN'
216 ! use REMD !include 'COMMON.REMD'
217 ! use MD !include 'COMMON.MD'
222 use geometry, only:chainbuild
224 use compare, only:alloc_compare_arrays,hairpin,secondary2,rms_nac_nnc
225 use minimm, only:minimize,minim_dc,sc_move
229 ! implicit real*8 (a-h,o-z)
230 ! include 'DIMENSIONS'
235 !el common /srutu/ icall
236 real(kind=8) :: energy_(0:n_ene)
237 real(kind=8) :: energy_long(0:n_ene),energy_short(0:n_ene)
238 real(kind=8) :: varia(6*nres) !(maxvar) (maxvar=6*maxres)
239 real(kind=8) :: time00, evals, etota, etot, time_ene, time1
240 integer :: nharp,nft_sc,iretcode,nfun
241 integer,dimension(4,nres/3) :: iharp !(4,nres/3)(4,maxres/3)
243 real(kind=8) :: rms,frac,frac_nn,co
246 call alloc_compare_arrays
247 if (indpdb.eq.0) then
249 write(iout,*) 'Warning: Calling chainbuild'
255 ! write(iout,*)"in exec_eeval or minimim",split_ene
257 ! write(iout,*)"cccccc",j,(c(i,j),i=1,3)
258 ! write(iout,*)"dcccccc",j,(dc(i,j),i=1,3)
261 ! write(iout,*)"in exec_eeval or minimim"
263 print *,"Processor",myrank," after chainbuild"
266 call etotal_long(energy_long)
267 write (iout,*) "Printing long range energy"
268 call enerprint(energy_long)
270 call etotal_short(energy_short)
271 write (iout,*) "Printing short range energy"
272 call enerprint(energy_short)
274 energy_(i)=energy_long(i)+energy_short(i)
275 write (iout,*) i,energy_long(i),energy_short(i),energy_(i)
277 write (iout,*) "Printing long+short range energy"
278 call enerprint(energy_)
283 time_ene=MPI_Wtime()-time00
285 write (iout,*) "Time for energy evaluation",time_ene
286 print *,"after etotal"
289 call enerprint(energy_)
290 call hairpin(.true.,nharp,iharp)
291 call secondary2(.true.)
295 print *, 'Calling OVERLAP_SC'
296 call overlap_sc(fail)
300 call sc_move(2,nres-1,10,1d10,nft_sc,etot)
301 print *,'SC_move',nft_sc,etot
302 write(iout,*) 'SC_move',nft_sc,etot
306 print *, 'Calling MINIM_DC'
310 ! call check_ecartint !el
311 call minim_dc(etot,iretcode,nfun)
312 ! call check_ecartint !el
314 if (indpdb.ne.0) then
316 write(iout,*) 'Warning: Calling chainbuild'
319 call geom_to_var(nvar,varia)
320 print *,'Calling MINIMIZE.'
325 ! call exec_checkgrad !el
326 call minimize(etot,varia,iretcode,nfun)
328 ! call exec_checkgrad !el
330 print *,'SUMSL return code is',iretcode,' eval ',nfun
332 evals=nfun/(MPI_WTIME()-time1)
334 print *,'# eval/s',evals
335 print *,'refstr=',refstr
336 call hairpin(.true.,nharp,iharp)
337 call secondary2(.true.)
340 call enerprint(energy_)
343 call briefout(0,etot)
344 if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
345 write (iout,'(a,i3)') 'SUMSL return code:',iretcode
346 write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
347 write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
349 print *,'refstr=',refstr,frac,frac_nn,co
350 if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
351 print *,"after rms_nac_ncc"
352 call briefout(0,etot)
354 if (outpdb) call pdbout(etot,titel(:32),ipdb)
355 if (outmol2) call mol2out(etot,titel(:32))
356 write(iout,*) "after exec_eeval_or_minim"
358 end subroutine exec_eeval_or_minim
359 !-----------------------------------------------------------------------------
360 subroutine exec_regularize
361 ! use MPI_data !include 'COMMON.SETUP'
362 use control_data !include 'COMMON.CONTROL''COMMON.TIME1''COMMON.NAMES''COMMON.HEADER'
363 use io_units !include 'COMMON.IOUNITS'
365 use energy_data !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE'
366 use geometry_data !include 'COMMON.GEO''COMMON.CHAIN'
367 ! use REMD !include 'COMMON.REMD'
368 ! use MD !include 'COMMON.MD'
372 ! implicit real*8 (a-h,o-z)
373 ! include 'DIMENSIONS'
377 real(kind=8) :: energy_(0:n_ene)
379 real(kind=8) :: rms,frac,frac_nn,co
382 call alloc_compare_arrays
386 call regularize(nct-nnt+1,etot,rms,cref(1,nnt,1),iretcode)
388 energy_(0)=energy_(0)-energy_(14)
390 call enerprint(energy_)
392 call briefout(0,etot)
393 if (outpdb) call pdbout(etot,titel(:32),ipdb)
394 if (outmol2) call mol2out(etot,titel(:32))
395 if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
396 write (iout,'(a,i3)') 'SUMSL return code:',iretcode
398 end subroutine exec_regularize
399 !-----------------------------------------------------------------------------
400 subroutine exec_thread
401 ! use MPI_data !include 'COMMON.SETUP'
404 ! include 'DIMENSIONS'
408 call alloc_compare_arrays
411 end subroutine exec_thread
412 !-----------------------------------------------------------------------------
414 ! use MPI_data !include 'COMMON.SETUP'
415 use control_data !include 'COMMON.CONTROL'
420 ! implicit real*8 (a-h,o-z)
421 ! include 'DIMENSIONS'
422 character(len=10) :: nodeinfo
423 real(kind=8) :: varia(6*nres) !(maxvar) (maxvar=6*maxres)
428 call alloc_MCM_arrays
432 if (modecalc.eq.3) then
438 if (modecalc.eq.3) then
448 end subroutine exec_MC
449 !-----------------------------------------------------------------------------
450 subroutine exec_mult_eeval_or_minim
451 use MPI_data !include 'COMMON.SETUP'
452 use control_data !include 'COMMON.CONTROL''COMMON.TIME1''COMMON.NAMES''COMMON.HEADER'
453 use io_units !include 'COMMON.IOUNITS'
455 use energy_data !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE'
456 use geometry_data !include 'COMMON.GEO''COMMON.CHAIN'
457 ! use REMD !include 'COMMON.REMD'
458 ! use MD !include 'COMMON.MD'
460 use geometry, only:chainbuild,geom_to_var,int_from_cart1,var_to_geom
461 use energy, only:etotal,enerprint
462 use compare, only:rms_nac_nnc
463 use minimm, only:minimize!,minim_mcmf
464 ! implicit real*8 (a-h,o-z)
465 ! include 'DIMENSIONS'
467 use minimm, only:minim_mcmf
470 integer :: ierror,ierr
472 real(kind=8),dimension(mpi_status_size) :: muster
476 real(kind=8) :: varia(6*nres) !(maxvar) (maxvar=6*maxres)
477 integer,dimension(6) :: ind
478 real(kind=8) :: energy_(0:n_ene)
480 real(kind=8) :: etot,ene0
481 integer :: mm,imm,nft,n,iconf,nmin,i,iretcode,nfun,it,&
483 real(kind=8) :: rms,frac,frac_nn,co,time,ene
493 open(intin,file=intinname,status='old')
494 write (istat,'(a5,20a12)')"# ",&
495 (wname(print_order(i)),i=1,nprint_ene)
497 write (istat,'(a5,20a12)')"# ",&
498 (ename(print_order(i)),i=1,nprint_ene),&
499 "ETOT total","RMSD","nat.contact","nnt.contact"
501 write (istat,'(a5,20a12)')"# ",&
502 (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
508 read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
509 call read_x(intin,*11)
511 ! Broadcast the order to compute internal coordinates to the slaves.
513 call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
515 call int_from_cart1(.false.)
517 read (intin,'(i5)',end=1100,err=1100) iconf
518 call read_angles(intin,*11)
519 call geom_to_var(nvar,varia)
520 write(iout,*) 'Warning: Calling chainbuild'
523 write (iout,'(a,i7)') 'Conformation #',iconf
525 call briefout(iconf,energy_(0))
526 call enerprint(energy_)
529 call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
530 write (istat,'(i5,20(f12.3))') iconf,&
531 (energy_(print_order(i)),i=1,nprint_ene),etot,&
535 write (istat,'(i5,16(f12.3))') iconf,&
536 (energy_(print_order(i)),i=1,nprint_ene),etot
552 if (mm.lt.nodes) then
554 read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
555 call read_x(intin,*11)
557 ! Broadcast the order to compute internal coordinates to the slaves.
559 call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
561 call int_from_cart1(.false.)
563 read (intin,'(i5)',end=11,err=11) iconf
564 call read_angles(intin,*11)
565 call geom_to_var(nvar,varia)
566 write(iout,*) 'Warning: Calling chainbuild'
569 write (iout,'(a,i7)') 'Conformation #',iconf
579 call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM,&
581 call mpi_send(varia,nvar,mpi_double_precision,mm,&
583 call mpi_send(ene0,1,mpi_double_precision,mm,&
585 ! print *,'task ',n,' sent to worker ',mm,nvar
587 call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,&
589 man=muster(mpi_source)
590 ! print *,'receiving result from worker ',man,' (',iii1,iii,')'
591 call mpi_recv(varia,nvar,mpi_double_precision,&
592 man,idreal,CG_COMM,muster,ierr)
593 call mpi_recv(ene,1,&
594 mpi_double_precision,man,idreal,&
596 call mpi_recv(ene0,1,&
597 mpi_double_precision,man,idreal,&
599 ! print *,'result received from worker ',man,' sending now'
601 call var_to_geom(nvar,varia)
602 write(iout,*) 'Warning: Calling chainbuild'
608 write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5)
611 call enerprint(energy_)
612 call briefout(it,etot)
613 ! if (minim) call briefout(it,etot)
615 call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
616 write (istat,'(i5,19(f12.3))') iconf,&
617 (energy_(print_order(i)),i=1,nprint_ene),etot,&
620 write (istat,'(i5,15(f12.3))') iconf,&
621 (energy_(print_order(i)),i=1,nprint_ene),etot
626 read (intin,'(e15.10,e15.5)',end=1101,err=1101) time,ene
627 call read_x(intin,*11)
629 ! Broadcast the order to compute internal coordinates to the slaves.
631 call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
633 call int_from_cart1(.false.)
635 read (intin,'(i5)',end=1101,err=1101) iconf
636 call read_angles(intin,*11)
637 call geom_to_var(nvar,varia)
638 write(iout,*) 'Warning: Calling chainbuild'
649 call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM,&
651 call mpi_send(varia,nvar,mpi_double_precision,man,&
653 call mpi_send(ene0,1,mpi_double_precision,man,&
655 nf_mcmf=nf_mcmf+ind(4)
661 call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,&
663 man=muster(mpi_source)
664 call mpi_recv(varia,nvar,mpi_double_precision,&
665 man,idreal,CG_COMM,muster,ierr)
666 call mpi_recv(ene,1,&
667 mpi_double_precision,man,idreal,&
669 call mpi_recv(ene0,1,&
670 mpi_double_precision,man,idreal,&
673 call var_to_geom(nvar,varia)
674 write(iout,*) 'Warning: Calling chainbuild'
680 write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5)
683 call enerprint(energy_)
684 call briefout(it,etot)
686 call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
687 write (istat,'(i5,19(f12.3))') iconf,&
688 (energy_(print_order(i)),i=1,nprint_ene),etot,&
691 write (istat,'(i5,15(f12.3))') iconf,&
692 (energy_(print_order(i)),i=1,nprint_ene),etot
704 call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM,&
709 open(intin,file=intinname,status='old')
710 write (istat,'(a5,20a12)')"# ",&
711 (wname(print_order(i)),i=1,nprint_ene)
712 write (istat,'("# ",20(1pe12.4))') &
713 (weights(print_order(i)),i=1,nprint_ene)
715 write (istat,'(a5,20a12)')"# ",&
716 (ename(print_order(i)),i=1,nprint_ene),&
717 "ETOT total","RMSD","nat.contact","nnt.contact"
719 write (istat,'(a5,14a12)')"# ",&
720 (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
724 read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
725 call read_x(intin,*11)
727 ! Broadcast the order to compute internal coordinates to the slaves.
729 call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
731 call int_from_cart1(.false.)
733 read (intin,'(i5)',end=11,err=11) iconf
734 call read_angles(intin,*11)
735 call geom_to_var(nvar,varia)
736 write(iout,*) 'Warning: Calling chainbuild'
739 write (iout,'(a,i7)') 'Conformation #',iconf
740 if (minim) call minimize(etot,varia,iretcode,nfun)
744 call enerprint(energy_)
745 if (minim) call briefout(it,etot)
747 call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
748 write (istat,'(i5,18(f12.3))') iconf,&
749 (energy_(print_order(i)),i=1,nprint_ene),&
750 etot,rms,frac,frac_nn,co
753 write (istat,'(i5,14(f12.3))') iconf,&
754 (energy_(print_order(i)),i=1,nprint_ene),etot
760 end subroutine exec_mult_eeval_or_minim
761 !-----------------------------------------------------------------------------
762 subroutine exec_checkgrad
763 ! use MPI_data !include 'COMMON.SETUP'
764 use control_data !include 'COMMON.CONTROL''COMMON.TIME1''COMMON.NAMES''COMMON.HEADER'
765 use io_units !include 'COMMON.IOUNITS'
766 !el use energy_data, only:icall !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE'
767 use geometry_data !include 'COMMON.GEO''COMMON.CHAIN'
768 ! use REMD !include 'COMMON.REMD'
769 use MD_data !include 'COMMON.MD'
770 use io_base, only:intout
771 use io_config, only:read_fragments
776 ! implicit real*8 (a-h,o-z)
777 ! include 'DIMENSIONS'
782 !el common /srutu/ icall
783 real(kind=8) :: energy_(0:max_ene)
787 ! vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0)
788 ! if (itype(i).ne.10)
789 ! & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0)
791 if (indpdb.eq.0) then
792 write(iout,*) 'Warning: Calling chainbuild'
797 ! dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0)
801 ! if (itype(i).ne.10) then
803 ! dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0)
808 ! dc(j,0)=ran_number(-0.2d0,0.2d0)
818 call etotal(energy_(0))
820 call enerprint(energy_(0))
821 write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back
822 print *,'icheckgrad=',icheckgrad
823 goto (10,20,30) icheckgrad
824 10 call check_ecartint
826 20 call check_cartgrad
830 end subroutine exec_checkgrad
831 !-----------------------------------------------------------------------------
835 use io_config, only:map_read
838 call alloc_map_arrays
842 end subroutine exec_map
843 !-----------------------------------------------------------------------------
846 use io_units !include 'COMMON.IOUNITS'
852 ! include 'DIMENSIONS'
853 ! Conformational Space Annealling programmed by Jooyoung Lee.
854 ! This method works only with parallel machines!
856 call alloc_CSA_arrays
859 write (iout,*) "CSA works on parallel machines only"
862 end subroutine exec_CSA
863 !-----------------------------------------------------------------------------
864 subroutine exec_softreg
865 use io_units !include 'COMMON.IOUNITS'
866 use control_data !include 'COMMON.CONTROL'
868 use io_base, only:intout,briefout
869 use geometry, only:chainbuild
873 ! include 'DIMENSIONS'
874 real(kind=8) :: energy_(0:n_ene)
876 real(kind=8) :: rms,frac,frac_nn,co,etot
879 call alloc_compare_arrays
880 write(iout,*) 'Warning: Calling chainbuild'
883 call enerprint(energy_)
884 if (.not.lsecondary) then
885 write(iout,*) 'Calling secondary structure recognition'
886 call secondary2(debug)
888 write(iout,*) 'Using secondary structure supplied in pdb'
895 call enerprint(energy_)
897 call briefout(0,etot)
898 call secondary2(.true.)
899 if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
901 end subroutine exec_softreg
902 !-----------------------------------------------------------------------------
904 !-----------------------------------------------------------------------------
906 subroutine ergastulum
908 ! implicit real*8 (a-h,o-z)
909 ! include 'DIMENSIONS'
912 use MDyn, only:setup_fricmat
913 use REMD, only:fricmat_mult,ginv_mult
917 ! include 'COMMON.SETUP'
918 ! include 'COMMON.DERIV'
919 ! include 'COMMON.VAR'
920 ! include 'COMMON.IOUNITS'
921 ! include 'COMMON.FFIELD'
922 ! include 'COMMON.INTERACT'
923 ! include 'COMMON.MD'
924 ! include 'COMMON.TIME1'
925 real(kind=8),dimension(6*nres) :: z,d_a_tmp !(maxres6) maxres6=6*maxres
926 real(kind=8) :: edum(0:n_ene),time_order(0:10)
927 !el real(kind=8),dimension(2*nres,2*nres) :: Gcopy !(maxres2,maxres2) maxres2=2*maxres
928 !el common /przechowalnia/ Gcopy
932 real(kind=8) :: time00
933 integer :: iorder,i,j,nres2,ierr,ierror
936 if(.not.allocated(Gcopy)) allocate(Gcopy(nres2,nres2))
938 if(.not.allocated(Ginv)) allocate(Ginv(nres2,nres2)) !(maxres2,maxres2)
941 if(.not.allocated(ng_start)) allocate(ng_start(0:nfgtasks-1))
942 if(.not.allocated(ng_counts)) allocate(ng_counts(0:nfgtasks-1))
943 if(.not.allocated(nginv_counts)) allocate(nginv_counts(0:nfgtasks-1)) !(0:MaxProcs-1)
944 if(.not.allocated(nginv_start)) allocate(nginv_start(0:nfgtasks)) !(0:MaxProcs)
946 if(.not.allocated(fricmat)) allocate(fricmat(nres2,nres2)) !maxres2=2*maxres
948 ! Workers wait for variables and NF, and NFL from the boss
950 do while (iorder.ge.0)
951 ! write (*,*) 'Processor',fg_rank,' CG group',kolor,
952 ! & ' receives order from Master'
954 call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR)
955 time_Bcast=time_Bcast+MPI_Wtime()-time00
956 if (icall.gt.4 .and. iorder.ge.0) &
957 time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00
960 ! & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder
961 if (iorder.eq.0) then
964 ! write (2,*) "After etotal"
965 ! write (2,*) "dimen",dimen," dimen3",dimen3
967 else if (iorder.eq.2) then
969 call etotal_short(edum)
970 ! write (2,*) "After etotal_short"
971 ! write (2,*) "dimen",dimen," dimen3",dimen3
973 else if (iorder.eq.3) then
975 call etotal_long(edum)
976 ! write (2,*) "After etotal_long"
977 ! write (2,*) "dimen",dimen," dimen3",dimen3
979 else if (iorder.eq.1) then
981 ! write (2,*) "After sum_gradient"
982 ! write (2,*) "dimen",dimen," dimen3",dimen3
984 else if (iorder.eq.4) then
985 call ginv_mult(z,d_a_tmp)
986 else if (iorder.eq.5) then
987 ! Setup MD things for a slave
988 dimen=(nct-nnt+1)+nside
989 dimen1=(nct-nnt)+(nct-nnt+1)
991 ! write (2,*) "dimen",dimen," dimen3",dimen3
993 call int_bounds(dimen,igmult_start,igmult_end)
994 igmult_start=igmult_start-1
995 call MPI_Allgather(3*igmult_start,1,MPI_INTEGER,&
996 ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
997 my_ng_count=igmult_end-igmult_start
998 call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1,&
999 MPI_INTEGER,FG_COMM,IERROR)
1000 write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) !sp
1001 ! write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1)
1002 myginv_ng_count=nres2*my_ng_count !el maxres2
1003 ! write (2,*) "igmult_start",igmult_start," igmult_end",
1004 ! & igmult_end," my_ng_count",my_ng_count
1006 call MPI_Allgather(nres2*igmult_start,1,MPI_INTEGER,& !el maxres2
1007 nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
1008 call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER,&
1009 nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR)
1010 ! write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1)
1011 ! write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1)
1013 ! call MPI_Barrier(FG_COMM,IERROR)
1015 call MPI_Scatterv(ginv(1,1),nginv_counts(0),&
1016 nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1),&
1017 myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
1019 time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00
1022 do j=1,2*my_ng_count
1023 ginv(j,i)=gcopy(i,j)
1026 ! write (2,*) "dimen",dimen," dimen3",dimen3
1027 ! write (2,*) "End MD setup"
1029 ! write (iout,*) "My chunk of ginv_block"
1030 ! call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block)
1031 else if (iorder.eq.6) then
1032 call int_from_cart1(.false.)
1033 else if (iorder.eq.7) then
1034 call chainbuild_cart
1035 else if (iorder.eq.8) then
1037 else if (iorder.eq.9) then
1038 call fricmat_mult(z,d_a_tmp)
1039 else if (iorder.eq.10) then
1043 write (*,*) 'Processor',fg_rank,' CG group',kolor,&
1044 ' absolute rank',myrank,' leves ERGASTULUM.'
1045 write(*,*)'Processor',fg_rank,' wait times for respective orders',&
1046 (' order[',i,']',time_order(i),i=0,10)
1048 end subroutine ergastulum