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:MaxProcs),
292 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
293 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
294 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
295 & ielend_all(maxres,0:MaxProcs-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)
345 if (ihpb(ii).eq.i+nres) then
352 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
356 c write (iout,*) 'jj=i+1'
357 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
358 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
364 else if (jj.eq.nct) then
366 c write (iout,*) 'jj=nct'
367 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
368 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
376 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
377 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
379 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
380 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
391 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
392 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
397 ind_scint=ind_scint+nct-i
401 ind_scint_old=ind_scint
409 if (iatsc_s.eq.0) iatsc_s=1
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
542 if (iatscp_s.eq.0) iatscp_s=1
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,iphi1_start,iphi1_end)
566 iphi1_start=iphi1_start+3
567 iphi1_end=iphi1_end+3
568 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
569 iturn4_start=iturn4_start+nnt
570 iphid_start=iturn4_start+2
571 iturn4_end=iturn4_end+nnt
572 iphid_end=iturn4_end+2
573 iturn4_start=iturn4_start-1
574 iturn4_end=iturn4_end-1
575 call int_bounds(nres-2,ibond_start,ibond_end)
576 ibond_start=ibond_start+1
577 ibond_end=ibond_end+1
578 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
579 ibondp_start=ibondp_start+nnt
580 ibondp_end=ibondp_end+nnt
581 call int_bounds1(nres-1,ivec_start,ivec_end)
582 c print *,"Processor",myrank,fg_rank,fg_rank1,
583 c & " ivec_start",ivec_start," ivec_end",ivec_end
584 iset_start=loc_start+2
586 if (ndih_constr.eq.0) then
590 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
592 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
594 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
596 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
597 igrad_start=((2*nlen+1)
598 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
599 jgrad_start(igrad_start)=
600 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
602 jgrad_end(igrad_start)=nres
603 igrad_end=((2*nlen+1)
604 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
605 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
606 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
608 do i=igrad_start+1,igrad_end-1
613 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
614 & ' absolute rank',myrank,
615 & ' loc_start',loc_start,' loc_end',loc_end,
616 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
617 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
618 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
619 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
620 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
621 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
622 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
623 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
624 & ' iset_start',iset_start,' iset_end',iset_end,
625 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
627 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
628 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
629 & ' ngrad_end',ngrad_end
630 do i=igrad_start,igrad_end
631 write(*,*) 'Processor:',fg_rank,myrank,i,
632 & jgrad_start(i),jgrad_end(i)
635 if (nfgtasks.gt.1) then
636 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
637 & MPI_INTEGER,FG_COMM1,IERROR)
638 iaux=ivec_end-ivec_start+1
639 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
640 & MPI_INTEGER,FG_COMM1,IERROR)
641 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
642 & MPI_INTEGER,FG_COMM,IERROR)
643 iaux=iset_end-iset_start+1
644 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
645 & MPI_INTEGER,FG_COMM,IERROR)
646 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
647 & MPI_INTEGER,FG_COMM,IERROR)
648 iaux=ibond_end-ibond_start+1
649 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
650 & MPI_INTEGER,FG_COMM,IERROR)
651 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
652 & MPI_INTEGER,FG_COMM,IERROR)
653 iaux=ithet_end-ithet_start+1
654 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
655 & MPI_INTEGER,FG_COMM,IERROR)
656 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
657 & MPI_INTEGER,FG_COMM,IERROR)
658 iaux=iphi_end-iphi_start+1
659 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
660 & MPI_INTEGER,FG_COMM,IERROR)
661 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
662 & MPI_INTEGER,FG_COMM,IERROR)
663 iaux=iphi1_end-iphi1_start+1
664 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
665 & MPI_INTEGER,FG_COMM,IERROR)
672 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
673 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
674 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
675 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
676 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
677 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
678 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
679 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
680 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
681 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
683 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
685 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
687 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
689 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
690 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
691 write (iout,*) "iturn3_start_all",
692 & (iturn3_start_all(i),i=0,nfgtasks-1)
693 write (iout,*) "iturn3_end_all",
694 & (iturn3_end_all(i),i=0,nfgtasks-1)
695 write (iout,*) "iturn4_start_all",
696 & (iturn4_start_all(i),i=0,nfgtasks-1)
697 write (iout,*) "iturn4_end_all",
698 & (iturn4_end_all(i),i=0,nfgtasks-1)
699 write (iout,*) "The ielstart_all array"
701 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
703 write (iout,*) "The ielend_all array"
705 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
711 itask_cont_from(0)=fg_rank
712 itask_cont_to(0)=fg_rank
714 do ii=iturn3_start,iturn3_end
715 call add_int(ii,ii+2,iturn3_sent(1,ii),
716 & ntask_cont_to,itask_cont_to,flag)
718 do ii=iturn4_start,iturn4_end
719 call add_int(ii,ii+3,iturn4_sent(1,ii),
720 & ntask_cont_to,itask_cont_to,flag)
722 do ii=iturn3_start,iturn3_end
723 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
725 do ii=iturn4_start,iturn4_end
726 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
729 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
730 & " ntask_cont_to",ntask_cont_to
731 write (iout,*) "itask_cont_from",
732 & (itask_cont_from(i),i=1,ntask_cont_from)
733 write (iout,*) "itask_cont_to",
734 & (itask_cont_to(i),i=1,ntask_cont_to)
737 c write (iout,*) "Loop forward"
740 c write (iout,*) "from loop i=",i
742 do j=ielstart(i),ielend(i)
743 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
746 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
747 c & " iatel_e",iatel_e
751 c write (iout,*) "i",i," ielstart",ielstart(i),
752 c & " ielend",ielend(i)
755 do j=ielstart(i),ielend(i)
756 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
757 & itask_cont_to,flag)
765 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
766 & " ntask_cont_to",ntask_cont_to
767 write (iout,*) "itask_cont_from",
768 & (itask_cont_from(i),i=1,ntask_cont_from)
769 write (iout,*) "itask_cont_to",
770 & (itask_cont_to(i),i=1,ntask_cont_to)
772 write (iout,*) "iint_sent"
775 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
776 & j=ielstart(ii),ielend(ii))
778 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
779 & " iturn3_end",iturn3_end
780 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
781 & i=iturn3_start,iturn3_end)
782 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
783 & " iturn4_end",iturn4_end
784 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
785 & i=iturn4_start,iturn4_end)
788 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
789 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
790 c write (iout,*) "Gather ntask_cont_from ended"
792 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
793 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
795 c write (iout,*) "Gather itask_cont_from ended"
797 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
798 & 1,MPI_INTEGER,king,FG_COMM,IERR)
799 c write (iout,*) "Gather ntask_cont_to ended"
801 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
802 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
803 c write (iout,*) "Gather itask_cont_to ended"
805 if (fg_rank.eq.king) then
806 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
808 write (iout,'(20i4)') i,ntask_cont_from_all(i),
809 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
813 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
815 write (iout,'(20i4)') i,ntask_cont_to_all(i),
816 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
820 C Check if every send will have a matching receive
824 ncheck_to=ncheck_to+ntask_cont_to_all(i)
825 ncheck_from=ncheck_from+ntask_cont_from_all(i)
827 write (iout,*) "Control sums",ncheck_from,ncheck_to
828 if (ncheck_from.ne.ncheck_to) then
829 write (iout,*) "Error: #receive differs from #send."
830 write (iout,*) "Terminating program...!"
836 do j=1,ntask_cont_to_all(i)
837 ii=itask_cont_to_all(j,i)
838 do k=1,ntask_cont_from_all(ii)
839 if (itask_cont_from_all(k,ii).eq.i) then
840 if(lprint)write(iout,*)"Matching send/receive",i,ii
844 if (k.eq.ntask_cont_from_all(ii)+1) then
846 write (iout,*) "Error: send by",j," to",ii,
847 & " would have no matching receive"
853 write (iout,*) "Unmatched sends; terminating program"
857 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
858 c write (iout,*) "flag broadcast ended flag=",flag
861 call MPI_Finalize(IERROR)
862 stop "Error in INIT_INT_TABLE: unmatched send/receive."
864 call MPI_Comm_group(FG_COMM,fg_group,IERR)
865 c write (iout,*) "MPI_Comm_group ended"
867 call MPI_Group_incl(fg_group,ntask_cont_from+1,
868 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
869 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
870 & CONT_TO_GROUP,IERR)
873 iaux=4*(ielend(ii)-ielstart(ii)+1)
874 call MPI_Group_translate_ranks(fg_group,iaux,
875 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
876 & iint_sent_local(1,ielstart(ii),i),IERR )
877 c write (iout,*) "Ranks translated i=",i
880 iaux=4*(iturn3_end-iturn3_start+1)
881 call MPI_Group_translate_ranks(fg_group,iaux,
882 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
883 & iturn3_sent_local(1,iturn3_start),IERR)
884 iaux=4*(iturn4_end-iturn4_start+1)
885 call MPI_Group_translate_ranks(fg_group,iaux,
886 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
887 & iturn4_sent_local(1,iturn4_start),IERR)
889 write (iout,*) "iint_sent_local"
892 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
893 & j=ielstart(ii),ielend(ii))
896 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
897 & " iturn3_end",iturn3_end
898 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
899 & i=iturn3_start,iturn3_end)
900 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
901 & " iturn4_end",iturn4_end
902 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
903 & i=iturn4_start,iturn4_end)
906 call MPI_Group_free(fg_group,ierr)
907 call MPI_Group_free(cont_from_group,ierr)
908 call MPI_Group_free(cont_to_group,ierr)
909 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
910 call MPI_Type_commit(MPI_UYZ,IERROR)
911 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
913 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
914 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
915 call MPI_Type_commit(MPI_MU,IERROR)
916 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
917 call MPI_Type_commit(MPI_MAT1,IERROR)
918 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
919 call MPI_Type_commit(MPI_MAT2,IERROR)
920 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
921 call MPI_Type_commit(MPI_THET,IERROR)
922 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
923 call MPI_Type_commit(MPI_GAM,IERROR)
925 c 9/22/08 Derived types to send matrices which appear in correlation terms
927 if (ivec_count(i).eq.ivec_count(0)) then
933 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
934 if (ind_typ.eq.0) then
944 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
947 c blocklengths(i)=blocklengths(i)*ichunk
949 c write (iout,*) "blocklengths and displs"
951 c write (iout,*) i,blocklengths(i),displs(i)
954 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
955 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
956 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
957 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
963 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
966 c blocklengths(i)=blocklengths(i)*ichunk
968 c write (iout,*) "blocklengths and displs"
970 c write (iout,*) i,blocklengths(i),displs(i)
973 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
974 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
975 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
976 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
982 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
985 blocklengths(i)=blocklengths(i)*ichunk
987 call MPI_Type_indexed(8,blocklengths,displs,
988 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
989 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
995 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
998 blocklengths(i)=blocklengths(i)*ichunk
1000 call MPI_Type_indexed(8,blocklengths,displs,
1001 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1002 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1008 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1011 blocklengths(i)=blocklengths(i)*ichunk
1013 call MPI_Type_indexed(6,blocklengths,displs,
1014 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1015 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1021 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1024 blocklengths(i)=blocklengths(i)*ichunk
1026 call MPI_Type_indexed(2,blocklengths,displs,
1027 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1028 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1034 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1037 blocklengths(i)=blocklengths(i)*ichunk
1039 call MPI_Type_indexed(4,blocklengths,displs,
1040 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1041 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1045 iint_start=ivec_start+1
1048 iint_count(i)=ivec_count(i)
1049 iint_displ(i)=ivec_displ(i)
1050 ivec_displ(i)=ivec_displ(i)-1
1051 iset_displ(i)=iset_displ(i)-1
1052 ithet_displ(i)=ithet_displ(i)-1
1053 iphi_displ(i)=iphi_displ(i)-1
1054 iphi1_displ(i)=iphi1_displ(i)-1
1055 ibond_displ(i)=ibond_displ(i)-1
1057 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1058 & .and. (me.eq.0 .or. .not. out1file)) then
1059 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1061 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1064 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1065 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1066 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1068 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1071 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1072 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1073 & ' SC-p interactions','were distributed among',nfgtasks,
1074 & ' fine-grain processors.'
1090 idihconstr_end=ndih_constr
1091 iphid_start=iphi_start
1092 iphid_end=iphi_end-1
1107 c---------------------------------------------------------------------------
1108 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1110 include "DIMENSIONS"
1111 include "COMMON.INTERACT"
1112 include "COMMON.SETUP"
1113 include "COMMON.IOUNITS"
1114 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1116 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1117 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1118 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1119 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1120 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1121 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1122 & ielend_all(maxres,0:MaxProcs-1)
1123 integer iproc,isent,k,l
1124 c Determines whether to send interaction ii,jj to other processors; a given
1125 c interaction can be sent to at most 2 processors.
1126 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1127 c one processor, otherwise flag is unchanged from the input value.
1133 c write (iout,*) "ii",ii," jj",jj
1134 c Loop over processors to check if anybody could need interaction ii,jj
1135 do iproc=0,fg_rank-1
1136 c Check if the interaction matches any turn3 at iproc
1137 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1139 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1140 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1142 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1145 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1146 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1149 call add_task(iproc,ntask_cont_to,itask_cont_to)
1153 C Check if the interaction matches any turn4 at iproc
1154 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1156 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1157 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1159 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1162 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1163 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1166 call add_task(iproc,ntask_cont_to,itask_cont_to)
1170 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1171 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1172 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1173 & ielend_all(ii-1,iproc).ge.jj-1) then
1175 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1176 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1179 call add_task(iproc,ntask_cont_to,itask_cont_to)
1182 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1183 & ielend_all(ii-1,iproc).ge.jj+1) then
1185 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1186 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1189 call add_task(iproc,ntask_cont_to,itask_cont_to)
1196 c---------------------------------------------------------------------------
1197 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1199 include "DIMENSIONS"
1200 include "COMMON.INTERACT"
1201 include "COMMON.SETUP"
1202 include "COMMON.IOUNITS"
1203 integer ii,jj,itask(2),ntask_cont_from,
1204 & itask_cont_from(0:MaxProcs-1)
1206 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1207 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1208 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1209 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1210 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1211 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1212 & ielend_all(maxres,0:MaxProcs-1)
1214 do iproc=fg_rank+1,nfgtasks-1
1215 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1217 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1218 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1220 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1221 call add_task(iproc,ntask_cont_from,itask_cont_from)
1224 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1226 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1227 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1229 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1230 call add_task(iproc,ntask_cont_from,itask_cont_from)
1233 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1234 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1236 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1237 & jj+1.le.ielend_all(ii+1,iproc)) then
1238 call add_task(iproc,ntask_cont_from,itask_cont_from)
1240 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1241 & jj-1.le.ielend_all(ii+1,iproc)) then
1242 call add_task(iproc,ntask_cont_from,itask_cont_from)
1245 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1247 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1248 & jj-1.le.ielend_all(ii-1,iproc)) then
1249 call add_task(iproc,ntask_cont_from,itask_cont_from)
1251 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1252 & jj+1.le.ielend_all(ii-1,iproc)) then
1253 call add_task(iproc,ntask_cont_from,itask_cont_from)
1260 c---------------------------------------------------------------------------
1261 subroutine add_task(iproc,ntask_cont,itask_cont)
1263 include "DIMENSIONS"
1264 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1267 if (itask_cont(ii).eq.iproc) return
1269 ntask_cont=ntask_cont+1
1270 itask_cont(ntask_cont)=iproc
1273 c---------------------------------------------------------------------------
1274 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1275 implicit real*8 (a-h,o-z)
1276 include 'DIMENSIONS'
1278 include 'COMMON.SETUP'
1279 integer total_ints,lower_bound,upper_bound
1280 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1281 nint=total_ints/nfgtasks
1285 nexcess=total_ints-nint*nfgtasks
1287 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1291 lower_bound=lower_bound+int4proc(i)
1293 upper_bound=lower_bound+int4proc(fg_rank)
1294 lower_bound=lower_bound+1
1297 c---------------------------------------------------------------------------
1298 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1299 implicit real*8 (a-h,o-z)
1300 include 'DIMENSIONS'
1302 include 'COMMON.SETUP'
1303 integer total_ints,lower_bound,upper_bound
1304 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1305 nint=total_ints/nfgtasks1
1309 nexcess=total_ints-nint*nfgtasks1
1311 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1315 lower_bound=lower_bound+int4proc(i)
1317 upper_bound=lower_bound+int4proc(fg_rank1)
1318 lower_bound=lower_bound+1
1321 c---------------------------------------------------------------------------
1322 subroutine int_partition(int_index,lower_index,upper_index,atom,
1323 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1324 implicit real*8 (a-h,o-z)
1325 include 'DIMENSIONS'
1326 include 'COMMON.IOUNITS'
1327 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1328 & first_atom,last_atom,int_gr,jat_start,jat_end
1331 if (lprn) write (iout,*) 'int_index=',int_index
1332 int_index_old=int_index
1333 int_index=int_index+last_atom-first_atom+1
1335 & write (iout,*) 'int_index=',int_index,
1336 & ' int_index_old',int_index_old,
1337 & ' lower_index=',lower_index,
1338 & ' upper_index=',upper_index,
1339 & ' atom=',atom,' first_atom=',first_atom,
1340 & ' last_atom=',last_atom
1341 if (int_index.ge.lower_index) then
1343 if (at_start.eq.0) then
1345 jat_start=first_atom-1+lower_index-int_index_old
1347 jat_start=first_atom
1349 if (lprn) write (iout,*) 'jat_start',jat_start
1350 if (int_index.ge.upper_index) then
1352 jat_end=first_atom-1+upper_index-int_index_old
1357 if (lprn) write (iout,*) 'jat_end',jat_end
1362 c------------------------------------------------------------------------------
1363 subroutine hpb_partition
1364 implicit real*8 (a-h,o-z)
1365 include 'DIMENSIONS'
1369 include 'COMMON.SBRIDGE'
1370 include 'COMMON.IOUNITS'
1371 include 'COMMON.SETUP'
1373 call int_bounds(nhpb,link_start,link_end)
1374 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1375 & ' absolute rank',MyRank,
1376 & ' nhpb',nhpb,' link_start=',link_start,
1377 & ' link_end',link_end