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'/
63 C The following is just to define auxiliary variables used in angle conversion
102 crc for write_rmsbank1
104 cdr include secondary structure prediction bias
107 C CSA I/O units (separated from others especially for Jooyoung)
118 icsa_bank_reminimized=38
121 crc for ifc error 118
124 C Set default weights of the energy terms.
135 print '(a,$)','Inside initialize'
136 c call memmon_print_usage()
169 athet(j,i,k,kk)=0.0D0
170 bthet(j,i,k,kk)=0.0D0
190 gaussc(l,k,j,i)=0.0D0
211 C Initialize the bridge arrays
230 C Initialize variables used in minimization.
239 C Initialize the variables responsible for the mode of gradient storage.
244 C Initialize constants used to split the energy into long- and short-range
250 nprint_ene=nprint_ene-1
254 c-------------------------------------------------------------------------
256 implicit real*8 (a-h,o-z)
258 include 'COMMON.NAMES'
259 include 'COMMON.FFIELD'
261 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
262 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
264 &'C','M','F','I','L','V','W','Y','A','G','T',
265 &'S','Q','N','E','D','H','R','K','P','X'/
266 data potname /'LJ','LJK','BP','GB','GBV'/
268 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
269 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
270 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
271 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
273 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
274 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
275 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
278 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
281 c---------------------------------------------------------------------------
282 subroutine init_int_table
283 implicit real*8 (a-h,o-z)
287 integer blocklengths(15),displs(15)
289 include 'COMMON.CONTROL'
290 include 'COMMON.SETUP'
291 include 'COMMON.CHAIN'
292 include 'COMMON.INTERACT'
293 include 'COMMON.LOCAL'
294 include 'COMMON.SBRIDGE'
295 include 'COMMON.TORCNSTR'
296 include 'COMMON.IOUNITS'
297 include 'COMMON.DERIV'
298 include 'COMMON.CONTACTS'
299 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
300 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
301 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
302 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
303 & ielend_all(maxres,0:max_fg_procs-1),
304 & ntask_cont_from_all(0:max_fg_procs-1),
305 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
306 & ntask_cont_to_all(0:max_fg_procs-1),
307 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
308 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
309 logical scheck,lprint,flag
311 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
312 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
313 C... Determine the numbers of start and end SC-SC interaction
314 C... to deal with by current processor.
316 itask_cont_from(i)=fg_rank
317 itask_cont_to(i)=fg_rank
321 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
322 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
323 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
325 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
326 & ' absolute rank',MyRank,
327 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
328 & ' my_sc_inde',my_sc_inde
348 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
349 cd & (ihpb(i),jhpb(i),i=1,nss)
354 if (ihpb(ii).eq.i+nres) then
361 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
365 c write (iout,*) 'jj=i+1'
366 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
367 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
373 else if (jj.eq.nct) then
375 c write (iout,*) 'jj=nct'
376 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
377 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
385 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
386 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
388 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
389 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
400 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
401 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
406 ind_scint=ind_scint+nct-i
410 ind_scint_old=ind_scint
418 if (iatsc_s.eq.0) iatsc_s=1
420 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
421 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
424 write (iout,'(a)') 'Interaction array:'
426 write (iout,'(i3,2(2x,2i3))')
427 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
432 C Now partition the electrostatic-interaction array
434 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
435 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
437 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
438 & ' absolute rank',MyRank,
439 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
440 & ' my_ele_inde',my_ele_inde
447 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
448 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
451 if (iatel_s.eq.0) iatel_s=1
452 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
453 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
454 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
455 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
456 c & " my_ele_inde_vdw",my_ele_inde_vdw
463 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
465 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
467 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
468 c & " ielend_vdw",ielend_vdw(i)
470 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
481 do i=iatel_s_vdw,iatel_e_vdw
487 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
488 & ' absolute rank',MyRank
489 write (iout,*) 'Electrostatic interaction array:'
491 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
496 C Partition the SC-p interaction array
498 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
499 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
500 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
501 & ' absolute rank',myrank,
502 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
503 & ' my_scp_inde',my_scp_inde
509 if (i.lt.nnt+iscp) then
510 cd write (iout,*) 'i.le.nnt+iscp'
511 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
512 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
514 else if (i.gt.nct-iscp) then
515 cd write (iout,*) 'i.gt.nct-iscp'
516 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
517 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
520 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
521 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
524 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
525 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
534 if (i.lt.nnt+iscp) then
536 iscpstart(i,1)=i+iscp
538 elseif (i.gt.nct-iscp) then
546 iscpstart(i,2)=i+iscp
551 if (iatscp_s.eq.0) iatscp_s=1
553 write (iout,'(a)') 'SC-p interaction array:'
554 do i=iatscp_s,iatscp_e
555 write (iout,'(i3,2(2x,2i3))')
556 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
559 C Partition local interactions
561 call int_bounds(nres-2,loc_start,loc_end)
562 loc_start=loc_start+1
564 call int_bounds(nres-2,ithet_start,ithet_end)
565 ithet_start=ithet_start+2
566 ithet_end=ithet_end+2
567 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
568 iturn3_start=iturn3_start+nnt
569 iphi_start=iturn3_start+2
570 iturn3_end=iturn3_end+nnt
571 iphi_end=iturn3_end+2
572 iturn3_start=iturn3_start-1
573 iturn3_end=iturn3_end-1
574 call int_bounds(nres-3,itau_start,itau_end)
575 itau_start=itau_start+3
577 call int_bounds(nres-3,iphi1_start,iphi1_end)
578 iphi1_start=iphi1_start+3
579 iphi1_end=iphi1_end+3
580 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
581 iturn4_start=iturn4_start+nnt
582 iphid_start=iturn4_start+2
583 iturn4_end=iturn4_end+nnt
584 iphid_end=iturn4_end+2
585 iturn4_start=iturn4_start-1
586 iturn4_end=iturn4_end-1
587 call int_bounds(nres-2,ibond_start,ibond_end)
588 ibond_start=ibond_start+1
589 ibond_end=ibond_end+1
590 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
591 ibondp_start=ibondp_start+nnt
592 ibondp_end=ibondp_end+nnt
593 call int_bounds1(nres-1,ivec_start,ivec_end)
594 print *,"Processor",myrank,fg_rank,fg_rank1,
595 & " ivec_start",ivec_start," ivec_end",ivec_end
596 iset_start=loc_start+2
598 if (ndih_constr.eq.0) then
602 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
604 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
606 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
607 igrad_start=((2*nlen+1)
608 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
609 jgrad_start(igrad_start)=
610 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
612 jgrad_end(igrad_start)=nres
613 igrad_end=((2*nlen+1)
614 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
615 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
616 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
618 do i=igrad_start+1,igrad_end-1
623 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
624 & ' absolute rank',myrank,
625 & ' loc_start',loc_start,' loc_end',loc_end,
626 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
627 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
628 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
629 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
630 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
631 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
632 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
633 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
634 & ' iset_start',iset_start,' iset_end',iset_end,
635 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
637 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
638 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
639 & ' ngrad_end',ngrad_end
640 do i=igrad_start,igrad_end
641 write(*,*) 'Processor:',fg_rank,myrank,i,
642 & jgrad_start(i),jgrad_end(i)
645 if (nfgtasks.gt.1) then
646 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
647 & MPI_INTEGER,FG_COMM1,IERROR)
648 iaux=ivec_end-ivec_start+1
649 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
650 & MPI_INTEGER,FG_COMM1,IERROR)
651 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
652 & MPI_INTEGER,FG_COMM,IERROR)
653 iaux=iset_end-iset_start+1
654 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
655 & MPI_INTEGER,FG_COMM,IERROR)
656 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
657 & MPI_INTEGER,FG_COMM,IERROR)
658 iaux=ibond_end-ibond_start+1
659 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
660 & MPI_INTEGER,FG_COMM,IERROR)
661 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
662 & MPI_INTEGER,FG_COMM,IERROR)
663 iaux=ithet_end-ithet_start+1
664 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
665 & MPI_INTEGER,FG_COMM,IERROR)
666 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
667 & MPI_INTEGER,FG_COMM,IERROR)
668 iaux=iphi_end-iphi_start+1
669 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
670 & MPI_INTEGER,FG_COMM,IERROR)
671 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
672 & MPI_INTEGER,FG_COMM,IERROR)
673 iaux=iphi1_end-iphi1_start+1
674 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
675 & MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
683 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
685 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
687 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
689 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
690 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
691 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
692 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
693 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
694 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
695 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
696 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
697 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
699 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
700 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
701 write (iout,*) "iturn3_start_all",
702 & (iturn3_start_all(i),i=0,nfgtasks-1)
703 write (iout,*) "iturn3_end_all",
704 & (iturn3_end_all(i),i=0,nfgtasks-1)
705 write (iout,*) "iturn4_start_all",
706 & (iturn4_start_all(i),i=0,nfgtasks-1)
707 write (iout,*) "iturn4_end_all",
708 & (iturn4_end_all(i),i=0,nfgtasks-1)
709 write (iout,*) "The ielstart_all array"
711 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
713 write (iout,*) "The ielend_all array"
715 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
721 itask_cont_from(0)=fg_rank
722 itask_cont_to(0)=fg_rank
724 do ii=iturn3_start,iturn3_end
725 call add_int(ii,ii+2,iturn3_sent(1,ii),
726 & ntask_cont_to,itask_cont_to,flag)
728 do ii=iturn4_start,iturn4_end
729 call add_int(ii,ii+3,iturn4_sent(1,ii),
730 & ntask_cont_to,itask_cont_to,flag)
732 do ii=iturn3_start,iturn3_end
733 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
735 do ii=iturn4_start,iturn4_end
736 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
739 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
740 & " ntask_cont_to",ntask_cont_to
741 write (iout,*) "itask_cont_from",
742 & (itask_cont_from(i),i=1,ntask_cont_from)
743 write (iout,*) "itask_cont_to",
744 & (itask_cont_to(i),i=1,ntask_cont_to)
747 c write (iout,*) "Loop forward"
750 c write (iout,*) "from loop i=",i
752 do j=ielstart(i),ielend(i)
753 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
756 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
757 c & " iatel_e",iatel_e
761 c write (iout,*) "i",i," ielstart",ielstart(i),
762 c & " ielend",ielend(i)
765 do j=ielstart(i),ielend(i)
766 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
767 & itask_cont_to,flag)
775 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
776 & " ntask_cont_to",ntask_cont_to
777 write (iout,*) "itask_cont_from",
778 & (itask_cont_from(i),i=1,ntask_cont_from)
779 write (iout,*) "itask_cont_to",
780 & (itask_cont_to(i),i=1,ntask_cont_to)
782 write (iout,*) "iint_sent"
785 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
786 & j=ielstart(ii),ielend(ii))
788 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
789 & " iturn3_end",iturn3_end
790 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
791 & i=iturn3_start,iturn3_end)
792 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
793 & " iturn4_end",iturn4_end
794 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
795 & i=iturn4_start,iturn4_end)
798 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
799 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
800 c write (iout,*) "Gather ntask_cont_from ended"
802 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
803 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
805 c write (iout,*) "Gather itask_cont_from ended"
807 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
808 & 1,MPI_INTEGER,king,FG_COMM,IERR)
809 c write (iout,*) "Gather ntask_cont_to ended"
811 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
812 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
813 c write (iout,*) "Gather itask_cont_to ended"
815 if (fg_rank.eq.king) then
816 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
818 write (iout,'(20i4)') i,ntask_cont_from_all(i),
819 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
823 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
825 write (iout,'(20i4)') i,ntask_cont_to_all(i),
826 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
830 C Check if every send will have a matching receive
834 ncheck_to=ncheck_to+ntask_cont_to_all(i)
835 ncheck_from=ncheck_from+ntask_cont_from_all(i)
837 write (iout,*) "Control sums",ncheck_from,ncheck_to
838 if (ncheck_from.ne.ncheck_to) then
839 write (iout,*) "Error: #receive differs from #send."
840 write (iout,*) "Terminating program...!"
846 do j=1,ntask_cont_to_all(i)
847 ii=itask_cont_to_all(j,i)
848 do k=1,ntask_cont_from_all(ii)
849 if (itask_cont_from_all(k,ii).eq.i) then
850 if(lprint)write(iout,*)"Matching send/receive",i,ii
854 if (k.eq.ntask_cont_from_all(ii)+1) then
856 write (iout,*) "Error: send by",j," to",ii,
857 & " would have no matching receive"
863 write (iout,*) "Unmatched sends; terminating program"
867 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
868 c write (iout,*) "flag broadcast ended flag=",flag
871 call MPI_Finalize(IERROR)
872 stop "Error in INIT_INT_TABLE: unmatched send/receive."
874 call MPI_Comm_group(FG_COMM,fg_group,IERR)
875 c write (iout,*) "MPI_Comm_group ended"
877 call MPI_Group_incl(fg_group,ntask_cont_from+1,
878 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
879 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
880 & CONT_TO_GROUP,IERR)
883 iaux=4*(ielend(ii)-ielstart(ii)+1)
884 call MPI_Group_translate_ranks(fg_group,iaux,
885 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
886 & iint_sent_local(1,ielstart(ii),i),IERR )
887 c write (iout,*) "Ranks translated i=",i
890 iaux=4*(iturn3_end-iturn3_start+1)
891 call MPI_Group_translate_ranks(fg_group,iaux,
892 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
893 & iturn3_sent_local(1,iturn3_start),IERR)
894 iaux=4*(iturn4_end-iturn4_start+1)
895 call MPI_Group_translate_ranks(fg_group,iaux,
896 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
897 & iturn4_sent_local(1,iturn4_start),IERR)
899 write (iout,*) "iint_sent_local"
902 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
903 & j=ielstart(ii),ielend(ii))
906 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
907 & " iturn3_end",iturn3_end
908 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
909 & i=iturn3_start,iturn3_end)
910 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
911 & " iturn4_end",iturn4_end
912 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
913 & i=iturn4_start,iturn4_end)
916 call MPI_Group_free(fg_group,ierr)
917 call MPI_Group_free(cont_from_group,ierr)
918 call MPI_Group_free(cont_to_group,ierr)
919 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
920 call MPI_Type_commit(MPI_UYZ,IERROR)
921 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
923 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
924 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
925 call MPI_Type_commit(MPI_MU,IERROR)
926 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
927 call MPI_Type_commit(MPI_MAT1,IERROR)
928 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
929 call MPI_Type_commit(MPI_MAT2,IERROR)
930 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
931 call MPI_Type_commit(MPI_THET,IERROR)
932 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
933 call MPI_Type_commit(MPI_GAM,IERROR)
935 c 9/22/08 Derived types to send matrices which appear in correlation terms
937 if (ivec_count(i).eq.ivec_count(0)) then
943 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
944 if (ind_typ.eq.0) then
954 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
957 c blocklengths(i)=blocklengths(i)*ichunk
959 c write (iout,*) "blocklengths and displs"
961 c write (iout,*) i,blocklengths(i),displs(i)
964 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
965 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
966 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
967 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
973 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
976 c blocklengths(i)=blocklengths(i)*ichunk
978 c write (iout,*) "blocklengths and displs"
980 c write (iout,*) i,blocklengths(i),displs(i)
983 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
984 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
985 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
986 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
992 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
995 blocklengths(i)=blocklengths(i)*ichunk
997 call MPI_Type_indexed(8,blocklengths,displs,
998 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
999 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1005 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1008 blocklengths(i)=blocklengths(i)*ichunk
1010 call MPI_Type_indexed(8,blocklengths,displs,
1011 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1012 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1018 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1021 blocklengths(i)=blocklengths(i)*ichunk
1023 call MPI_Type_indexed(6,blocklengths,displs,
1024 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1025 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1031 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1034 blocklengths(i)=blocklengths(i)*ichunk
1036 call MPI_Type_indexed(2,blocklengths,displs,
1037 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1038 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1044 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1047 blocklengths(i)=blocklengths(i)*ichunk
1049 call MPI_Type_indexed(4,blocklengths,displs,
1050 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1051 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1055 iint_start=ivec_start+1
1058 iint_count(i)=ivec_count(i)
1059 iint_displ(i)=ivec_displ(i)
1060 ivec_displ(i)=ivec_displ(i)-1
1061 iset_displ(i)=iset_displ(i)-1
1062 ithet_displ(i)=ithet_displ(i)-1
1063 iphi_displ(i)=iphi_displ(i)-1
1064 iphi1_displ(i)=iphi1_displ(i)-1
1065 ibond_displ(i)=ibond_displ(i)-1
1067 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1068 & .and. (me.eq.0 .or. out1file)) then
1069 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1071 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1074 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1075 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1076 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1078 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1081 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1082 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1083 & ' SC-p interactions','were distributed among',nfgtasks,
1084 & ' fine-grain processors.'
1100 idihconstr_end=ndih_constr
1101 iphid_start=iphi_start
1102 iphid_end=iphi_end-1
1119 c---------------------------------------------------------------------------
1120 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1122 include "DIMENSIONS"
1123 include "COMMON.INTERACT"
1124 include "COMMON.SETUP"
1125 include "COMMON.IOUNITS"
1126 integer ii,jj,itask(4),
1127 & ntask_cont_to,itask_cont_to(0:max_fg_procs-1)
1129 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1130 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1131 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1132 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1133 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1134 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1135 & ielend_all(maxres,0:max_fg_procs-1)
1136 integer iproc,isent,k,l
1137 c Determines whether to send interaction ii,jj to other processors; a given
1138 c interaction can be sent to at most 2 processors.
1139 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1140 c one processor, otherwise flag is unchanged from the input value.
1146 c write (iout,*) "ii",ii," jj",jj
1147 c Loop over processors to check if anybody could need interaction ii,jj
1148 do iproc=0,fg_rank-1
1149 c Check if the interaction matches any turn3 at iproc
1150 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1152 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1153 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1155 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1158 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1159 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1162 call add_task(iproc,ntask_cont_to,itask_cont_to)
1166 C Check if the interaction matches any turn4 at iproc
1167 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1169 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1170 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1172 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
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)
1183 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1184 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1185 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1186 & ielend_all(ii-1,iproc).ge.jj-1) then
1188 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1189 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1192 call add_task(iproc,ntask_cont_to,itask_cont_to)
1195 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1196 & ielend_all(ii-1,iproc).ge.jj+1) then
1198 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1199 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1202 call add_task(iproc,ntask_cont_to,itask_cont_to)
1209 c---------------------------------------------------------------------------
1210 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1212 include "DIMENSIONS"
1213 include "COMMON.INTERACT"
1214 include "COMMON.SETUP"
1215 include "COMMON.IOUNITS"
1216 integer ii,jj,itask(2),ntask_cont_from,
1217 & itask_cont_from(0:max_fg_procs-1)
1219 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1220 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1221 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1222 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1223 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1224 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1225 & ielend_all(maxres,0:max_fg_procs-1)
1227 do iproc=fg_rank+1,nfgtasks-1
1228 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1230 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1231 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1233 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1234 call add_task(iproc,ntask_cont_from,itask_cont_from)
1237 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1239 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1240 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1242 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1243 call add_task(iproc,ntask_cont_from,itask_cont_from)
1246 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1247 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1249 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1250 & jj+1.le.ielend_all(ii+1,iproc)) then
1251 call add_task(iproc,ntask_cont_from,itask_cont_from)
1253 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1254 & jj-1.le.ielend_all(ii+1,iproc)) then
1255 call add_task(iproc,ntask_cont_from,itask_cont_from)
1258 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1260 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1261 & jj-1.le.ielend_all(ii-1,iproc)) then
1262 call add_task(iproc,ntask_cont_from,itask_cont_from)
1264 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1265 & jj+1.le.ielend_all(ii-1,iproc)) then
1266 call add_task(iproc,ntask_cont_from,itask_cont_from)
1273 c---------------------------------------------------------------------------
1274 subroutine add_task(iproc,ntask_cont,itask_cont)
1276 include "DIMENSIONS"
1277 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1280 if (itask_cont(ii).eq.iproc) return
1282 ntask_cont=ntask_cont+1
1283 itask_cont(ntask_cont)=iproc
1286 c---------------------------------------------------------------------------
1287 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1288 implicit real*8 (a-h,o-z)
1289 include 'DIMENSIONS'
1291 include 'COMMON.SETUP'
1292 integer total_ints,lower_bound,upper_bound
1293 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1294 nint=total_ints/nfgtasks
1298 nexcess=total_ints-nint*nfgtasks
1300 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1304 lower_bound=lower_bound+int4proc(i)
1306 upper_bound=lower_bound+int4proc(fg_rank)
1307 lower_bound=lower_bound+1
1310 c---------------------------------------------------------------------------
1311 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1312 implicit real*8 (a-h,o-z)
1313 include 'DIMENSIONS'
1315 include 'COMMON.SETUP'
1316 integer total_ints,lower_bound,upper_bound
1317 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1318 nint=total_ints/nfgtasks1
1322 nexcess=total_ints-nint*nfgtasks1
1324 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1328 lower_bound=lower_bound+int4proc(i)
1330 upper_bound=lower_bound+int4proc(fg_rank1)
1331 lower_bound=lower_bound+1
1334 c---------------------------------------------------------------------------
1335 subroutine int_partition(int_index,lower_index,upper_index,atom,
1336 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1337 implicit real*8 (a-h,o-z)
1338 include 'DIMENSIONS'
1339 include 'COMMON.IOUNITS'
1340 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1341 & first_atom,last_atom,int_gr,jat_start,jat_end
1344 if (lprn) write (iout,*) 'int_index=',int_index
1345 int_index_old=int_index
1346 int_index=int_index+last_atom-first_atom+1
1348 & write (iout,*) 'int_index=',int_index,
1349 & ' int_index_old',int_index_old,
1350 & ' lower_index=',lower_index,
1351 & ' upper_index=',upper_index,
1352 & ' atom=',atom,' first_atom=',first_atom,
1353 & ' last_atom=',last_atom
1354 if (int_index.ge.lower_index) then
1356 if (at_start.eq.0) then
1358 jat_start=first_atom-1+lower_index-int_index_old
1360 jat_start=first_atom
1362 if (lprn) write (iout,*) 'jat_start',jat_start
1363 if (int_index.ge.upper_index) then
1365 jat_end=first_atom-1+upper_index-int_index_old
1370 if (lprn) write (iout,*) 'jat_end',jat_end
1375 c------------------------------------------------------------------------------
1376 subroutine hpb_partition
1377 implicit real*8 (a-h,o-z)
1378 include 'DIMENSIONS'
1382 include 'COMMON.SBRIDGE'
1383 include 'COMMON.IOUNITS'
1384 include 'COMMON.SETUP'
1385 include 'COMMON.CONTROL'
1386 c write(2,*)"hpb_partition: nhpb=",nhpb
1388 call int_bounds(nhpb,link_start,link_end)
1390 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1391 & ' absolute rank',MyRank,
1392 & ' nhpb',nhpb,' link_start=',link_start,
1393 & ' link_end',link_end
1398 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end