2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
10 c--------------------------------------------------------------------------
13 C Define constants and zero out tables.
15 implicit real*8 (a-h,o-z)
23 cMS$ATTRIBUTES C :: proc_proc
26 include 'COMMON.IOUNITS'
27 include 'COMMON.CHAIN'
28 include 'COMMON.INTERACT'
30 include 'COMMON.LOCAL'
31 include 'COMMON.TORSION'
32 include 'COMMON.FFIELD'
33 include 'COMMON.SBRIDGE'
35 include 'COMMON.MINIM'
36 include 'COMMON.DERIV'
37 include 'COMMON.SPLITELE'
38 c Common blocks from the diagonalization routines
39 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
40 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
42 c real*8 text1 /'initial_i'/
61 C The following is just to define auxiliary variables used in angle conversion
100 crc for write_rmsbank1
102 cdr include secondary structure prediction bias
105 C CSA I/O units (separated from others especially for Jooyoung)
116 icsa_bank_reminimized=38
119 crc for ifc error 118
122 C Set default weights of the energy terms.
133 print '(a,$)','Inside initialize'
134 c call memmon_print_usage()
184 gaussc(l,k,j,i)=0.0D0
205 C Initialize the bridge arrays
224 C Initialize variables used in minimization.
233 C Initialize the variables responsible for the mode of gradient storage.
238 C Initialize constants used to split the energy into long- and short-range
244 nprint_ene=nprint_ene-1
248 c-------------------------------------------------------------------------
250 implicit real*8 (a-h,o-z)
252 include 'COMMON.NAMES'
253 include 'COMMON.FFIELD'
255 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
256 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
258 &'C','M','F','I','L','V','W','Y','A','G','T',
259 &'S','Q','N','E','D','H','R','K','P','X'/
260 data potname /'LJ','LJK','BP','GB','GBV'/
262 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
263 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
264 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
265 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
267 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
268 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
269 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
272 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
275 c---------------------------------------------------------------------------
276 subroutine init_int_table
277 implicit real*8 (a-h,o-z)
281 integer blocklengths(15),displs(15)
283 include 'COMMON.CONTROL'
284 include 'COMMON.SETUP'
285 include 'COMMON.CHAIN'
286 include 'COMMON.INTERACT'
287 include 'COMMON.LOCAL'
288 include 'COMMON.SBRIDGE'
289 include 'COMMON.TORCNSTR'
290 include 'COMMON.IOUNITS'
291 include 'COMMON.DERIV'
292 include 'COMMON.CONTACTS'
293 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
294 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
295 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
296 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
297 & ielend_all(maxres,0:MaxProcs-1),
298 & ntask_cont_from_all(0:max_fg_procs-1),
299 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
300 & ntask_cont_to_all(0:max_fg_procs-1),
301 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
302 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
303 logical scheck,lprint,flag
305 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
306 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
307 C... Determine the numbers of start and end SC-SC interaction
308 C... to deal with by current processor.
310 itask_cont_from(i)=fg_rank
311 itask_cont_to(i)=fg_rank
315 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
316 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
317 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
319 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
320 & ' absolute rank',MyRank,
321 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
322 & ' my_sc_inde',my_sc_inde
342 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
343 cd & (ihpb(i),jhpb(i),i=1,nss)
347 if (ihpb(ii).eq.i+nres) then
354 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
358 c write (iout,*) 'jj=i+1'
359 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
360 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
366 else if (jj.eq.nct) then
368 c write (iout,*) 'jj=nct'
369 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
370 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
378 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
379 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
381 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
382 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
393 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
394 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
399 ind_scint=ind_scint+nct-i
403 ind_scint_old=ind_scint
412 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
413 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
416 write (iout,'(a)') 'Interaction array:'
418 write (iout,'(i3,2(2x,2i3))')
419 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
424 C Now partition the electrostatic-interaction array
426 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
427 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
429 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
430 & ' absolute rank',MyRank,
431 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
432 & ' my_ele_inde',my_ele_inde
439 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
440 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
443 if (iatel_s.eq.0) iatel_s=1
444 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
445 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
446 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
447 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
448 c & " my_ele_inde_vdw",my_ele_inde_vdw
455 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
457 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
459 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
460 c & " ielend_vdw",ielend_vdw(i)
462 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
473 do i=iatel_s_vdw,iatel_e_vdw
479 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
480 & ' absolute rank',MyRank
481 write (iout,*) 'Electrostatic interaction array:'
483 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
488 C Partition the SC-p interaction array
490 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
491 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
492 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
493 & ' absolute rank',myrank,
494 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
495 & ' my_scp_inde',my_scp_inde
501 if (i.lt.nnt+iscp) then
502 cd write (iout,*) 'i.le.nnt+iscp'
503 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
504 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
506 else if (i.gt.nct-iscp) then
507 cd write (iout,*) 'i.gt.nct-iscp'
508 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
509 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
512 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
513 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
516 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
517 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
526 if (i.lt.nnt+iscp) then
528 iscpstart(i,1)=i+iscp
530 elseif (i.gt.nct-iscp) then
538 iscpstart(i,2)=i+iscp
544 write (iout,'(a)') 'SC-p interaction array:'
545 do i=iatscp_s,iatscp_e
546 write (iout,'(i3,2(2x,2i3))')
547 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
550 C Partition local interactions
552 call int_bounds(nres-2,loc_start,loc_end)
553 loc_start=loc_start+1
555 call int_bounds(nres-2,ithet_start,ithet_end)
556 ithet_start=ithet_start+2
557 ithet_end=ithet_end+2
558 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
559 iturn3_start=iturn3_start+nnt
560 iphi_start=iturn3_start+2
561 iturn3_end=iturn3_end+nnt
562 iphi_end=iturn3_end+2
563 iturn3_start=iturn3_start-1
564 iturn3_end=iturn3_end-1
565 call int_bounds(nres-3,itau_start,itau_end)
566 itau_start=itau_start+3
568 call int_bounds(nres-3,iphi1_start,iphi1_end)
569 iphi1_start=iphi1_start+3
570 iphi1_end=iphi1_end+3
571 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
572 iturn4_start=iturn4_start+nnt
573 iphid_start=iturn4_start+2
574 iturn4_end=iturn4_end+nnt
575 iphid_end=iturn4_end+2
576 iturn4_start=iturn4_start-1
577 iturn4_end=iturn4_end-1
578 call int_bounds(nres-2,ibond_start,ibond_end)
579 ibond_start=ibond_start+1
580 ibond_end=ibond_end+1
581 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
582 ibondp_start=ibondp_start+nnt
583 ibondp_end=ibondp_end+nnt
584 call int_bounds1(nres-1,ivec_start,ivec_end)
585 print *,"Processor",myrank,fg_rank,fg_rank1,
586 & " ivec_start",ivec_start," ivec_end",ivec_end
587 iset_start=loc_start+2
589 if (ndih_constr.eq.0) then
593 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
595 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
597 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
598 igrad_start=((2*nlen+1)
599 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
600 jgrad_start(igrad_start)=
601 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
603 jgrad_end(igrad_start)=nres
604 igrad_end=((2*nlen+1)
605 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
606 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
607 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
609 do i=igrad_start+1,igrad_end-1
614 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
615 & ' absolute rank',myrank,
616 & ' loc_start',loc_start,' loc_end',loc_end,
617 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
618 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
619 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
620 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
621 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
622 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
623 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
624 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
625 & ' iset_start',iset_start,' iset_end',iset_end,
626 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
628 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
629 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
630 & ' ngrad_end',ngrad_end
631 do i=igrad_start,igrad_end
632 write(*,*) 'Processor:',fg_rank,myrank,i,
633 & jgrad_start(i),jgrad_end(i)
636 if (nfgtasks.gt.1) then
637 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
638 & MPI_INTEGER,FG_COMM1,IERROR)
639 iaux=ivec_end-ivec_start+1
640 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
641 & MPI_INTEGER,FG_COMM1,IERROR)
642 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
643 & MPI_INTEGER,FG_COMM,IERROR)
644 iaux=iset_end-iset_start+1
645 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
646 & MPI_INTEGER,FG_COMM,IERROR)
647 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
648 & MPI_INTEGER,FG_COMM,IERROR)
649 iaux=ibond_end-ibond_start+1
650 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
651 & MPI_INTEGER,FG_COMM,IERROR)
652 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
653 & MPI_INTEGER,FG_COMM,IERROR)
654 iaux=ithet_end-ithet_start+1
655 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
656 & MPI_INTEGER,FG_COMM,IERROR)
657 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
658 & MPI_INTEGER,FG_COMM,IERROR)
659 iaux=iphi_end-iphi_start+1
660 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
661 & MPI_INTEGER,FG_COMM,IERROR)
662 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
663 & MPI_INTEGER,FG_COMM,IERROR)
664 iaux=iphi1_end-iphi1_start+1
665 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
666 & MPI_INTEGER,FG_COMM,IERROR)
673 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
674 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
675 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
676 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
677 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
678 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
679 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
680 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
682 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
684 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
686 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
688 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
690 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
691 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
692 write (iout,*) "iturn3_start_all",
693 & (iturn3_start_all(i),i=0,nfgtasks-1)
694 write (iout,*) "iturn3_end_all",
695 & (iturn3_end_all(i),i=0,nfgtasks-1)
696 write (iout,*) "iturn4_start_all",
697 & (iturn4_start_all(i),i=0,nfgtasks-1)
698 write (iout,*) "iturn4_end_all",
699 & (iturn4_end_all(i),i=0,nfgtasks-1)
700 write (iout,*) "The ielstart_all array"
702 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
704 write (iout,*) "The ielend_all array"
706 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
712 itask_cont_from(0)=fg_rank
713 itask_cont_to(0)=fg_rank
715 do ii=iturn3_start,iturn3_end
716 call add_int(ii,ii+2,iturn3_sent(1,ii),
717 & ntask_cont_to,itask_cont_to,flag)
719 do ii=iturn4_start,iturn4_end
720 call add_int(ii,ii+3,iturn4_sent(1,ii),
721 & ntask_cont_to,itask_cont_to,flag)
723 do ii=iturn3_start,iturn3_end
724 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
726 do ii=iturn4_start,iturn4_end
727 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
730 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
731 & " ntask_cont_to",ntask_cont_to
732 write (iout,*) "itask_cont_from",
733 & (itask_cont_from(i),i=1,ntask_cont_from)
734 write (iout,*) "itask_cont_to",
735 & (itask_cont_to(i),i=1,ntask_cont_to)
738 c write (iout,*) "Loop forward"
741 c write (iout,*) "from loop i=",i
743 do j=ielstart(i),ielend(i)
744 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
747 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
748 c & " iatel_e",iatel_e
752 c write (iout,*) "i",i," ielstart",ielstart(i),
753 c & " ielend",ielend(i)
756 do j=ielstart(i),ielend(i)
757 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
758 & itask_cont_to,flag)
766 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
767 & " ntask_cont_to",ntask_cont_to
768 write (iout,*) "itask_cont_from",
769 & (itask_cont_from(i),i=1,ntask_cont_from)
770 write (iout,*) "itask_cont_to",
771 & (itask_cont_to(i),i=1,ntask_cont_to)
773 write (iout,*) "iint_sent"
776 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
777 & j=ielstart(ii),ielend(ii))
779 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
780 & " iturn3_end",iturn3_end
781 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
782 & i=iturn3_start,iturn3_end)
783 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
784 & " iturn4_end",iturn4_end
785 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
786 & i=iturn4_start,iturn4_end)
789 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
790 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
791 c write (iout,*) "Gather ntask_cont_from ended"
793 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
794 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
796 c write (iout,*) "Gather itask_cont_from ended"
798 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
799 & 1,MPI_INTEGER,king,FG_COMM,IERR)
800 c write (iout,*) "Gather ntask_cont_to ended"
802 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
803 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
804 c write (iout,*) "Gather itask_cont_to ended"
806 if (fg_rank.eq.king) then
807 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
809 write (iout,'(20i4)') i,ntask_cont_from_all(i),
810 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
814 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
816 write (iout,'(20i4)') i,ntask_cont_to_all(i),
817 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
821 C Check if every send will have a matching receive
825 ncheck_to=ncheck_to+ntask_cont_to_all(i)
826 ncheck_from=ncheck_from+ntask_cont_from_all(i)
828 write (iout,*) "Control sums",ncheck_from,ncheck_to
829 if (ncheck_from.ne.ncheck_to) then
830 write (iout,*) "Error: #receive differs from #send."
831 write (iout,*) "Terminating program...!"
837 do j=1,ntask_cont_to_all(i)
838 ii=itask_cont_to_all(j,i)
839 do k=1,ntask_cont_from_all(ii)
840 if (itask_cont_from_all(k,ii).eq.i) then
841 if(lprint)write(iout,*)"Matching send/receive",i,ii
845 if (k.eq.ntask_cont_from_all(ii)+1) then
847 write (iout,*) "Error: send by",j," to",ii,
848 & " would have no matching receive"
854 write (iout,*) "Unmatched sends; terminating program"
858 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
859 c write (iout,*) "flag broadcast ended flag=",flag
862 call MPI_Finalize(IERROR)
863 stop "Error in INIT_INT_TABLE: unmatched send/receive."
865 call MPI_Comm_group(FG_COMM,fg_group,IERR)
866 c write (iout,*) "MPI_Comm_group ended"
868 call MPI_Group_incl(fg_group,ntask_cont_from+1,
869 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
870 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
871 & CONT_TO_GROUP,IERR)
874 iaux=4*(ielend(ii)-ielstart(ii)+1)
875 call MPI_Group_translate_ranks(fg_group,iaux,
876 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
877 & iint_sent_local(1,ielstart(ii),i),IERR )
878 c write (iout,*) "Ranks translated i=",i
881 iaux=4*(iturn3_end-iturn3_start+1)
882 call MPI_Group_translate_ranks(fg_group,iaux,
883 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
884 & iturn3_sent_local(1,iturn3_start),IERR)
885 iaux=4*(iturn4_end-iturn4_start+1)
886 call MPI_Group_translate_ranks(fg_group,iaux,
887 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
888 & iturn4_sent_local(1,iturn4_start),IERR)
890 write (iout,*) "iint_sent_local"
893 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
894 & j=ielstart(ii),ielend(ii))
897 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
898 & " iturn3_end",iturn3_end
899 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
900 & i=iturn3_start,iturn3_end)
901 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
902 & " iturn4_end",iturn4_end
903 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
904 & i=iturn4_start,iturn4_end)
907 call MPI_Group_free(fg_group,ierr)
908 call MPI_Group_free(cont_from_group,ierr)
909 call MPI_Group_free(cont_to_group,ierr)
910 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
911 call MPI_Type_commit(MPI_UYZ,IERROR)
912 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
914 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
915 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
916 call MPI_Type_commit(MPI_MU,IERROR)
917 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
918 call MPI_Type_commit(MPI_MAT1,IERROR)
919 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
920 call MPI_Type_commit(MPI_MAT2,IERROR)
921 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
922 call MPI_Type_commit(MPI_THET,IERROR)
923 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
924 call MPI_Type_commit(MPI_GAM,IERROR)
926 c 9/22/08 Derived types to send matrices which appear in correlation terms
928 if (ivec_count(i).eq.ivec_count(0)) then
934 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
935 if (ind_typ.eq.0) then
945 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
948 c blocklengths(i)=blocklengths(i)*ichunk
950 c write (iout,*) "blocklengths and displs"
952 c write (iout,*) i,blocklengths(i),displs(i)
955 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
956 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
957 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
958 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
964 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
967 c blocklengths(i)=blocklengths(i)*ichunk
969 c write (iout,*) "blocklengths and displs"
971 c write (iout,*) i,blocklengths(i),displs(i)
974 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
975 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
976 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
977 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
983 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
986 blocklengths(i)=blocklengths(i)*ichunk
988 call MPI_Type_indexed(8,blocklengths,displs,
989 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
990 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
996 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
999 blocklengths(i)=blocklengths(i)*ichunk
1001 call MPI_Type_indexed(8,blocklengths,displs,
1002 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1003 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1009 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1012 blocklengths(i)=blocklengths(i)*ichunk
1014 call MPI_Type_indexed(6,blocklengths,displs,
1015 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1016 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1022 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1025 blocklengths(i)=blocklengths(i)*ichunk
1027 call MPI_Type_indexed(2,blocklengths,displs,
1028 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1029 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1035 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1038 blocklengths(i)=blocklengths(i)*ichunk
1040 call MPI_Type_indexed(4,blocklengths,displs,
1041 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1042 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1046 iint_start=ivec_start+1
1049 iint_count(i)=ivec_count(i)
1050 iint_displ(i)=ivec_displ(i)
1051 ivec_displ(i)=ivec_displ(i)-1
1052 iset_displ(i)=iset_displ(i)-1
1053 ithet_displ(i)=ithet_displ(i)-1
1054 iphi_displ(i)=iphi_displ(i)-1
1055 iphi1_displ(i)=iphi1_displ(i)-1
1056 ibond_displ(i)=ibond_displ(i)-1
1058 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1059 & .and. (me.eq.0 .or. out1file)) then
1060 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1062 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1065 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1066 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1067 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1069 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1072 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1073 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1074 & ' SC-p interactions','were distributed among',nfgtasks,
1075 & ' fine-grain processors.'
1091 idihconstr_end=ndih_constr
1092 iphid_start=iphi_start
1093 iphid_end=iphi_end-1
1110 c---------------------------------------------------------------------------
1111 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1113 include "DIMENSIONS"
1114 include "COMMON.INTERACT"
1115 include "COMMON.SETUP"
1116 include "COMMON.IOUNITS"
1117 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1119 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1120 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1121 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1122 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1123 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1124 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1125 & ielend_all(maxres,0:MaxProcs-1)
1126 integer iproc,isent,k,l
1127 c Determines whether to send interaction ii,jj to other processors; a given
1128 c interaction can be sent to at most 2 processors.
1129 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1130 c one processor, otherwise flag is unchanged from the input value.
1136 c write (iout,*) "ii",ii," jj",jj
1137 c Loop over processors to check if anybody could need interaction ii,jj
1138 do iproc=0,fg_rank-1
1139 c Check if the interaction matches any turn3 at iproc
1140 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1142 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1143 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1145 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1148 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1149 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1152 call add_task(iproc,ntask_cont_to,itask_cont_to)
1156 C Check if the interaction matches any turn4 at iproc
1157 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1159 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1160 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1162 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1165 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1166 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1169 call add_task(iproc,ntask_cont_to,itask_cont_to)
1173 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1174 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1175 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1176 & ielend_all(ii-1,iproc).ge.jj-1) then
1178 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1179 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1182 call add_task(iproc,ntask_cont_to,itask_cont_to)
1185 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1186 & ielend_all(ii-1,iproc).ge.jj+1) then
1188 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1189 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1192 call add_task(iproc,ntask_cont_to,itask_cont_to)
1199 c---------------------------------------------------------------------------
1200 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1202 include "DIMENSIONS"
1203 include "COMMON.INTERACT"
1204 include "COMMON.SETUP"
1205 include "COMMON.IOUNITS"
1206 integer ii,jj,itask(2),ntask_cont_from,
1207 & itask_cont_from(0:MaxProcs-1)
1209 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1210 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1211 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1212 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1213 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1214 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1215 & ielend_all(maxres,0:MaxProcs-1)
1217 do iproc=fg_rank+1,nfgtasks-1
1218 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1220 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1221 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1223 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1224 call add_task(iproc,ntask_cont_from,itask_cont_from)
1227 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1229 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1230 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1232 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1233 call add_task(iproc,ntask_cont_from,itask_cont_from)
1236 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1237 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1239 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1240 & jj+1.le.ielend_all(ii+1,iproc)) then
1241 call add_task(iproc,ntask_cont_from,itask_cont_from)
1243 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1244 & jj-1.le.ielend_all(ii+1,iproc)) then
1245 call add_task(iproc,ntask_cont_from,itask_cont_from)
1248 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1250 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1251 & jj-1.le.ielend_all(ii-1,iproc)) then
1252 call add_task(iproc,ntask_cont_from,itask_cont_from)
1254 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1255 & jj+1.le.ielend_all(ii-1,iproc)) then
1256 call add_task(iproc,ntask_cont_from,itask_cont_from)
1263 c---------------------------------------------------------------------------
1264 subroutine add_task(iproc,ntask_cont,itask_cont)
1266 include "DIMENSIONS"
1267 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1270 if (itask_cont(ii).eq.iproc) return
1272 ntask_cont=ntask_cont+1
1273 itask_cont(ntask_cont)=iproc
1276 c---------------------------------------------------------------------------
1277 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1278 implicit real*8 (a-h,o-z)
1279 include 'DIMENSIONS'
1281 include 'COMMON.SETUP'
1282 integer total_ints,lower_bound,upper_bound
1283 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1284 nint=total_ints/nfgtasks
1288 nexcess=total_ints-nint*nfgtasks
1290 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1294 lower_bound=lower_bound+int4proc(i)
1296 upper_bound=lower_bound+int4proc(fg_rank)
1297 lower_bound=lower_bound+1
1300 c---------------------------------------------------------------------------
1301 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1302 implicit real*8 (a-h,o-z)
1303 include 'DIMENSIONS'
1305 include 'COMMON.SETUP'
1306 integer total_ints,lower_bound,upper_bound
1307 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1308 nint=total_ints/nfgtasks1
1312 nexcess=total_ints-nint*nfgtasks1
1314 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1318 lower_bound=lower_bound+int4proc(i)
1320 upper_bound=lower_bound+int4proc(fg_rank1)
1321 lower_bound=lower_bound+1
1324 c---------------------------------------------------------------------------
1325 subroutine int_partition(int_index,lower_index,upper_index,atom,
1326 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1327 implicit real*8 (a-h,o-z)
1328 include 'DIMENSIONS'
1329 include 'COMMON.IOUNITS'
1330 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1331 & first_atom,last_atom,int_gr,jat_start,jat_end
1334 if (lprn) write (iout,*) 'int_index=',int_index
1335 int_index_old=int_index
1336 int_index=int_index+last_atom-first_atom+1
1338 & write (iout,*) 'int_index=',int_index,
1339 & ' int_index_old',int_index_old,
1340 & ' lower_index=',lower_index,
1341 & ' upper_index=',upper_index,
1342 & ' atom=',atom,' first_atom=',first_atom,
1343 & ' last_atom=',last_atom
1344 if (int_index.ge.lower_index) then
1346 if (at_start.eq.0) then
1348 jat_start=first_atom-1+lower_index-int_index_old
1350 jat_start=first_atom
1352 if (lprn) write (iout,*) 'jat_start',jat_start
1353 if (int_index.ge.upper_index) then
1355 jat_end=first_atom-1+upper_index-int_index_old
1360 if (lprn) write (iout,*) 'jat_end',jat_end
1365 c------------------------------------------------------------------------------
1366 subroutine hpb_partition
1367 implicit real*8 (a-h,o-z)
1368 include 'DIMENSIONS'
1372 include 'COMMON.SBRIDGE'
1373 include 'COMMON.IOUNITS'
1374 include 'COMMON.SETUP'
1375 include 'COMMON.CONTROL'
1376 c write(2,*)"hpb_partition: nhpb=",nhpb
1378 call int_bounds(nhpb,link_start,link_end)
1380 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1381 & ' absolute rank',MyRank,
1382 & ' nhpb',nhpb,' link_start=',link_start,
1383 & ' link_end',link_end
1388 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end