2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
99 crc for write_rmsbank1
101 cdr include secondary structure prediction bias
104 C CSA I/O units (separated from others especially for Jooyoung)
115 icsa_bank_reminimized=38
118 crc for ifc error 118
121 C Set default weights of the energy terms.
132 c print '(a,$)','Inside initialize'
133 c call memmon_print_usage()
183 gaussc(l,k,j,i)=0.0D0
204 C Initialize the bridge arrays
223 C Initialize variables used in minimization.
232 C Initialize the variables responsible for the mode of gradient storage.
237 C Initialize constants used to split the energy into long- and short-range
243 nprint_ene=nprint_ene-1
247 c-------------------------------------------------------------------------
249 implicit real*8 (a-h,o-z)
251 include 'COMMON.NAMES'
252 include 'COMMON.FFIELD'
254 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
255 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
257 &'C','M','F','I','L','V','W','Y','A','G','T',
258 &'S','Q','N','E','D','H','R','K','P','X'/
259 data potname /'LJ','LJK','BP','GB','GBV'/
261 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
262 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
263 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
264 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
266 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
267 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
268 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
270 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
273 c---------------------------------------------------------------------------
274 subroutine init_int_table
275 implicit real*8 (a-h,o-z)
279 integer blocklengths(15),displs(15)
281 include 'COMMON.CONTROL'
282 include 'COMMON.SETUP'
283 include 'COMMON.CHAIN'
284 include 'COMMON.INTERACT'
285 include 'COMMON.LOCAL'
286 include 'COMMON.SBRIDGE'
287 include 'COMMON.TORCNSTR'
288 include 'COMMON.IOUNITS'
289 include 'COMMON.DERIV'
290 include 'COMMON.CONTACTS'
291 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
292 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
293 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
294 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
295 & ielend_all(maxres,0:max_fg_procs-1),
296 & ntask_cont_from_all(0:max_fg_procs-1),
297 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
298 & ntask_cont_to_all(0:max_fg_procs-1),
299 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
300 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
301 logical scheck,lprint,flag
303 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
304 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
305 C... Determine the numbers of start and end SC-SC interaction
306 C... to deal with by current processor.
308 itask_cont_from(i)=fg_rank
309 itask_cont_to(i)=fg_rank
313 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
314 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
315 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
317 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
318 & ' absolute rank',MyRank,
319 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
320 & ' my_sc_inde',my_sc_inde
340 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
341 cd & (ihpb(i),jhpb(i),i=1,nss)
346 if (ihpb(ii).eq.i+nres) then
353 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
357 c write (iout,*) 'jj=i+1'
358 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
359 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
365 else if (jj.eq.nct) then
367 c write (iout,*) 'jj=nct'
368 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
369 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
377 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
378 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
380 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
381 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
392 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
393 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
398 ind_scint=ind_scint+nct-i
402 ind_scint_old=ind_scint
411 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
412 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
415 write (iout,'(a)') 'Interaction array:'
417 write (iout,'(i3,2(2x,2i3))')
418 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
423 C Now partition the electrostatic-interaction array
425 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
426 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
428 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
429 & ' absolute rank',MyRank,
430 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
431 & ' my_ele_inde',my_ele_inde
438 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
439 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
442 if (iatel_s.eq.0) iatel_s=1
443 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
444 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
445 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
446 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
447 c & " my_ele_inde_vdw",my_ele_inde_vdw
454 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
456 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
458 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
459 c & " ielend_vdw",ielend_vdw(i)
461 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
472 do i=iatel_s_vdw,iatel_e_vdw
478 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
479 & ' absolute rank',MyRank
480 write (iout,*) 'Electrostatic interaction array:'
482 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
487 C Partition the SC-p interaction array
489 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
490 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
491 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
492 & ' absolute rank',myrank,
493 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
494 & ' my_scp_inde',my_scp_inde
500 if (i.lt.nnt+iscp) then
501 cd write (iout,*) 'i.le.nnt+iscp'
502 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
503 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
505 else if (i.gt.nct-iscp) then
506 cd write (iout,*) 'i.gt.nct-iscp'
507 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
508 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
511 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
512 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
515 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
516 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
525 if (i.lt.nnt+iscp) then
527 iscpstart(i,1)=i+iscp
529 elseif (i.gt.nct-iscp) then
537 iscpstart(i,2)=i+iscp
543 write (iout,'(a)') 'SC-p interaction array:'
544 do i=iatscp_s,iatscp_e
545 write (iout,'(i3,2(2x,2i3))')
546 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
549 C Partition local interactions
551 call int_bounds(nres-2,loc_start,loc_end)
552 loc_start=loc_start+1
554 call int_bounds(nres-2,ithet_start,ithet_end)
555 ithet_start=ithet_start+2
556 ithet_end=ithet_end+2
557 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
558 iturn3_start=iturn3_start+nnt
559 iphi_start=iturn3_start+2
560 iturn3_end=iturn3_end+nnt
561 iphi_end=iturn3_end+2
562 iturn3_start=iturn3_start-1
563 iturn3_end=iturn3_end-1
564 call int_bounds(nres-3,itau_start,itau_end)
565 itau_start=itau_start+3
567 call int_bounds(nres-3,iphi1_start,iphi1_end)
568 iphi1_start=iphi1_start+3
569 iphi1_end=iphi1_end+3
570 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
571 iturn4_start=iturn4_start+nnt
572 iphid_start=iturn4_start+2
573 iturn4_end=iturn4_end+nnt
574 iphid_end=iturn4_end+2
575 iturn4_start=iturn4_start-1
576 iturn4_end=iturn4_end-1
577 call int_bounds(nres-2,ibond_start,ibond_end)
578 ibond_start=ibond_start+1
579 ibond_end=ibond_end+1
580 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
581 ibondp_start=ibondp_start+nnt
582 ibondp_end=ibondp_end+nnt
583 call int_bounds1(nres-1,ivec_start,ivec_end)
584 c print *,"Processor",myrank,fg_rank,fg_rank1,
585 c & " ivec_start",ivec_start," ivec_end",ivec_end
586 iset_start=loc_start+2
588 if (ndih_constr.eq.0) then
592 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
594 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
596 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
598 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
599 igrad_start=((2*nlen+1)
600 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
601 jgrad_start(igrad_start)=
602 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
604 jgrad_end(igrad_start)=nres
605 igrad_end=((2*nlen+1)
606 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
607 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
608 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
610 do i=igrad_start+1,igrad_end-1
615 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
616 & ' absolute rank',myrank,
617 & ' loc_start',loc_start,' loc_end',loc_end,
618 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
619 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
620 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
621 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
622 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
623 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
624 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
625 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
626 & ' iset_start',iset_start,' iset_end',iset_end,
627 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
629 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
630 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
631 & ' ngrad_end',ngrad_end
632 do i=igrad_start,igrad_end
633 write(*,*) 'Processor:',fg_rank,myrank,i,
634 & jgrad_start(i),jgrad_end(i)
637 if (nfgtasks.gt.1) then
638 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
639 & MPI_INTEGER,FG_COMM1,IERROR)
640 iaux=ivec_end-ivec_start+1
641 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
642 & MPI_INTEGER,FG_COMM1,IERROR)
643 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
644 & MPI_INTEGER,FG_COMM,IERROR)
645 iaux=iset_end-iset_start+1
646 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
647 & MPI_INTEGER,FG_COMM,IERROR)
648 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
649 & MPI_INTEGER,FG_COMM,IERROR)
650 iaux=ibond_end-ibond_start+1
651 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
652 & MPI_INTEGER,FG_COMM,IERROR)
653 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
654 & MPI_INTEGER,FG_COMM,IERROR)
655 iaux=ithet_end-ithet_start+1
656 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
657 & MPI_INTEGER,FG_COMM,IERROR)
658 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
659 & MPI_INTEGER,FG_COMM,IERROR)
660 iaux=iphi_end-iphi_start+1
661 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
662 & MPI_INTEGER,FG_COMM,IERROR)
663 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 iaux=iphi1_end-iphi1_start+1
666 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
667 & MPI_INTEGER,FG_COMM,IERROR)
674 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
675 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
676 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
677 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
678 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
679 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
680 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
681 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
683 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
685 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
687 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
689 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
691 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
692 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
693 write (iout,*) "iturn3_start_all",
694 & (iturn3_start_all(i),i=0,nfgtasks-1)
695 write (iout,*) "iturn3_end_all",
696 & (iturn3_end_all(i),i=0,nfgtasks-1)
697 write (iout,*) "iturn4_start_all",
698 & (iturn4_start_all(i),i=0,nfgtasks-1)
699 write (iout,*) "iturn4_end_all",
700 & (iturn4_end_all(i),i=0,nfgtasks-1)
701 write (iout,*) "The ielstart_all array"
703 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
705 write (iout,*) "The ielend_all array"
707 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
713 itask_cont_from(0)=fg_rank
714 itask_cont_to(0)=fg_rank
716 do ii=iturn3_start,iturn3_end
717 call add_int(ii,ii+2,iturn3_sent(1,ii),
718 & ntask_cont_to,itask_cont_to,flag)
720 do ii=iturn4_start,iturn4_end
721 call add_int(ii,ii+3,iturn4_sent(1,ii),
722 & ntask_cont_to,itask_cont_to,flag)
724 do ii=iturn3_start,iturn3_end
725 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
727 do ii=iturn4_start,iturn4_end
728 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
731 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
732 & " ntask_cont_to",ntask_cont_to
733 write (iout,*) "itask_cont_from",
734 & (itask_cont_from(i),i=1,ntask_cont_from)
735 write (iout,*) "itask_cont_to",
736 & (itask_cont_to(i),i=1,ntask_cont_to)
739 c write (iout,*) "Loop forward"
742 c write (iout,*) "from loop i=",i
744 do j=ielstart(i),ielend(i)
745 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
748 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
749 c & " iatel_e",iatel_e
753 c write (iout,*) "i",i," ielstart",ielstart(i),
754 c & " ielend",ielend(i)
757 do j=ielstart(i),ielend(i)
758 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
759 & itask_cont_to,flag)
767 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
768 & " ntask_cont_to",ntask_cont_to
769 write (iout,*) "itask_cont_from",
770 & (itask_cont_from(i),i=1,ntask_cont_from)
771 write (iout,*) "itask_cont_to",
772 & (itask_cont_to(i),i=1,ntask_cont_to)
774 write (iout,*) "iint_sent"
777 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
778 & j=ielstart(ii),ielend(ii))
780 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
781 & " iturn3_end",iturn3_end
782 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
783 & i=iturn3_start,iturn3_end)
784 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
785 & " iturn4_end",iturn4_end
786 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
787 & i=iturn4_start,iturn4_end)
790 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
791 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
792 c write (iout,*) "Gather ntask_cont_from ended"
794 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
795 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
797 c write (iout,*) "Gather itask_cont_from ended"
799 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
800 & 1,MPI_INTEGER,king,FG_COMM,IERR)
801 c write (iout,*) "Gather ntask_cont_to ended"
803 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
804 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
805 c write (iout,*) "Gather itask_cont_to ended"
807 if (fg_rank.eq.king) then
808 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
810 write (iout,'(20i4)') i,ntask_cont_from_all(i),
811 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
815 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
817 write (iout,'(20i4)') i,ntask_cont_to_all(i),
818 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
822 C Check if every send will have a matching receive
826 ncheck_to=ncheck_to+ntask_cont_to_all(i)
827 ncheck_from=ncheck_from+ntask_cont_from_all(i)
829 write (iout,*) "Control sums",ncheck_from,ncheck_to
830 if (ncheck_from.ne.ncheck_to) then
831 write (iout,*) "Error: #receive differs from #send."
832 write (iout,*) "Terminating program...!"
838 do j=1,ntask_cont_to_all(i)
839 ii=itask_cont_to_all(j,i)
840 do k=1,ntask_cont_from_all(ii)
841 if (itask_cont_from_all(k,ii).eq.i) then
842 if(lprint)write(iout,*)"Matching send/receive",i,ii
846 if (k.eq.ntask_cont_from_all(ii)+1) then
848 write (iout,*) "Error: send by",j," to",ii,
849 & " would have no matching receive"
855 write (iout,*) "Unmatched sends; terminating program"
859 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
860 c write (iout,*) "flag broadcast ended flag=",flag
863 call MPI_Finalize(IERROR)
864 stop "Error in INIT_INT_TABLE: unmatched send/receive."
866 call MPI_Comm_group(FG_COMM,fg_group,IERR)
867 c write (iout,*) "MPI_Comm_group ended"
869 call MPI_Group_incl(fg_group,ntask_cont_from+1,
870 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
871 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
872 & CONT_TO_GROUP,IERR)
875 iaux=4*(ielend(ii)-ielstart(ii)+1)
876 call MPI_Group_translate_ranks(fg_group,iaux,
877 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
878 & iint_sent_local(1,ielstart(ii),i),IERR )
879 c write (iout,*) "Ranks translated i=",i
882 iaux=4*(iturn3_end-iturn3_start+1)
883 call MPI_Group_translate_ranks(fg_group,iaux,
884 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
885 & iturn3_sent_local(1,iturn3_start),IERR)
886 iaux=4*(iturn4_end-iturn4_start+1)
887 call MPI_Group_translate_ranks(fg_group,iaux,
888 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
889 & iturn4_sent_local(1,iturn4_start),IERR)
891 write (iout,*) "iint_sent_local"
894 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
895 & j=ielstart(ii),ielend(ii))
898 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
899 & " iturn3_end",iturn3_end
900 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
901 & i=iturn3_start,iturn3_end)
902 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
903 & " iturn4_end",iturn4_end
904 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
905 & i=iturn4_start,iturn4_end)
908 call MPI_Group_free(fg_group,ierr)
909 call MPI_Group_free(cont_from_group,ierr)
910 call MPI_Group_free(cont_to_group,ierr)
911 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
912 call MPI_Type_commit(MPI_UYZ,IERROR)
913 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
915 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
916 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
917 call MPI_Type_commit(MPI_MU,IERROR)
918 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
919 call MPI_Type_commit(MPI_MAT1,IERROR)
920 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
921 call MPI_Type_commit(MPI_MAT2,IERROR)
922 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
923 call MPI_Type_commit(MPI_THET,IERROR)
924 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
925 call MPI_Type_commit(MPI_GAM,IERROR)
927 c 9/22/08 Derived types to send matrices which appear in correlation terms
929 if (ivec_count(i).eq.ivec_count(0)) then
935 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
936 if (ind_typ.eq.0) then
946 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
949 c blocklengths(i)=blocklengths(i)*ichunk
951 c write (iout,*) "blocklengths and displs"
953 c write (iout,*) i,blocklengths(i),displs(i)
956 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
957 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
958 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
959 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
965 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
968 c blocklengths(i)=blocklengths(i)*ichunk
970 c write (iout,*) "blocklengths and displs"
972 c write (iout,*) i,blocklengths(i),displs(i)
975 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
976 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
977 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
978 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
984 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
987 blocklengths(i)=blocklengths(i)*ichunk
989 call MPI_Type_indexed(8,blocklengths,displs,
990 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
991 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
997 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1000 blocklengths(i)=blocklengths(i)*ichunk
1002 call MPI_Type_indexed(8,blocklengths,displs,
1003 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1004 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1010 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1013 blocklengths(i)=blocklengths(i)*ichunk
1015 call MPI_Type_indexed(6,blocklengths,displs,
1016 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1017 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1023 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1026 blocklengths(i)=blocklengths(i)*ichunk
1028 call MPI_Type_indexed(2,blocklengths,displs,
1029 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1030 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1036 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1039 blocklengths(i)=blocklengths(i)*ichunk
1041 call MPI_Type_indexed(4,blocklengths,displs,
1042 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1043 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1047 iint_start=ivec_start+1
1050 iint_count(i)=ivec_count(i)
1051 iint_displ(i)=ivec_displ(i)
1052 ivec_displ(i)=ivec_displ(i)-1
1053 iset_displ(i)=iset_displ(i)-1
1054 ithet_displ(i)=ithet_displ(i)-1
1055 iphi_displ(i)=iphi_displ(i)-1
1056 iphi1_displ(i)=iphi1_displ(i)-1
1057 ibond_displ(i)=ibond_displ(i)-1
1059 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1060 & .and. (me.eq.0 .or. .not. out1file)) then
1061 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1063 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1066 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1067 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1068 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1070 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1073 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1074 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1075 & ' SC-p interactions','were distributed among',nfgtasks,
1076 & ' fine-grain processors.'
1092 idihconstr_end=ndih_constr
1093 iphid_start=iphi_start
1094 iphid_end=iphi_end-1
1111 c---------------------------------------------------------------------------
1112 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1114 include "DIMENSIONS"
1115 include "COMMON.INTERACT"
1116 include "COMMON.SETUP"
1117 include "COMMON.IOUNITS"
1118 integer ii,jj,itask(4),ntask_cont_to,
1119 &itask_cont_to(0:max_fg_procs-1)
1121 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1122 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1123 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1124 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1125 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1126 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1127 & ielend_all(maxres,0:max_fg_procs-1)
1128 integer iproc,isent,k,l
1129 c Determines whether to send interaction ii,jj to other processors; a given
1130 c interaction can be sent to at most 2 processors.
1131 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1132 c one processor, otherwise flag is unchanged from the input value.
1138 c write (iout,*) "ii",ii," jj",jj
1139 c Loop over processors to check if anybody could need interaction ii,jj
1140 do iproc=0,fg_rank-1
1141 c Check if the interaction matches any turn3 at iproc
1142 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1144 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1145 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1147 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1150 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1151 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1154 call add_task(iproc,ntask_cont_to,itask_cont_to)
1158 C Check if the interaction matches any turn4 at iproc
1159 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1161 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1162 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1164 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1167 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1168 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1171 call add_task(iproc,ntask_cont_to,itask_cont_to)
1175 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1176 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1177 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1178 & ielend_all(ii-1,iproc).ge.jj-1) then
1180 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1181 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1184 call add_task(iproc,ntask_cont_to,itask_cont_to)
1187 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1188 & ielend_all(ii-1,iproc).ge.jj+1) then
1190 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1191 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1194 call add_task(iproc,ntask_cont_to,itask_cont_to)
1201 c---------------------------------------------------------------------------
1202 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1204 include "DIMENSIONS"
1205 include "COMMON.INTERACT"
1206 include "COMMON.SETUP"
1207 include "COMMON.IOUNITS"
1208 integer ii,jj,itask(2),ntask_cont_from,
1209 & itask_cont_from(0:max_fg_procs-1)
1211 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1212 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1213 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1214 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1215 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1216 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1217 & ielend_all(maxres,0:max_fg_procs-1)
1219 do iproc=fg_rank+1,nfgtasks-1
1220 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1222 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1223 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1225 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1226 call add_task(iproc,ntask_cont_from,itask_cont_from)
1229 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1231 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1232 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1234 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1235 call add_task(iproc,ntask_cont_from,itask_cont_from)
1238 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1239 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1241 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1242 & jj+1.le.ielend_all(ii+1,iproc)) then
1243 call add_task(iproc,ntask_cont_from,itask_cont_from)
1245 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1246 & jj-1.le.ielend_all(ii+1,iproc)) then
1247 call add_task(iproc,ntask_cont_from,itask_cont_from)
1250 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
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)
1256 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1257 & jj+1.le.ielend_all(ii-1,iproc)) then
1258 call add_task(iproc,ntask_cont_from,itask_cont_from)
1265 c---------------------------------------------------------------------------
1266 subroutine add_task(iproc,ntask_cont,itask_cont)
1268 include "DIMENSIONS"
1269 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1272 if (itask_cont(ii).eq.iproc) return
1274 ntask_cont=ntask_cont+1
1275 itask_cont(ntask_cont)=iproc
1278 c---------------------------------------------------------------------------
1279 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1283 include 'COMMON.SETUP'
1284 integer total_ints,lower_bound,upper_bound
1285 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1286 nint=total_ints/nfgtasks
1290 nexcess=total_ints-nint*nfgtasks
1292 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1296 lower_bound=lower_bound+int4proc(i)
1298 upper_bound=lower_bound+int4proc(fg_rank)
1299 lower_bound=lower_bound+1
1302 c---------------------------------------------------------------------------
1303 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1307 include 'COMMON.SETUP'
1308 integer total_ints,lower_bound,upper_bound
1309 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1310 nint=total_ints/nfgtasks1
1314 nexcess=total_ints-nint*nfgtasks1
1316 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1320 lower_bound=lower_bound+int4proc(i)
1322 upper_bound=lower_bound+int4proc(fg_rank1)
1323 lower_bound=lower_bound+1
1326 c---------------------------------------------------------------------------
1327 subroutine int_partition(int_index,lower_index,upper_index,atom,
1328 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1329 implicit real*8 (a-h,o-z)
1330 include 'DIMENSIONS'
1331 include 'COMMON.IOUNITS'
1332 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1333 & first_atom,last_atom,int_gr,jat_start,jat_end
1336 if (lprn) write (iout,*) 'int_index=',int_index
1337 int_index_old=int_index
1338 int_index=int_index+last_atom-first_atom+1
1340 & write (iout,*) 'int_index=',int_index,
1341 & ' int_index_old',int_index_old,
1342 & ' lower_index=',lower_index,
1343 & ' upper_index=',upper_index,
1344 & ' atom=',atom,' first_atom=',first_atom,
1345 & ' last_atom=',last_atom
1346 if (int_index.ge.lower_index) then
1348 if (at_start.eq.0) then
1350 jat_start=first_atom-1+lower_index-int_index_old
1352 jat_start=first_atom
1354 if (lprn) write (iout,*) 'jat_start',jat_start
1355 if (int_index.ge.upper_index) then
1357 jat_end=first_atom-1+upper_index-int_index_old
1362 if (lprn) write (iout,*) 'jat_end',jat_end
1367 c------------------------------------------------------------------------------
1368 subroutine hpb_partition
1369 implicit real*8 (a-h,o-z)
1370 include 'DIMENSIONS'
1374 include 'COMMON.SBRIDGE'
1375 include 'COMMON.IOUNITS'
1376 include 'COMMON.SETUP'
1378 call int_bounds(nhpb,link_start,link_end)
1379 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1380 & ' absolute rank',MyRank,
1381 & ' nhpb',nhpb,' link_start=',link_start,
1382 & ' link_end',link_end