2 implicit real*8 (a-h,o-z)
6 include 'COMMON.INTERACT'
8 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
10 c Conversion from poises to molecular unit and the gas constant
11 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c Dielectric constant of water
15 c--------------------------------------------------------------------------
18 C Define constants and zero out tables.
20 implicit real*8 (a-h,o-z)
28 cMS$ATTRIBUTES C :: proc_proc
31 include 'COMMON.IOUNITS'
32 include 'COMMON.CHAIN'
33 include 'COMMON.INTERACT'
35 include 'COMMON.LOCAL'
36 include 'COMMON.TORSION'
37 include 'COMMON.FFIELD'
38 include 'COMMON.SBRIDGE'
40 include 'COMMON.MINIM'
41 include 'COMMON.DERIV'
42 include 'COMMON.SPLITELE'
43 c Common blocks from the diagonalization routines
44 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
45 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
47 c real*8 text1 /'initial_i'/
66 C The following is just to define auxiliary variables used in angle conversion
105 crc for write_rmsbank1
107 cdr include secondary structure prediction bias
110 C CSA I/O units (separated from others especially for Jooyoung)
121 icsa_bank_reminimized=38
124 crc for ifc error 118
127 C Set default weights of the energy terms.
138 print '(a,$)','Inside initialize'
139 c call memmon_print_usage()
189 gaussc(l,k,j,i)=0.0D0
210 C Initialize the bridge arrays
229 C Initialize variables used in minimization.
238 C Initialize the variables responsible for the mode of gradient storage.
243 C Initialize constants used to split the energy into long- and short-range
249 nprint_ene=nprint_ene-1
253 c-------------------------------------------------------------------------
255 implicit real*8 (a-h,o-z)
257 include 'COMMON.NAMES'
258 include 'COMMON.FFIELD'
260 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
261 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
263 &'C','M','F','I','L','V','W','Y','A','G','T',
264 &'S','Q','N','E','D','H','R','K','P','X'/
265 data potname /'LJ','LJK','BP','GB','GBV','MOMO'/
267 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
268 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
269 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
270 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
272 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
273 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
274 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
277 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
280 c---------------------------------------------------------------------------
281 subroutine init_int_table
282 implicit real*8 (a-h,o-z)
286 integer blocklengths(15),displs(15)
288 include 'COMMON.CONTROL'
289 include 'COMMON.SETUP'
290 include 'COMMON.CHAIN'
291 include 'COMMON.INTERACT'
292 include 'COMMON.LOCAL'
293 include 'COMMON.SBRIDGE'
294 include 'COMMON.TORCNSTR'
295 include 'COMMON.IOUNITS'
296 include 'COMMON.DERIV'
297 include 'COMMON.CONTACTS'
298 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
299 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
300 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
301 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
302 & ielend_all(maxres,0:max_fg_procs-1),
303 & ntask_cont_from_all(0:max_fg_procs-1),
304 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
305 & ntask_cont_to_all(0:max_fg_procs-1),
306 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
307 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
308 logical scheck,lprint,flag
310 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
311 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
312 C... Determine the numbers of start and end SC-SC interaction
313 C... to deal with by current processor.
315 itask_cont_from(i)=fg_rank
316 itask_cont_to(i)=fg_rank
320 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
321 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
322 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
324 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
325 & ' absolute rank',MyRank,
326 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
327 & ' my_sc_inde',my_sc_inde
347 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
348 cd & (ihpb(i),jhpb(i),i=1,nss)
353 if (ihpb(ii).eq.i+nres) then
360 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
364 c write (iout,*) 'jj=i+1'
365 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
366 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
372 else if (jj.eq.nct) then
374 c write (iout,*) 'jj=nct'
375 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
376 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
384 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
385 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
387 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
388 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
399 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
400 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
405 ind_scint=ind_scint+nct-i
409 ind_scint_old=ind_scint
417 if (iatsc_s.eq.0) iatsc_s=1
419 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
420 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
423 write (iout,'(a)') 'Interaction array:'
425 write (iout,'(i3,2(2x,2i3))')
426 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
431 C Now partition the electrostatic-interaction array
433 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
434 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
436 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
437 & ' absolute rank',MyRank,
438 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
439 & ' my_ele_inde',my_ele_inde
446 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
447 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
450 if (iatel_s.eq.0) iatel_s=1
451 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
452 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
453 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
454 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
455 c & " my_ele_inde_vdw",my_ele_inde_vdw
462 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
464 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
466 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
467 c & " ielend_vdw",ielend_vdw(i)
469 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
480 do i=iatel_s_vdw,iatel_e_vdw
486 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
487 & ' absolute rank',MyRank
488 write (iout,*) 'Electrostatic interaction array:'
490 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
495 C Partition the SC-p interaction array
497 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
498 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
499 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
500 & ' absolute rank',myrank,
501 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
502 & ' my_scp_inde',my_scp_inde
508 if (i.lt.nnt+iscp) then
509 cd write (iout,*) 'i.le.nnt+iscp'
510 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
511 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
513 else if (i.gt.nct-iscp) then
514 cd write (iout,*) 'i.gt.nct-iscp'
515 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
516 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
519 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
520 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
523 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
524 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
533 if (i.lt.nnt+iscp) then
535 iscpstart(i,1)=i+iscp
537 elseif (i.gt.nct-iscp) then
545 iscpstart(i,2)=i+iscp
550 if (iatscp_s.eq.0) iatscp_s=1
552 write (iout,'(a)') 'SC-p interaction array:'
553 do i=iatscp_s,iatscp_e
554 write (iout,'(i3,2(2x,2i3))')
555 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
558 C Partition local interactions
560 call int_bounds(nres-2,loc_start,loc_end)
561 loc_start=loc_start+1
563 call int_bounds(nres-2,ithet_start,ithet_end)
564 ithet_start=ithet_start+2
565 ithet_end=ithet_end+2
566 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
567 iturn3_start=iturn3_start+nnt
568 iphi_start=iturn3_start+2
569 iturn3_end=iturn3_end+nnt
570 iphi_end=iturn3_end+2
571 iturn3_start=iturn3_start-1
572 iturn3_end=iturn3_end-1
573 call int_bounds(nres-3,itau_start,itau_end)
574 itau_start=itau_start+3
576 call int_bounds(nres-3,iphi1_start,iphi1_end)
577 iphi1_start=iphi1_start+3
578 iphi1_end=iphi1_end+3
579 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
580 iturn4_start=iturn4_start+nnt
581 iphid_start=iturn4_start+2
582 iturn4_end=iturn4_end+nnt
583 iphid_end=iturn4_end+2
584 iturn4_start=iturn4_start-1
585 iturn4_end=iturn4_end-1
586 call int_bounds(nres-2,ibond_start,ibond_end)
587 ibond_start=ibond_start+1
588 ibond_end=ibond_end+1
589 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
590 ibondp_start=ibondp_start+nnt
591 ibondp_end=ibondp_end+nnt
592 call int_bounds1(nres-1,ivec_start,ivec_end)
593 print *,"Processor",myrank,fg_rank,fg_rank1,
594 & " ivec_start",ivec_start," ivec_end",ivec_end
595 iset_start=loc_start+2
597 if (ndih_constr.eq.0) then
601 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
603 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
605 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
606 igrad_start=((2*nlen+1)
607 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
608 jgrad_start(igrad_start)=
609 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
611 jgrad_end(igrad_start)=nres
612 igrad_end=((2*nlen+1)
613 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
614 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
615 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
617 do i=igrad_start+1,igrad_end-1
622 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
623 & ' absolute rank',myrank,
624 & ' loc_start',loc_start,' loc_end',loc_end,
625 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
626 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
627 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
628 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
629 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
630 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
631 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
632 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
633 & ' iset_start',iset_start,' iset_end',iset_end,
634 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
636 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
637 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
638 & ' ngrad_end',ngrad_end
639 do i=igrad_start,igrad_end
640 write(*,*) 'Processor:',fg_rank,myrank,i,
641 & jgrad_start(i),jgrad_end(i)
644 if (nfgtasks.gt.1) then
645 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
646 & MPI_INTEGER,FG_COMM1,IERROR)
647 iaux=ivec_end-ivec_start+1
648 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
649 & MPI_INTEGER,FG_COMM1,IERROR)
650 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
651 & MPI_INTEGER,FG_COMM,IERROR)
652 iaux=iset_end-iset_start+1
653 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
654 & MPI_INTEGER,FG_COMM,IERROR)
655 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
656 & MPI_INTEGER,FG_COMM,IERROR)
657 iaux=ibond_end-ibond_start+1
658 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
659 & MPI_INTEGER,FG_COMM,IERROR)
660 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
661 & MPI_INTEGER,FG_COMM,IERROR)
662 iaux=ithet_end-ithet_start+1
663 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
666 & MPI_INTEGER,FG_COMM,IERROR)
667 iaux=iphi_end-iphi_start+1
668 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
669 & MPI_INTEGER,FG_COMM,IERROR)
670 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
671 & MPI_INTEGER,FG_COMM,IERROR)
672 iaux=iphi1_end-iphi1_start+1
673 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
674 & MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
682 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
684 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
686 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
688 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
689 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
690 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
692 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
693 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
694 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
695 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
696 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
698 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
699 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
700 write (iout,*) "iturn3_start_all",
701 & (iturn3_start_all(i),i=0,nfgtasks-1)
702 write (iout,*) "iturn3_end_all",
703 & (iturn3_end_all(i),i=0,nfgtasks-1)
704 write (iout,*) "iturn4_start_all",
705 & (iturn4_start_all(i),i=0,nfgtasks-1)
706 write (iout,*) "iturn4_end_all",
707 & (iturn4_end_all(i),i=0,nfgtasks-1)
708 write (iout,*) "The ielstart_all array"
710 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
712 write (iout,*) "The ielend_all array"
714 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
720 itask_cont_from(0)=fg_rank
721 itask_cont_to(0)=fg_rank
723 do ii=iturn3_start,iturn3_end
724 call add_int(ii,ii+2,iturn3_sent(1,ii),
725 & ntask_cont_to,itask_cont_to,flag)
727 do ii=iturn4_start,iturn4_end
728 call add_int(ii,ii+3,iturn4_sent(1,ii),
729 & ntask_cont_to,itask_cont_to,flag)
731 do ii=iturn3_start,iturn3_end
732 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
734 do ii=iturn4_start,iturn4_end
735 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
738 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
739 & " ntask_cont_to",ntask_cont_to
740 write (iout,*) "itask_cont_from",
741 & (itask_cont_from(i),i=1,ntask_cont_from)
742 write (iout,*) "itask_cont_to",
743 & (itask_cont_to(i),i=1,ntask_cont_to)
746 c write (iout,*) "Loop forward"
749 c write (iout,*) "from loop i=",i
751 do j=ielstart(i),ielend(i)
752 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
755 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
756 c & " iatel_e",iatel_e
760 c write (iout,*) "i",i," ielstart",ielstart(i),
761 c & " ielend",ielend(i)
764 do j=ielstart(i),ielend(i)
765 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
766 & itask_cont_to,flag)
774 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
775 & " ntask_cont_to",ntask_cont_to
776 write (iout,*) "itask_cont_from",
777 & (itask_cont_from(i),i=1,ntask_cont_from)
778 write (iout,*) "itask_cont_to",
779 & (itask_cont_to(i),i=1,ntask_cont_to)
781 write (iout,*) "iint_sent"
784 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
785 & j=ielstart(ii),ielend(ii))
787 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
788 & " iturn3_end",iturn3_end
789 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
790 & i=iturn3_start,iturn3_end)
791 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
792 & " iturn4_end",iturn4_end
793 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
794 & i=iturn4_start,iturn4_end)
797 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
798 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
799 c write (iout,*) "Gather ntask_cont_from ended"
801 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
802 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
804 c write (iout,*) "Gather itask_cont_from ended"
806 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
807 & 1,MPI_INTEGER,king,FG_COMM,IERR)
808 c write (iout,*) "Gather ntask_cont_to ended"
810 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
811 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
812 c write (iout,*) "Gather itask_cont_to ended"
814 if (fg_rank.eq.king) then
815 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
817 write (iout,'(20i4)') i,ntask_cont_from_all(i),
818 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
822 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
824 write (iout,'(20i4)') i,ntask_cont_to_all(i),
825 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
829 C Check if every send will have a matching receive
833 ncheck_to=ncheck_to+ntask_cont_to_all(i)
834 ncheck_from=ncheck_from+ntask_cont_from_all(i)
836 write (iout,*) "Control sums",ncheck_from,ncheck_to
837 if (ncheck_from.ne.ncheck_to) then
838 write (iout,*) "Error: #receive differs from #send."
839 write (iout,*) "Terminating program...!"
845 do j=1,ntask_cont_to_all(i)
846 ii=itask_cont_to_all(j,i)
847 do k=1,ntask_cont_from_all(ii)
848 if (itask_cont_from_all(k,ii).eq.i) then
849 if(lprint)write(iout,*)"Matching send/receive",i,ii
853 if (k.eq.ntask_cont_from_all(ii)+1) then
855 write (iout,*) "Error: send by",j," to",ii,
856 & " would have no matching receive"
862 write (iout,*) "Unmatched sends; terminating program"
866 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
867 c write (iout,*) "flag broadcast ended flag=",flag
870 call MPI_Finalize(IERROR)
871 stop "Error in INIT_INT_TABLE: unmatched send/receive."
873 call MPI_Comm_group(FG_COMM,fg_group,IERR)
874 c write (iout,*) "MPI_Comm_group ended"
876 call MPI_Group_incl(fg_group,ntask_cont_from+1,
877 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
878 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
879 & CONT_TO_GROUP,IERR)
882 iaux=4*(ielend(ii)-ielstart(ii)+1)
883 call MPI_Group_translate_ranks(fg_group,iaux,
884 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
885 & iint_sent_local(1,ielstart(ii),i),IERR )
886 c write (iout,*) "Ranks translated i=",i
889 iaux=4*(iturn3_end-iturn3_start+1)
890 call MPI_Group_translate_ranks(fg_group,iaux,
891 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
892 & iturn3_sent_local(1,iturn3_start),IERR)
893 iaux=4*(iturn4_end-iturn4_start+1)
894 call MPI_Group_translate_ranks(fg_group,iaux,
895 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
896 & iturn4_sent_local(1,iturn4_start),IERR)
898 write (iout,*) "iint_sent_local"
901 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
902 & j=ielstart(ii),ielend(ii))
905 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
906 & " iturn3_end",iturn3_end
907 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
908 & i=iturn3_start,iturn3_end)
909 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
910 & " iturn4_end",iturn4_end
911 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
912 & i=iturn4_start,iturn4_end)
915 call MPI_Group_free(fg_group,ierr)
916 call MPI_Group_free(cont_from_group,ierr)
917 call MPI_Group_free(cont_to_group,ierr)
918 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
919 call MPI_Type_commit(MPI_UYZ,IERROR)
920 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
922 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
923 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
924 call MPI_Type_commit(MPI_MU,IERROR)
925 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
926 call MPI_Type_commit(MPI_MAT1,IERROR)
927 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
928 call MPI_Type_commit(MPI_MAT2,IERROR)
929 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
930 call MPI_Type_commit(MPI_THET,IERROR)
931 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
932 call MPI_Type_commit(MPI_GAM,IERROR)
934 c 9/22/08 Derived types to send matrices which appear in correlation terms
936 if (ivec_count(i).eq.ivec_count(0)) then
942 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
943 if (ind_typ.eq.0) then
953 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
956 c blocklengths(i)=blocklengths(i)*ichunk
958 c write (iout,*) "blocklengths and displs"
960 c write (iout,*) i,blocklengths(i),displs(i)
963 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
964 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
965 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
966 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
972 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
975 c blocklengths(i)=blocklengths(i)*ichunk
977 c write (iout,*) "blocklengths and displs"
979 c write (iout,*) i,blocklengths(i),displs(i)
982 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
983 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
984 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
985 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
991 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
994 blocklengths(i)=blocklengths(i)*ichunk
996 call MPI_Type_indexed(8,blocklengths,displs,
997 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
998 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1004 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1007 blocklengths(i)=blocklengths(i)*ichunk
1009 call MPI_Type_indexed(8,blocklengths,displs,
1010 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1011 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1017 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1020 blocklengths(i)=blocklengths(i)*ichunk
1022 call MPI_Type_indexed(6,blocklengths,displs,
1023 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1024 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1030 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1033 blocklengths(i)=blocklengths(i)*ichunk
1035 call MPI_Type_indexed(2,blocklengths,displs,
1036 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1037 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1043 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1046 blocklengths(i)=blocklengths(i)*ichunk
1048 call MPI_Type_indexed(4,blocklengths,displs,
1049 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1050 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1054 iint_start=ivec_start+1
1057 iint_count(i)=ivec_count(i)
1058 iint_displ(i)=ivec_displ(i)
1059 ivec_displ(i)=ivec_displ(i)-1
1060 iset_displ(i)=iset_displ(i)-1
1061 ithet_displ(i)=ithet_displ(i)-1
1062 iphi_displ(i)=iphi_displ(i)-1
1063 iphi1_displ(i)=iphi1_displ(i)-1
1064 ibond_displ(i)=ibond_displ(i)-1
1066 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1067 & .and. (me.eq.0 .or. out1file)) then
1068 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1070 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1073 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1074 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1075 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1077 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1080 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1081 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1082 & ' SC-p interactions','were distributed among',nfgtasks,
1083 & ' fine-grain processors.'
1099 idihconstr_end=ndih_constr
1100 iphid_start=iphi_start
1101 iphid_end=iphi_end-1
1118 c---------------------------------------------------------------------------
1119 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1121 include "DIMENSIONS"
1122 include "COMMON.INTERACT"
1123 include "COMMON.SETUP"
1124 include "COMMON.IOUNITS"
1125 integer ii,jj,itask(4),
1126 & ntask_cont_to,itask_cont_to(0:max_fg_procs-1)
1128 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1129 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1130 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1131 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1132 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1133 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1134 & ielend_all(maxres,0:max_fg_procs-1)
1135 integer iproc,isent,k,l
1136 c Determines whether to send interaction ii,jj to other processors; a given
1137 c interaction can be sent to at most 2 processors.
1138 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1139 c one processor, otherwise flag is unchanged from the input value.
1145 c write (iout,*) "ii",ii," jj",jj
1146 c Loop over processors to check if anybody could need interaction ii,jj
1147 do iproc=0,fg_rank-1
1148 c Check if the interaction matches any turn3 at iproc
1149 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1151 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1152 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1154 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1157 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1158 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1161 call add_task(iproc,ntask_cont_to,itask_cont_to)
1165 C Check if the interaction matches any turn4 at iproc
1166 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1168 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1169 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1171 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1174 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1175 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1178 call add_task(iproc,ntask_cont_to,itask_cont_to)
1182 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1183 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1184 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1185 & ielend_all(ii-1,iproc).ge.jj-1) then
1187 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1188 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1191 call add_task(iproc,ntask_cont_to,itask_cont_to)
1194 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1195 & ielend_all(ii-1,iproc).ge.jj+1) then
1197 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1198 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1201 call add_task(iproc,ntask_cont_to,itask_cont_to)
1208 c---------------------------------------------------------------------------
1209 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1211 include "DIMENSIONS"
1212 include "COMMON.INTERACT"
1213 include "COMMON.SETUP"
1214 include "COMMON.IOUNITS"
1215 integer ii,jj,itask(2),ntask_cont_from,
1216 & itask_cont_from(0:max_fg_procs-1)
1218 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1219 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1220 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1221 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1222 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1223 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1224 & ielend_all(maxres,0:max_fg_procs-1)
1226 do iproc=fg_rank+1,nfgtasks-1
1227 do k=iturn3_start_all(iproc),iturn3_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,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1233 call add_task(iproc,ntask_cont_from,itask_cont_from)
1236 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1238 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1239 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1241 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1242 call add_task(iproc,ntask_cont_from,itask_cont_from)
1245 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1246 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1248 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1249 & jj+1.le.ielend_all(ii+1,iproc)) then
1250 call add_task(iproc,ntask_cont_from,itask_cont_from)
1252 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1253 & jj-1.le.ielend_all(ii+1,iproc)) then
1254 call add_task(iproc,ntask_cont_from,itask_cont_from)
1257 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1259 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1260 & jj-1.le.ielend_all(ii-1,iproc)) then
1261 call add_task(iproc,ntask_cont_from,itask_cont_from)
1263 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1264 & jj+1.le.ielend_all(ii-1,iproc)) then
1265 call add_task(iproc,ntask_cont_from,itask_cont_from)
1272 c---------------------------------------------------------------------------
1273 subroutine add_task(iproc,ntask_cont,itask_cont)
1275 include "DIMENSIONS"
1276 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1279 if (itask_cont(ii).eq.iproc) return
1281 ntask_cont=ntask_cont+1
1282 itask_cont(ntask_cont)=iproc
1285 c---------------------------------------------------------------------------
1286 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1287 implicit real*8 (a-h,o-z)
1288 include 'DIMENSIONS'
1290 include 'COMMON.SETUP'
1291 integer total_ints,lower_bound,upper_bound
1292 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1293 nint=total_ints/nfgtasks
1297 nexcess=total_ints-nint*nfgtasks
1299 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1303 lower_bound=lower_bound+int4proc(i)
1305 upper_bound=lower_bound+int4proc(fg_rank)
1306 lower_bound=lower_bound+1
1309 c---------------------------------------------------------------------------
1310 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1311 implicit real*8 (a-h,o-z)
1312 include 'DIMENSIONS'
1314 include 'COMMON.SETUP'
1315 integer total_ints,lower_bound,upper_bound
1316 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1317 nint=total_ints/nfgtasks1
1321 nexcess=total_ints-nint*nfgtasks1
1323 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1327 lower_bound=lower_bound+int4proc(i)
1329 upper_bound=lower_bound+int4proc(fg_rank1)
1330 lower_bound=lower_bound+1
1333 c---------------------------------------------------------------------------
1334 subroutine int_partition(int_index,lower_index,upper_index,atom,
1335 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1336 implicit real*8 (a-h,o-z)
1337 include 'DIMENSIONS'
1338 include 'COMMON.IOUNITS'
1339 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1340 & first_atom,last_atom,int_gr,jat_start,jat_end
1343 if (lprn) write (iout,*) 'int_index=',int_index
1344 int_index_old=int_index
1345 int_index=int_index+last_atom-first_atom+1
1347 & write (iout,*) 'int_index=',int_index,
1348 & ' int_index_old',int_index_old,
1349 & ' lower_index=',lower_index,
1350 & ' upper_index=',upper_index,
1351 & ' atom=',atom,' first_atom=',first_atom,
1352 & ' last_atom=',last_atom
1353 if (int_index.ge.lower_index) then
1355 if (at_start.eq.0) then
1357 jat_start=first_atom-1+lower_index-int_index_old
1359 jat_start=first_atom
1361 if (lprn) write (iout,*) 'jat_start',jat_start
1362 if (int_index.ge.upper_index) then
1364 jat_end=first_atom-1+upper_index-int_index_old
1369 if (lprn) write (iout,*) 'jat_end',jat_end
1374 c------------------------------------------------------------------------------
1375 subroutine hpb_partition
1376 implicit real*8 (a-h,o-z)
1377 include 'DIMENSIONS'
1381 include 'COMMON.SBRIDGE'
1382 include 'COMMON.IOUNITS'
1383 include 'COMMON.SETUP'
1384 include 'COMMON.CONTROL'
1385 c write(2,*)"hpb_partition: nhpb=",nhpb
1387 call int_bounds(nhpb,link_start,link_end)
1389 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1390 & ' absolute rank',MyRank,
1391 & ' nhpb',nhpb,' link_start=',link_start,
1392 & ' link_end',link_end
1397 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end