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()
186 gaussc(l,k,j,i)=0.0D0
207 C Initialize the bridge arrays
226 C Initialize variables used in minimization.
235 C Initialize the variables responsible for the mode of gradient storage.
240 C Initialize constants used to split the energy into long- and short-range
246 nprint_ene=nprint_ene-1
250 c-------------------------------------------------------------------------
252 implicit real*8 (a-h,o-z)
254 include 'COMMON.NAMES'
255 include 'COMMON.FFIELD'
257 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
258 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
260 &'C','M','F','I','L','V','W','Y','A','G','T',
261 &'S','Q','N','E','D','H','R','K','P','X'/
262 data potname /'LJ','LJK','BP','GB','GBV'/
264 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
265 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
266 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
267 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
268 & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
270 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
271 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
272 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
273 & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
275 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
276 & 21,24,25,26,27,0,0,0/
278 c---------------------------------------------------------------------------
279 subroutine init_int_table
280 implicit real*8 (a-h,o-z)
284 integer blocklengths(15),displs(15)
286 include 'COMMON.CONTROL'
287 include 'COMMON.SETUP'
288 include 'COMMON.CHAIN'
289 include 'COMMON.INTERACT'
290 include 'COMMON.LOCAL'
291 include 'COMMON.SBRIDGE'
292 include 'COMMON.TORCNSTR'
293 include 'COMMON.IOUNITS'
294 include 'COMMON.DERIV'
295 include 'COMMON.CONTACTS'
296 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
297 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
298 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
299 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
300 & ielend_all(maxres,0:MaxProcs-1),
301 & ntask_cont_from_all(0:max_fg_procs-1),
302 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
303 & ntask_cont_to_all(0:max_fg_procs-1),
304 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
305 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
306 logical scheck,lprint,flag
308 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
309 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
310 C... Determine the numbers of start and end SC-SC interaction
311 C... to deal with by current processor.
313 itask_cont_from(i)=fg_rank
314 itask_cont_to(i)=fg_rank
318 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
319 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
320 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
322 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
323 & ' absolute rank',MyRank,
324 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
325 & ' my_sc_inde',my_sc_inde
345 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
346 cd & (ihpb(i),jhpb(i),i=1,nss)
350 if (ihpb(ii).eq.i+nres) then
357 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
361 c write (iout,*) 'jj=i+1'
362 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
363 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
369 else if (jj.eq.nct) then
371 c write (iout,*) 'jj=nct'
372 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
373 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
381 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
382 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
384 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
385 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
396 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
397 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
402 ind_scint=ind_scint+nct-i
406 ind_scint_old=ind_scint
415 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
416 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
419 write (iout,'(a)') 'Interaction array:'
421 write (iout,'(i3,2(2x,2i3))')
422 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
427 C Now partition the electrostatic-interaction array
429 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
430 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
432 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
433 & ' absolute rank',MyRank,
434 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
435 & ' my_ele_inde',my_ele_inde
442 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
443 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
446 if (iatel_s.eq.0) iatel_s=1
447 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
448 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
449 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
450 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
451 c & " my_ele_inde_vdw",my_ele_inde_vdw
458 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
460 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
462 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
463 c & " ielend_vdw",ielend_vdw(i)
465 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
476 do i=iatel_s_vdw,iatel_e_vdw
482 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
483 & ' absolute rank',MyRank
484 write (iout,*) 'Electrostatic interaction array:'
486 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
491 C Partition the SC-p interaction array
493 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
494 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
495 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
496 & ' absolute rank',myrank,
497 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
498 & ' my_scp_inde',my_scp_inde
504 if (i.lt.nnt+iscp) then
505 cd write (iout,*) 'i.le.nnt+iscp'
506 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
507 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
509 else if (i.gt.nct-iscp) then
510 cd write (iout,*) 'i.gt.nct-iscp'
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,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
519 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
520 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
529 if (i.lt.nnt+iscp) then
531 iscpstart(i,1)=i+iscp
533 elseif (i.gt.nct-iscp) then
541 iscpstart(i,2)=i+iscp
547 write (iout,'(a)') 'SC-p interaction array:'
548 do i=iatscp_s,iatscp_e
549 write (iout,'(i3,2(2x,2i3))')
550 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
553 C Partition local interactions
555 call int_bounds(nres-2,loc_start,loc_end)
556 loc_start=loc_start+1
558 call int_bounds(nres-2,ithet_start,ithet_end)
559 ithet_start=ithet_start+2
560 ithet_end=ithet_end+2
561 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
562 iturn3_start=iturn3_start+nnt
563 iphi_start=iturn3_start+2
564 iturn3_end=iturn3_end+nnt
565 iphi_end=iturn3_end+2
566 iturn3_start=iturn3_start-1
567 iturn3_end=iturn3_end-1
568 call int_bounds(nres-3,itau_start,itau_end)
569 itau_start=itau_start+3
571 call int_bounds(nres-3,iphi1_start,iphi1_end)
572 iphi1_start=iphi1_start+3
573 iphi1_end=iphi1_end+3
574 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
575 iturn4_start=iturn4_start+nnt
576 iphid_start=iturn4_start+2
577 iturn4_end=iturn4_end+nnt
578 iphid_end=iturn4_end+2
579 iturn4_start=iturn4_start-1
580 iturn4_end=iturn4_end-1
581 call int_bounds(nres-2,ibond_start,ibond_end)
582 ibond_start=ibond_start+1
583 ibond_end=ibond_end+1
584 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
585 ibondp_start=ibondp_start+nnt
586 ibondp_end=ibondp_end+nnt
587 call int_bounds1(nres-1,ivec_start,ivec_end)
588 print *,"Processor",myrank,fg_rank,fg_rank1,
589 & " ivec_start",ivec_start," ivec_end",ivec_end
590 iset_start=loc_start+2
592 if (ndih_constr.eq.0) then
596 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
598 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
600 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
601 igrad_start=((2*nlen+1)
602 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
603 jgrad_start(igrad_start)=
604 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
606 jgrad_end(igrad_start)=nres
607 igrad_end=((2*nlen+1)
608 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
609 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
610 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
612 do i=igrad_start+1,igrad_end-1
617 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
618 & ' absolute rank',myrank,
619 & ' loc_start',loc_start,' loc_end',loc_end,
620 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
621 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
622 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
623 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
624 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
625 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
626 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
627 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
628 & ' iset_start',iset_start,' iset_end',iset_end,
629 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
631 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
632 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
633 & ' ngrad_end',ngrad_end
634 do i=igrad_start,igrad_end
635 write(*,*) 'Processor:',fg_rank,myrank,i,
636 & jgrad_start(i),jgrad_end(i)
639 if (nfgtasks.gt.1) then
640 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
641 & MPI_INTEGER,FG_COMM1,IERROR)
642 iaux=ivec_end-ivec_start+1
643 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
644 & MPI_INTEGER,FG_COMM1,IERROR)
645 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
646 & MPI_INTEGER,FG_COMM,IERROR)
647 iaux=iset_end-iset_start+1
648 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
649 & MPI_INTEGER,FG_COMM,IERROR)
650 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
651 & MPI_INTEGER,FG_COMM,IERROR)
652 iaux=ibond_end-ibond_start+1
653 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
654 & MPI_INTEGER,FG_COMM,IERROR)
655 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
656 & MPI_INTEGER,FG_COMM,IERROR)
657 iaux=ithet_end-ithet_start+1
658 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
659 & MPI_INTEGER,FG_COMM,IERROR)
660 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
661 & MPI_INTEGER,FG_COMM,IERROR)
662 iaux=iphi_end-iphi_start+1
663 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
666 & MPI_INTEGER,FG_COMM,IERROR)
667 iaux=iphi1_end-iphi1_start+1
668 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
669 & MPI_INTEGER,FG_COMM,IERROR)
676 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
677 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
678 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
679 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
680 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
681 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
683 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
685 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
687 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
689 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
690 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
691 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
693 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
694 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
695 write (iout,*) "iturn3_start_all",
696 & (iturn3_start_all(i),i=0,nfgtasks-1)
697 write (iout,*) "iturn3_end_all",
698 & (iturn3_end_all(i),i=0,nfgtasks-1)
699 write (iout,*) "iturn4_start_all",
700 & (iturn4_start_all(i),i=0,nfgtasks-1)
701 write (iout,*) "iturn4_end_all",
702 & (iturn4_end_all(i),i=0,nfgtasks-1)
703 write (iout,*) "The ielstart_all array"
705 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
707 write (iout,*) "The ielend_all array"
709 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
715 itask_cont_from(0)=fg_rank
716 itask_cont_to(0)=fg_rank
718 do ii=iturn3_start,iturn3_end
719 call add_int(ii,ii+2,iturn3_sent(1,ii),
720 & ntask_cont_to,itask_cont_to,flag)
722 do ii=iturn4_start,iturn4_end
723 call add_int(ii,ii+3,iturn4_sent(1,ii),
724 & ntask_cont_to,itask_cont_to,flag)
726 do ii=iturn3_start,iturn3_end
727 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
729 do ii=iturn4_start,iturn4_end
730 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
733 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
734 & " ntask_cont_to",ntask_cont_to
735 write (iout,*) "itask_cont_from",
736 & (itask_cont_from(i),i=1,ntask_cont_from)
737 write (iout,*) "itask_cont_to",
738 & (itask_cont_to(i),i=1,ntask_cont_to)
741 c write (iout,*) "Loop forward"
744 c write (iout,*) "from loop i=",i
746 do j=ielstart(i),ielend(i)
747 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
750 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
751 c & " iatel_e",iatel_e
755 c write (iout,*) "i",i," ielstart",ielstart(i),
756 c & " ielend",ielend(i)
759 do j=ielstart(i),ielend(i)
760 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
761 & itask_cont_to,flag)
769 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
770 & " ntask_cont_to",ntask_cont_to
771 write (iout,*) "itask_cont_from",
772 & (itask_cont_from(i),i=1,ntask_cont_from)
773 write (iout,*) "itask_cont_to",
774 & (itask_cont_to(i),i=1,ntask_cont_to)
776 write (iout,*) "iint_sent"
779 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
780 & j=ielstart(ii),ielend(ii))
782 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
783 & " iturn3_end",iturn3_end
784 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
785 & i=iturn3_start,iturn3_end)
786 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
787 & " iturn4_end",iturn4_end
788 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
789 & i=iturn4_start,iturn4_end)
792 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
793 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
794 c write (iout,*) "Gather ntask_cont_from ended"
796 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
797 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
799 c write (iout,*) "Gather itask_cont_from ended"
801 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
802 & 1,MPI_INTEGER,king,FG_COMM,IERR)
803 c write (iout,*) "Gather ntask_cont_to ended"
805 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
806 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
807 c write (iout,*) "Gather itask_cont_to ended"
809 if (fg_rank.eq.king) then
810 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
812 write (iout,'(20i4)') i,ntask_cont_from_all(i),
813 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
817 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
819 write (iout,'(20i4)') i,ntask_cont_to_all(i),
820 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
824 C Check if every send will have a matching receive
828 ncheck_to=ncheck_to+ntask_cont_to_all(i)
829 ncheck_from=ncheck_from+ntask_cont_from_all(i)
831 write (iout,*) "Control sums",ncheck_from,ncheck_to
832 if (ncheck_from.ne.ncheck_to) then
833 write (iout,*) "Error: #receive differs from #send."
834 write (iout,*) "Terminating program...!"
840 do j=1,ntask_cont_to_all(i)
841 ii=itask_cont_to_all(j,i)
842 do k=1,ntask_cont_from_all(ii)
843 if (itask_cont_from_all(k,ii).eq.i) then
844 if(lprint)write(iout,*)"Matching send/receive",i,ii
848 if (k.eq.ntask_cont_from_all(ii)+1) then
850 write (iout,*) "Error: send by",j," to",ii,
851 & " would have no matching receive"
857 write (iout,*) "Unmatched sends; terminating program"
861 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
862 c write (iout,*) "flag broadcast ended flag=",flag
865 call MPI_Finalize(IERROR)
866 stop "Error in INIT_INT_TABLE: unmatched send/receive."
868 call MPI_Comm_group(FG_COMM,fg_group,IERR)
869 c write (iout,*) "MPI_Comm_group ended"
871 call MPI_Group_incl(fg_group,ntask_cont_from+1,
872 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
873 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
874 & CONT_TO_GROUP,IERR)
877 iaux=4*(ielend(ii)-ielstart(ii)+1)
878 call MPI_Group_translate_ranks(fg_group,iaux,
879 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
880 & iint_sent_local(1,ielstart(ii),i),IERR )
881 c write (iout,*) "Ranks translated i=",i
884 iaux=4*(iturn3_end-iturn3_start+1)
885 call MPI_Group_translate_ranks(fg_group,iaux,
886 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
887 & iturn3_sent_local(1,iturn3_start),IERR)
888 iaux=4*(iturn4_end-iturn4_start+1)
889 call MPI_Group_translate_ranks(fg_group,iaux,
890 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
891 & iturn4_sent_local(1,iturn4_start),IERR)
893 write (iout,*) "iint_sent_local"
896 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
897 & j=ielstart(ii),ielend(ii))
900 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
901 & " iturn3_end",iturn3_end
902 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
903 & i=iturn3_start,iturn3_end)
904 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
905 & " iturn4_end",iturn4_end
906 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
907 & i=iturn4_start,iturn4_end)
910 call MPI_Group_free(fg_group,ierr)
911 call MPI_Group_free(cont_from_group,ierr)
912 call MPI_Group_free(cont_to_group,ierr)
913 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
914 call MPI_Type_commit(MPI_UYZ,IERROR)
915 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
917 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
918 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
919 call MPI_Type_commit(MPI_MU,IERROR)
920 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
921 call MPI_Type_commit(MPI_MAT1,IERROR)
922 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
923 call MPI_Type_commit(MPI_MAT2,IERROR)
924 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
925 call MPI_Type_commit(MPI_THET,IERROR)
926 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
927 call MPI_Type_commit(MPI_GAM,IERROR)
929 c 9/22/08 Derived types to send matrices which appear in correlation terms
931 if (ivec_count(i).eq.ivec_count(0)) then
937 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
938 if (ind_typ.eq.0) then
948 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
951 c blocklengths(i)=blocklengths(i)*ichunk
953 c write (iout,*) "blocklengths and displs"
955 c write (iout,*) i,blocklengths(i),displs(i)
958 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
959 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
960 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
961 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
967 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
970 c blocklengths(i)=blocklengths(i)*ichunk
972 c write (iout,*) "blocklengths and displs"
974 c write (iout,*) i,blocklengths(i),displs(i)
977 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
978 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
979 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
980 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
986 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
989 blocklengths(i)=blocklengths(i)*ichunk
991 call MPI_Type_indexed(8,blocklengths,displs,
992 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
993 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
999 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1002 blocklengths(i)=blocklengths(i)*ichunk
1004 call MPI_Type_indexed(8,blocklengths,displs,
1005 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1006 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1012 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1015 blocklengths(i)=blocklengths(i)*ichunk
1017 call MPI_Type_indexed(6,blocklengths,displs,
1018 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1019 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1025 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1028 blocklengths(i)=blocklengths(i)*ichunk
1030 call MPI_Type_indexed(2,blocklengths,displs,
1031 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1032 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1038 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1041 blocklengths(i)=blocklengths(i)*ichunk
1043 call MPI_Type_indexed(4,blocklengths,displs,
1044 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1045 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1049 iint_start=ivec_start+1
1052 iint_count(i)=ivec_count(i)
1053 iint_displ(i)=ivec_displ(i)
1054 ivec_displ(i)=ivec_displ(i)-1
1055 iset_displ(i)=iset_displ(i)-1
1056 ithet_displ(i)=ithet_displ(i)-1
1057 iphi_displ(i)=iphi_displ(i)-1
1058 iphi1_displ(i)=iphi1_displ(i)-1
1059 ibond_displ(i)=ibond_displ(i)-1
1061 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1062 & .and. (me.eq.0 .or. out1file)) then
1063 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1065 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1068 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1069 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1070 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1072 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1075 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1076 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1077 & ' SC-p interactions','were distributed among',nfgtasks,
1078 & ' fine-grain processors.'
1094 idihconstr_end=ndih_constr
1095 iphid_start=iphi_start
1096 iphid_end=iphi_end-1
1113 c---------------------------------------------------------------------------
1114 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1116 include "DIMENSIONS"
1117 include "COMMON.INTERACT"
1118 include "COMMON.SETUP"
1119 include "COMMON.IOUNITS"
1120 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1122 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1123 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1124 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1125 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1126 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1127 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1128 & ielend_all(maxres,0:MaxProcs-1)
1129 integer iproc,isent,k,l
1130 c Determines whether to send interaction ii,jj to other processors; a given
1131 c interaction can be sent to at most 2 processors.
1132 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1133 c one processor, otherwise flag is unchanged from the input value.
1139 c write (iout,*) "ii",ii," jj",jj
1140 c Loop over processors to check if anybody could need interaction ii,jj
1141 do iproc=0,fg_rank-1
1142 c Check if the interaction matches any turn3 at iproc
1143 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1145 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1146 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1148 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1151 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1152 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1155 call add_task(iproc,ntask_cont_to,itask_cont_to)
1159 C Check if the interaction matches any turn4 at iproc
1160 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1162 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1163 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1165 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1168 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1169 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1172 call add_task(iproc,ntask_cont_to,itask_cont_to)
1176 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1177 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1178 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1179 & ielend_all(ii-1,iproc).ge.jj-1) then
1181 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1182 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1185 call add_task(iproc,ntask_cont_to,itask_cont_to)
1188 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1189 & ielend_all(ii-1,iproc).ge.jj+1) then
1191 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1192 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1195 call add_task(iproc,ntask_cont_to,itask_cont_to)
1202 c---------------------------------------------------------------------------
1203 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1205 include "DIMENSIONS"
1206 include "COMMON.INTERACT"
1207 include "COMMON.SETUP"
1208 include "COMMON.IOUNITS"
1209 integer ii,jj,itask(2),ntask_cont_from,
1210 & itask_cont_from(0:MaxProcs-1)
1212 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1213 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1214 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1215 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1216 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1217 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1218 & ielend_all(maxres,0:MaxProcs-1)
1220 do iproc=fg_rank+1,nfgtasks-1
1221 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1223 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1224 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1226 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1227 call add_task(iproc,ntask_cont_from,itask_cont_from)
1230 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1232 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1233 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1235 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1236 call add_task(iproc,ntask_cont_from,itask_cont_from)
1239 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1240 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1242 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1243 & jj+1.le.ielend_all(ii+1,iproc)) then
1244 call add_task(iproc,ntask_cont_from,itask_cont_from)
1246 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1247 & jj-1.le.ielend_all(ii+1,iproc)) then
1248 call add_task(iproc,ntask_cont_from,itask_cont_from)
1251 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
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)
1257 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1258 & jj+1.le.ielend_all(ii-1,iproc)) then
1259 call add_task(iproc,ntask_cont_from,itask_cont_from)
1266 c---------------------------------------------------------------------------
1267 subroutine add_task(iproc,ntask_cont,itask_cont)
1269 include "DIMENSIONS"
1270 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1273 if (itask_cont(ii).eq.iproc) return
1275 ntask_cont=ntask_cont+1
1276 itask_cont(ntask_cont)=iproc
1279 c---------------------------------------------------------------------------
1280 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1281 implicit real*8 (a-h,o-z)
1282 include 'DIMENSIONS'
1284 include 'COMMON.SETUP'
1285 integer total_ints,lower_bound,upper_bound
1286 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1287 nint=total_ints/nfgtasks
1291 nexcess=total_ints-nint*nfgtasks
1293 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1297 lower_bound=lower_bound+int4proc(i)
1299 upper_bound=lower_bound+int4proc(fg_rank)
1300 lower_bound=lower_bound+1
1303 c---------------------------------------------------------------------------
1304 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1305 implicit real*8 (a-h,o-z)
1306 include 'DIMENSIONS'
1308 include 'COMMON.SETUP'
1309 integer total_ints,lower_bound,upper_bound
1310 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1311 nint=total_ints/nfgtasks1
1315 nexcess=total_ints-nint*nfgtasks1
1317 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1321 lower_bound=lower_bound+int4proc(i)
1323 upper_bound=lower_bound+int4proc(fg_rank1)
1324 lower_bound=lower_bound+1
1327 c---------------------------------------------------------------------------
1328 subroutine int_partition(int_index,lower_index,upper_index,atom,
1329 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1330 implicit real*8 (a-h,o-z)
1331 include 'DIMENSIONS'
1332 include 'COMMON.IOUNITS'
1333 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1334 & first_atom,last_atom,int_gr,jat_start,jat_end
1337 if (lprn) write (iout,*) 'int_index=',int_index
1338 int_index_old=int_index
1339 int_index=int_index+last_atom-first_atom+1
1341 & write (iout,*) 'int_index=',int_index,
1342 & ' int_index_old',int_index_old,
1343 & ' lower_index=',lower_index,
1344 & ' upper_index=',upper_index,
1345 & ' atom=',atom,' first_atom=',first_atom,
1346 & ' last_atom=',last_atom
1347 if (int_index.ge.lower_index) then
1349 if (at_start.eq.0) then
1351 jat_start=first_atom-1+lower_index-int_index_old
1353 jat_start=first_atom
1355 if (lprn) write (iout,*) 'jat_start',jat_start
1356 if (int_index.ge.upper_index) then
1358 jat_end=first_atom-1+upper_index-int_index_old
1363 if (lprn) write (iout,*) 'jat_end',jat_end
1368 c------------------------------------------------------------------------------
1369 subroutine hpb_partition
1370 implicit real*8 (a-h,o-z)
1371 include 'DIMENSIONS'
1375 include 'COMMON.SBRIDGE'
1376 include 'COMMON.IOUNITS'
1377 include 'COMMON.SETUP'
1378 include 'COMMON.CONTROL'
1379 c write(2,*)"hpb_partition: nhpb=",nhpb
1381 call int_bounds(nhpb,link_start,link_end)
1383 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1384 & ' absolute rank',MyRank,
1385 & ' nhpb',nhpb,' link_start=',link_start,
1386 & ' link_end',link_end
1391 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end