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
199 v1(k,j,i,iblock)=0.0D0
200 v2(k,j,i,iblock)=0.0D0
209 C Initialize the bridge arrays
228 C Initialize variables used in minimization.
237 C Initialize the variables responsible for the mode of gradient storage.
242 C Initialize constants used to split the energy into long- and short-range
248 nprint_ene=nprint_ene-1
252 c-------------------------------------------------------------------------
254 implicit real*8 (a-h,o-z)
256 include 'COMMON.NAMES'
257 include 'COMMON.FFIELD'
259 &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
260 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
261 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
262 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
264 &'z','p','k','r','h','d','e','n','q','s','t','g',
265 &'a','y','w','v','l','i','f','m','c','x',
266 &'C','M','F','I','L','V','W','Y','A','G','T',
267 &'S','Q','N','E','D','H','R','K','P','X'/
268 data potname /'LJ','LJK','BP','GB','GBV'/
270 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
271 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
272 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
273 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
275 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
276 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
277 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
280 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
283 c---------------------------------------------------------------------------
284 subroutine init_int_table
285 implicit real*8 (a-h,o-z)
289 integer blocklengths(15),displs(15)
291 include 'COMMON.CONTROL'
292 include 'COMMON.SETUP'
293 include 'COMMON.CHAIN'
294 include 'COMMON.INTERACT'
295 include 'COMMON.LOCAL'
296 include 'COMMON.SBRIDGE'
297 include 'COMMON.TORCNSTR'
298 include 'COMMON.IOUNITS'
299 include 'COMMON.DERIV'
300 include 'COMMON.CONTACTS'
301 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
302 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
303 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
304 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
305 & ielend_all(maxres,0:MaxProcs-1),
306 & ntask_cont_from_all(0:max_fg_procs-1),
307 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
308 & ntask_cont_to_all(0:max_fg_procs-1),
309 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
310 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
311 logical scheck,lprint,flag
313 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
314 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
315 C... Determine the numbers of start and end SC-SC interaction
316 C... to deal with by current processor.
318 itask_cont_from(i)=fg_rank
319 itask_cont_to(i)=fg_rank
323 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
324 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
325 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
327 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
328 & ' absolute rank',MyRank,
329 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
330 & ' my_sc_inde',my_sc_inde
350 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
351 cd & (ihpb(i),jhpb(i),i=1,nss)
355 if (ihpb(ii).eq.i+nres) then
362 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
366 c write (iout,*) 'jj=i+1'
367 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
368 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
374 else if (jj.eq.nct) then
376 c write (iout,*) 'jj=nct'
377 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
378 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
386 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
387 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
389 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
390 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
401 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
402 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
407 ind_scint=ind_scint+nct-i
411 ind_scint_old=ind_scint
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
552 write (iout,'(a)') 'SC-p interaction array:'
553 do i=iatscp_s,iatscp_e
554 write (iout,'(i3,2(2x,2i3))')
555 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
558 C Partition local interactions
560 call int_bounds(nres-2,loc_start,loc_end)
561 loc_start=loc_start+1
563 call int_bounds(nres-2,ithet_start,ithet_end)
564 ithet_start=ithet_start+2
565 ithet_end=ithet_end+2
566 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
567 iturn3_start=iturn3_start+nnt
568 iphi_start=iturn3_start+2
569 iturn3_end=iturn3_end+nnt
570 iphi_end=iturn3_end+2
571 iturn3_start=iturn3_start-1
572 iturn3_end=iturn3_end-1
573 call int_bounds(nres-3,itau_start,itau_end)
574 itau_start=itau_start+3
576 call int_bounds(nres-3,iphi1_start,iphi1_end)
577 iphi1_start=iphi1_start+3
578 iphi1_end=iphi1_end+3
579 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
580 iturn4_start=iturn4_start+nnt
581 iphid_start=iturn4_start+2
582 iturn4_end=iturn4_end+nnt
583 iphid_end=iturn4_end+2
584 iturn4_start=iturn4_start-1
585 iturn4_end=iturn4_end-1
586 call int_bounds(nres-2,ibond_start,ibond_end)
587 ibond_start=ibond_start+1
588 ibond_end=ibond_end+1
589 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
590 ibondp_start=ibondp_start+nnt
591 ibondp_end=ibondp_end+nnt
592 call int_bounds1(nres-1,ivec_start,ivec_end)
593 print *,"Processor",myrank,fg_rank,fg_rank1,
594 & " ivec_start",ivec_start," ivec_end",ivec_end
595 iset_start=loc_start+2
597 if (ndih_constr.eq.0) then
601 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
603 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
605 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
606 igrad_start=((2*nlen+1)
607 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
608 jgrad_start(igrad_start)=
609 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
611 jgrad_end(igrad_start)=nres
612 igrad_end=((2*nlen+1)
613 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
614 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
615 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
617 do i=igrad_start+1,igrad_end-1
622 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
623 & ' absolute rank',myrank,
624 & ' loc_start',loc_start,' loc_end',loc_end,
625 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
626 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
627 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
628 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
629 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
630 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
631 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
632 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
633 & ' iset_start',iset_start,' iset_end',iset_end,
634 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
636 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
637 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
638 & ' ngrad_end',ngrad_end
639 do i=igrad_start,igrad_end
640 write(*,*) 'Processor:',fg_rank,myrank,i,
641 & jgrad_start(i),jgrad_end(i)
644 if (nfgtasks.gt.1) then
645 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
646 & MPI_INTEGER,FG_COMM1,IERROR)
647 iaux=ivec_end-ivec_start+1
648 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
649 & MPI_INTEGER,FG_COMM1,IERROR)
650 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
651 & MPI_INTEGER,FG_COMM,IERROR)
652 iaux=iset_end-iset_start+1
653 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
654 & MPI_INTEGER,FG_COMM,IERROR)
655 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
656 & MPI_INTEGER,FG_COMM,IERROR)
657 iaux=ibond_end-ibond_start+1
658 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
659 & MPI_INTEGER,FG_COMM,IERROR)
660 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
661 & MPI_INTEGER,FG_COMM,IERROR)
662 iaux=ithet_end-ithet_start+1
663 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
666 & MPI_INTEGER,FG_COMM,IERROR)
667 iaux=iphi_end-iphi_start+1
668 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
669 & MPI_INTEGER,FG_COMM,IERROR)
670 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
671 & MPI_INTEGER,FG_COMM,IERROR)
672 iaux=iphi1_end-iphi1_start+1
673 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
674 & MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
682 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
684 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
686 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
688 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
689 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
690 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
692 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
693 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
694 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
695 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
696 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
698 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
699 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
700 write (iout,*) "iturn3_start_all",
701 & (iturn3_start_all(i),i=0,nfgtasks-1)
702 write (iout,*) "iturn3_end_all",
703 & (iturn3_end_all(i),i=0,nfgtasks-1)
704 write (iout,*) "iturn4_start_all",
705 & (iturn4_start_all(i),i=0,nfgtasks-1)
706 write (iout,*) "iturn4_end_all",
707 & (iturn4_end_all(i),i=0,nfgtasks-1)
708 write (iout,*) "The ielstart_all array"
710 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
712 write (iout,*) "The ielend_all array"
714 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
720 itask_cont_from(0)=fg_rank
721 itask_cont_to(0)=fg_rank
723 do ii=iturn3_start,iturn3_end
724 call add_int(ii,ii+2,iturn3_sent(1,ii),
725 & ntask_cont_to,itask_cont_to,flag)
727 do ii=iturn4_start,iturn4_end
728 call add_int(ii,ii+3,iturn4_sent(1,ii),
729 & ntask_cont_to,itask_cont_to,flag)
731 do ii=iturn3_start,iturn3_end
732 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
734 do ii=iturn4_start,iturn4_end
735 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
738 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
739 & " ntask_cont_to",ntask_cont_to
740 write (iout,*) "itask_cont_from",
741 & (itask_cont_from(i),i=1,ntask_cont_from)
742 write (iout,*) "itask_cont_to",
743 & (itask_cont_to(i),i=1,ntask_cont_to)
746 c write (iout,*) "Loop forward"
749 c write (iout,*) "from loop i=",i
751 do j=ielstart(i),ielend(i)
752 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
755 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
756 c & " iatel_e",iatel_e
760 c write (iout,*) "i",i," ielstart",ielstart(i),
761 c & " ielend",ielend(i)
764 do j=ielstart(i),ielend(i)
765 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
766 & itask_cont_to,flag)
774 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
775 & " ntask_cont_to",ntask_cont_to
776 write (iout,*) "itask_cont_from",
777 & (itask_cont_from(i),i=1,ntask_cont_from)
778 write (iout,*) "itask_cont_to",
779 & (itask_cont_to(i),i=1,ntask_cont_to)
781 write (iout,*) "iint_sent"
784 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
785 & j=ielstart(ii),ielend(ii))
787 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
788 & " iturn3_end",iturn3_end
789 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
790 & i=iturn3_start,iturn3_end)
791 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
792 & " iturn4_end",iturn4_end
793 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
794 & i=iturn4_start,iturn4_end)
797 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
798 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
799 c write (iout,*) "Gather ntask_cont_from ended"
801 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
802 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
804 c write (iout,*) "Gather itask_cont_from ended"
806 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
807 & 1,MPI_INTEGER,king,FG_COMM,IERR)
808 c write (iout,*) "Gather ntask_cont_to ended"
810 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
811 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
812 c write (iout,*) "Gather itask_cont_to ended"
814 if (fg_rank.eq.king) then
815 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
817 write (iout,'(20i4)') i,ntask_cont_from_all(i),
818 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
822 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
824 write (iout,'(20i4)') i,ntask_cont_to_all(i),
825 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
829 C Check if every send will have a matching receive
833 ncheck_to=ncheck_to+ntask_cont_to_all(i)
834 ncheck_from=ncheck_from+ntask_cont_from_all(i)
836 write (iout,*) "Control sums",ncheck_from,ncheck_to
837 if (ncheck_from.ne.ncheck_to) then
838 write (iout,*) "Error: #receive differs from #send."
839 write (iout,*) "Terminating program...!"
845 do j=1,ntask_cont_to_all(i)
846 ii=itask_cont_to_all(j,i)
847 do k=1,ntask_cont_from_all(ii)
848 if (itask_cont_from_all(k,ii).eq.i) then
849 if(lprint)write(iout,*)"Matching send/receive",i,ii
853 if (k.eq.ntask_cont_from_all(ii)+1) then
855 write (iout,*) "Error: send by",j," to",ii,
856 & " would have no matching receive"
862 write (iout,*) "Unmatched sends; terminating program"
866 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
867 c write (iout,*) "flag broadcast ended flag=",flag
870 call MPI_Finalize(IERROR)
871 stop "Error in INIT_INT_TABLE: unmatched send/receive."
873 call MPI_Comm_group(FG_COMM,fg_group,IERR)
874 c write (iout,*) "MPI_Comm_group ended"
876 call MPI_Group_incl(fg_group,ntask_cont_from+1,
877 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
878 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
879 & CONT_TO_GROUP,IERR)
882 iaux=4*(ielend(ii)-ielstart(ii)+1)
883 call MPI_Group_translate_ranks(fg_group,iaux,
884 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
885 & iint_sent_local(1,ielstart(ii),i),IERR )
886 c write (iout,*) "Ranks translated i=",i
889 iaux=4*(iturn3_end-iturn3_start+1)
890 call MPI_Group_translate_ranks(fg_group,iaux,
891 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
892 & iturn3_sent_local(1,iturn3_start),IERR)
893 iaux=4*(iturn4_end-iturn4_start+1)
894 call MPI_Group_translate_ranks(fg_group,iaux,
895 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
896 & iturn4_sent_local(1,iturn4_start),IERR)
898 write (iout,*) "iint_sent_local"
901 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
902 & j=ielstart(ii),ielend(ii))
905 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
906 & " iturn3_end",iturn3_end
907 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
908 & i=iturn3_start,iturn3_end)
909 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
910 & " iturn4_end",iturn4_end
911 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
912 & i=iturn4_start,iturn4_end)
915 call MPI_Group_free(fg_group,ierr)
916 call MPI_Group_free(cont_from_group,ierr)
917 call MPI_Group_free(cont_to_group,ierr)
918 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
919 call MPI_Type_commit(MPI_UYZ,IERROR)
920 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
922 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
923 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
924 call MPI_Type_commit(MPI_MU,IERROR)
925 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
926 call MPI_Type_commit(MPI_MAT1,IERROR)
927 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
928 call MPI_Type_commit(MPI_MAT2,IERROR)
929 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
930 call MPI_Type_commit(MPI_THET,IERROR)
931 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
932 call MPI_Type_commit(MPI_GAM,IERROR)
934 c 9/22/08 Derived types to send matrices which appear in correlation terms
936 if (ivec_count(i).eq.ivec_count(0)) then
942 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
943 if (ind_typ.eq.0) then
953 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
956 c blocklengths(i)=blocklengths(i)*ichunk
958 c write (iout,*) "blocklengths and displs"
960 c write (iout,*) i,blocklengths(i),displs(i)
963 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
964 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
965 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
966 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
972 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
975 c blocklengths(i)=blocklengths(i)*ichunk
977 c write (iout,*) "blocklengths and displs"
979 c write (iout,*) i,blocklengths(i),displs(i)
982 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
983 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
984 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
985 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
991 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
994 blocklengths(i)=blocklengths(i)*ichunk
996 call MPI_Type_indexed(8,blocklengths,displs,
997 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
998 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1004 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1007 blocklengths(i)=blocklengths(i)*ichunk
1009 call MPI_Type_indexed(8,blocklengths,displs,
1010 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1011 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1017 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1020 blocklengths(i)=blocklengths(i)*ichunk
1022 call MPI_Type_indexed(6,blocklengths,displs,
1023 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1024 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1030 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1033 blocklengths(i)=blocklengths(i)*ichunk
1035 call MPI_Type_indexed(2,blocklengths,displs,
1036 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1037 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1043 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1046 blocklengths(i)=blocklengths(i)*ichunk
1048 call MPI_Type_indexed(4,blocklengths,displs,
1049 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1050 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1054 iint_start=ivec_start+1
1057 iint_count(i)=ivec_count(i)
1058 iint_displ(i)=ivec_displ(i)
1059 ivec_displ(i)=ivec_displ(i)-1
1060 iset_displ(i)=iset_displ(i)-1
1061 ithet_displ(i)=ithet_displ(i)-1
1062 iphi_displ(i)=iphi_displ(i)-1
1063 iphi1_displ(i)=iphi1_displ(i)-1
1064 ibond_displ(i)=ibond_displ(i)-1
1066 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1067 & .and. (me.eq.0 .or. out1file)) then
1068 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1070 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1073 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1074 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1075 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1077 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1080 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1081 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1082 & ' SC-p interactions','were distributed among',nfgtasks,
1083 & ' fine-grain processors.'
1099 idihconstr_end=ndih_constr
1100 iphid_start=iphi_start
1101 iphid_end=iphi_end-1
1118 c---------------------------------------------------------------------------
1119 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1121 include "DIMENSIONS"
1122 include "COMMON.INTERACT"
1123 include "COMMON.SETUP"
1124 include "COMMON.IOUNITS"
1125 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1127 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1128 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1129 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1130 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1131 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1132 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1133 & ielend_all(maxres,0:MaxProcs-1)
1134 integer iproc,isent,k,l
1135 c Determines whether to send interaction ii,jj to other processors; a given
1136 c interaction can be sent to at most 2 processors.
1137 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1138 c one processor, otherwise flag is unchanged from the input value.
1144 c write (iout,*) "ii",ii," jj",jj
1145 c Loop over processors to check if anybody could need interaction ii,jj
1146 do iproc=0,fg_rank-1
1147 c Check if the interaction matches any turn3 at iproc
1148 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1150 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1151 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1153 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1156 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1157 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1160 call add_task(iproc,ntask_cont_to,itask_cont_to)
1164 C Check if the interaction matches any turn4 at iproc
1165 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1167 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1168 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1170 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1173 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1174 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1177 call add_task(iproc,ntask_cont_to,itask_cont_to)
1181 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1182 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1183 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1184 & ielend_all(ii-1,iproc).ge.jj-1) then
1186 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1187 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1190 call add_task(iproc,ntask_cont_to,itask_cont_to)
1193 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1194 & ielend_all(ii-1,iproc).ge.jj+1) then
1196 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1197 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1200 call add_task(iproc,ntask_cont_to,itask_cont_to)
1207 c---------------------------------------------------------------------------
1208 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1210 include "DIMENSIONS"
1211 include "COMMON.INTERACT"
1212 include "COMMON.SETUP"
1213 include "COMMON.IOUNITS"
1214 integer ii,jj,itask(2),ntask_cont_from,
1215 & itask_cont_from(0:MaxProcs-1)
1217 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1218 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1219 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1220 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1221 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1222 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1223 & ielend_all(maxres,0:MaxProcs-1)
1225 do iproc=fg_rank+1,nfgtasks-1
1226 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1228 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1229 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1231 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1232 call add_task(iproc,ntask_cont_from,itask_cont_from)
1235 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1237 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1238 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1240 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1241 call add_task(iproc,ntask_cont_from,itask_cont_from)
1244 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
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)
1256 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1258 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1259 & jj-1.le.ielend_all(ii-1,iproc)) then
1260 call add_task(iproc,ntask_cont_from,itask_cont_from)
1262 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1263 & jj+1.le.ielend_all(ii-1,iproc)) then
1264 call add_task(iproc,ntask_cont_from,itask_cont_from)
1271 c---------------------------------------------------------------------------
1272 subroutine add_task(iproc,ntask_cont,itask_cont)
1274 include "DIMENSIONS"
1275 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1278 if (itask_cont(ii).eq.iproc) return
1280 ntask_cont=ntask_cont+1
1281 itask_cont(ntask_cont)=iproc
1284 c---------------------------------------------------------------------------
1285 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1286 implicit real*8 (a-h,o-z)
1287 include 'DIMENSIONS'
1289 include 'COMMON.SETUP'
1290 integer total_ints,lower_bound,upper_bound
1291 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1292 nint=total_ints/nfgtasks
1296 nexcess=total_ints-nint*nfgtasks
1298 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1302 lower_bound=lower_bound+int4proc(i)
1304 upper_bound=lower_bound+int4proc(fg_rank)
1305 lower_bound=lower_bound+1
1308 c---------------------------------------------------------------------------
1309 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1310 implicit real*8 (a-h,o-z)
1311 include 'DIMENSIONS'
1313 include 'COMMON.SETUP'
1314 integer total_ints,lower_bound,upper_bound
1315 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1316 nint=total_ints/nfgtasks1
1320 nexcess=total_ints-nint*nfgtasks1
1322 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1326 lower_bound=lower_bound+int4proc(i)
1328 upper_bound=lower_bound+int4proc(fg_rank1)
1329 lower_bound=lower_bound+1
1332 c---------------------------------------------------------------------------
1333 subroutine int_partition(int_index,lower_index,upper_index,atom,
1334 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1335 implicit real*8 (a-h,o-z)
1336 include 'DIMENSIONS'
1337 include 'COMMON.IOUNITS'
1338 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1339 & first_atom,last_atom,int_gr,jat_start,jat_end
1342 if (lprn) write (iout,*) 'int_index=',int_index
1343 int_index_old=int_index
1344 int_index=int_index+last_atom-first_atom+1
1346 & write (iout,*) 'int_index=',int_index,
1347 & ' int_index_old',int_index_old,
1348 & ' lower_index=',lower_index,
1349 & ' upper_index=',upper_index,
1350 & ' atom=',atom,' first_atom=',first_atom,
1351 & ' last_atom=',last_atom
1352 if (int_index.ge.lower_index) then
1354 if (at_start.eq.0) then
1356 jat_start=first_atom-1+lower_index-int_index_old
1358 jat_start=first_atom
1360 if (lprn) write (iout,*) 'jat_start',jat_start
1361 if (int_index.ge.upper_index) then
1363 jat_end=first_atom-1+upper_index-int_index_old
1368 if (lprn) write (iout,*) 'jat_end',jat_end
1373 c------------------------------------------------------------------------------
1374 subroutine hpb_partition
1375 implicit real*8 (a-h,o-z)
1376 include 'DIMENSIONS'
1380 include 'COMMON.SBRIDGE'
1381 include 'COMMON.IOUNITS'
1382 include 'COMMON.SETUP'
1383 include 'COMMON.CONTROL'
1385 call int_bounds(nhpb,link_start,link_end)
1387 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1388 & ' absolute rank',MyRank,
1389 & ' nhpb',nhpb,' link_start=',link_start,
1390 & ' link_end',link_end