2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
123 C Set default weights of the energy terms.
134 c print '(a,$)','Inside initialize'
135 c call memmon_print_usage()
168 athet(j,i,ichir1,ichir2)=0.0D0
169 bthet(j,i,ichir1,ichir2)=0.0D0
189 gaussc(l,k,j,i)=0.0D0
199 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
203 v1(k,j,i,iblock)=0.0D0
204 v2(k,j,i,iblock)=0.0D0
214 v1c(1,l,i,j,k,iblock)=0.0D0
215 v1s(1,l,i,j,k,iblock)=0.0D0
216 v1c(2,l,i,j,k,iblock)=0.0D0
217 v1s(2,l,i,j,k,iblock)=0.0D0
221 v2c(m,l,i,j,k,iblock)=0.0D0
222 v2s(m,l,i,j,k,iblock)=0.0D0
234 C Initialize the bridge arrays
248 C Initialize correlation arrays
269 C Initialize variables used in minimization.
278 C Initialize the variables responsible for the mode of gradient storage.
283 C Initialize constants used to split the energy into long- and short-range
289 nprint_ene=nprint_ene-1
293 c-------------------------------------------------------------------------
295 implicit real*8 (a-h,o-z)
297 include 'COMMON.NAMES'
298 include 'COMMON.FFIELD'
300 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
301 & 'DSG','DGN','DSN','DTH',
302 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
303 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
304 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
307 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
308 &'a','y','w','v','l','i','f','m','c','x',
309 &'C','M','F','I','L','V','W','Y','A','G','T',
310 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
311 data potname /'LJ','LJK','BP','GB','GBV'/
313 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
314 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
315 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
316 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
318 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
319 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
320 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
322 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
325 c---------------------------------------------------------------------------
326 subroutine init_int_table
327 implicit real*8 (a-h,o-z)
331 integer blocklengths(15),displs(15)
333 include 'COMMON.CONTROL'
334 include 'COMMON.SETUP'
335 include 'COMMON.CHAIN'
336 include 'COMMON.INTERACT'
337 include 'COMMON.LOCAL'
338 include 'COMMON.SBRIDGE'
339 include 'COMMON.TORCNSTR'
340 include 'COMMON.IOUNITS'
341 include 'COMMON.DERIV'
342 include 'COMMON.CONTACTS'
343 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
344 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
345 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
346 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
347 & ielend_all(maxres,0:max_fg_procs-1),
348 & ntask_cont_from_all(0:max_fg_procs-1),
349 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
350 & ntask_cont_to_all(0:max_fg_procs-1),
351 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
352 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
353 logical scheck,lprint,flag
355 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
356 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
357 C... Determine the numbers of start and end SC-SC interaction
358 C... to deal with by current processor.
360 itask_cont_from(i)=fg_rank
361 itask_cont_to(i)=fg_rank
365 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
366 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
367 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
369 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
370 & ' absolute rank',MyRank,
371 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
372 & ' my_sc_inde',my_sc_inde
392 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
393 cd & (ihpb(i),jhpb(i),i=1,nss)
398 if (ihpb(ii).eq.i+nres) then
405 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
409 c write (iout,*) 'jj=i+1'
410 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
411 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
417 else if (jj.eq.nct) then
419 c write (iout,*) 'jj=nct'
420 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
421 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
429 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
430 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
432 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
433 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
444 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
445 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
450 ind_scint=ind_scint+nct-i
454 ind_scint_old=ind_scint
463 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
464 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
467 write (iout,'(a)') 'Interaction array:'
469 write (iout,'(i3,2(2x,2i3))')
470 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
475 C Now partition the electrostatic-interaction array
477 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
478 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
480 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
481 & ' absolute rank',MyRank,
482 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
483 & ' my_ele_inde',my_ele_inde
490 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
491 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
494 if (iatel_s.eq.0) iatel_s=1
495 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
496 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
497 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
498 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
499 c & " my_ele_inde_vdw",my_ele_inde_vdw
506 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
508 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
510 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
511 c & " ielend_vdw",ielend_vdw(i)
513 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
524 do i=iatel_s_vdw,iatel_e_vdw
530 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
531 & ' absolute rank',MyRank
532 write (iout,*) 'Electrostatic interaction array:'
534 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
539 C Partition the SC-p interaction array
541 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
542 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
543 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
544 & ' absolute rank',myrank,
545 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
546 & ' my_scp_inde',my_scp_inde
552 if (i.lt.nnt+iscp) then
553 cd write (iout,*) 'i.le.nnt+iscp'
554 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
555 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
557 else if (i.gt.nct-iscp) then
558 cd write (iout,*) 'i.gt.nct-iscp'
559 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
560 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
563 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
564 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
567 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
568 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
577 if (i.lt.nnt+iscp) then
579 iscpstart(i,1)=i+iscp
581 elseif (i.gt.nct-iscp) then
589 iscpstart(i,2)=i+iscp
595 write (iout,'(a)') 'SC-p interaction array:'
596 do i=iatscp_s,iatscp_e
597 write (iout,'(i3,2(2x,2i3))')
598 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
601 C Partition local interactions
603 call int_bounds(nres-2,loc_start,loc_end)
604 loc_start=loc_start+1
606 call int_bounds(nres-2,ithet_start,ithet_end)
607 ithet_start=ithet_start+2
608 ithet_end=ithet_end+2
609 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
610 iturn3_start=iturn3_start+nnt
611 iphi_start=iturn3_start+2
612 iturn3_end=iturn3_end+nnt
613 iphi_end=iturn3_end+2
614 iturn3_start=iturn3_start-1
615 iturn3_end=iturn3_end-1
616 call int_bounds(nres-3,itau_start,itau_end)
617 itau_start=itau_start+3
619 call int_bounds(nres-3,iphi1_start,iphi1_end)
620 iphi1_start=iphi1_start+3
621 iphi1_end=iphi1_end+3
622 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
623 iturn4_start=iturn4_start+nnt
624 iphid_start=iturn4_start+2
625 iturn4_end=iturn4_end+nnt
626 iphid_end=iturn4_end+2
627 iturn4_start=iturn4_start-1
628 iturn4_end=iturn4_end-1
629 call int_bounds(nres-2,ibond_start,ibond_end)
630 ibond_start=ibond_start+1
631 ibond_end=ibond_end+1
632 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
633 ibondp_start=ibondp_start+nnt
634 ibondp_end=ibondp_end+nnt
635 call int_bounds1(nres-1,ivec_start,ivec_end)
636 c print *,"Processor",myrank,fg_rank,fg_rank1,
637 c & " ivec_start",ivec_start," ivec_end",ivec_end
638 iset_start=loc_start+2
640 if (ndih_constr.eq.0) then
644 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
646 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
648 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
650 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
651 igrad_start=((2*nlen+1)
652 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
653 jgrad_start(igrad_start)=
654 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
656 jgrad_end(igrad_start)=nres
657 igrad_end=((2*nlen+1)
658 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
659 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
660 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
662 do i=igrad_start+1,igrad_end-1
667 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
668 & ' absolute rank',myrank,
669 & ' loc_start',loc_start,' loc_end',loc_end,
670 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
671 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
672 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
673 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
674 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
675 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
676 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
677 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
678 & ' iset_start',iset_start,' iset_end',iset_end,
679 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
681 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
682 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
683 & ' ngrad_end',ngrad_end
684 do i=igrad_start,igrad_end
685 write(*,*) 'Processor:',fg_rank,myrank,i,
686 & jgrad_start(i),jgrad_end(i)
689 if (nfgtasks.gt.1) then
690 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
691 & MPI_INTEGER,FG_COMM1,IERROR)
692 iaux=ivec_end-ivec_start+1
693 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
694 & MPI_INTEGER,FG_COMM1,IERROR)
695 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
696 & MPI_INTEGER,FG_COMM,IERROR)
697 iaux=iset_end-iset_start+1
698 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
699 & MPI_INTEGER,FG_COMM,IERROR)
700 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
701 & MPI_INTEGER,FG_COMM,IERROR)
702 iaux=ibond_end-ibond_start+1
703 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
704 & MPI_INTEGER,FG_COMM,IERROR)
705 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
706 & MPI_INTEGER,FG_COMM,IERROR)
707 iaux=ithet_end-ithet_start+1
708 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
709 & MPI_INTEGER,FG_COMM,IERROR)
710 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
711 & MPI_INTEGER,FG_COMM,IERROR)
712 iaux=iphi_end-iphi_start+1
713 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
714 & MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
716 & MPI_INTEGER,FG_COMM,IERROR)
717 iaux=iphi1_end-iphi1_start+1
718 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
719 & MPI_INTEGER,FG_COMM,IERROR)
726 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
727 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
728 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
729 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
730 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
731 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
732 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
733 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
734 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
735 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
736 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
737 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
738 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
739 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
740 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
741 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
743 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
744 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
745 write (iout,*) "iturn3_start_all",
746 & (iturn3_start_all(i),i=0,nfgtasks-1)
747 write (iout,*) "iturn3_end_all",
748 & (iturn3_end_all(i),i=0,nfgtasks-1)
749 write (iout,*) "iturn4_start_all",
750 & (iturn4_start_all(i),i=0,nfgtasks-1)
751 write (iout,*) "iturn4_end_all",
752 & (iturn4_end_all(i),i=0,nfgtasks-1)
753 write (iout,*) "The ielstart_all array"
755 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
757 write (iout,*) "The ielend_all array"
759 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
765 itask_cont_from(0)=fg_rank
766 itask_cont_to(0)=fg_rank
768 do ii=iturn3_start,iturn3_end
769 call add_int(ii,ii+2,iturn3_sent(1,ii),
770 & ntask_cont_to,itask_cont_to,flag)
772 do ii=iturn4_start,iturn4_end
773 call add_int(ii,ii+3,iturn4_sent(1,ii),
774 & ntask_cont_to,itask_cont_to,flag)
776 do ii=iturn3_start,iturn3_end
777 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
779 do ii=iturn4_start,iturn4_end
780 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
783 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
784 & " ntask_cont_to",ntask_cont_to
785 write (iout,*) "itask_cont_from",
786 & (itask_cont_from(i),i=1,ntask_cont_from)
787 write (iout,*) "itask_cont_to",
788 & (itask_cont_to(i),i=1,ntask_cont_to)
791 c write (iout,*) "Loop forward"
794 c write (iout,*) "from loop i=",i
796 do j=ielstart(i),ielend(i)
797 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
800 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
801 c & " iatel_e",iatel_e
805 c write (iout,*) "i",i," ielstart",ielstart(i),
806 c & " ielend",ielend(i)
809 do j=ielstart(i),ielend(i)
810 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
811 & itask_cont_to,flag)
819 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
820 & " ntask_cont_to",ntask_cont_to
821 write (iout,*) "itask_cont_from",
822 & (itask_cont_from(i),i=1,ntask_cont_from)
823 write (iout,*) "itask_cont_to",
824 & (itask_cont_to(i),i=1,ntask_cont_to)
826 write (iout,*) "iint_sent"
829 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
830 & j=ielstart(ii),ielend(ii))
832 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
833 & " iturn3_end",iturn3_end
834 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
835 & i=iturn3_start,iturn3_end)
836 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
837 & " iturn4_end",iturn4_end
838 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
839 & i=iturn4_start,iturn4_end)
842 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
843 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
844 c write (iout,*) "Gather ntask_cont_from ended"
846 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
847 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
849 c write (iout,*) "Gather itask_cont_from ended"
851 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
852 & 1,MPI_INTEGER,king,FG_COMM,IERR)
853 c write (iout,*) "Gather ntask_cont_to ended"
855 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
856 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
857 c write (iout,*) "Gather itask_cont_to ended"
859 if (fg_rank.eq.king) then
860 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
862 write (iout,'(20i4)') i,ntask_cont_from_all(i),
863 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
867 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
869 write (iout,'(20i4)') i,ntask_cont_to_all(i),
870 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
874 C Check if every send will have a matching receive
878 ncheck_to=ncheck_to+ntask_cont_to_all(i)
879 ncheck_from=ncheck_from+ntask_cont_from_all(i)
881 write (iout,*) "Control sums",ncheck_from,ncheck_to
882 if (ncheck_from.ne.ncheck_to) then
883 write (iout,*) "Error: #receive differs from #send."
884 write (iout,*) "Terminating program...!"
890 do j=1,ntask_cont_to_all(i)
891 ii=itask_cont_to_all(j,i)
892 do k=1,ntask_cont_from_all(ii)
893 if (itask_cont_from_all(k,ii).eq.i) then
894 if(lprint)write(iout,*)"Matching send/receive",i,ii
898 if (k.eq.ntask_cont_from_all(ii)+1) then
900 write (iout,*) "Error: send by",j," to",ii,
901 & " would have no matching receive"
907 write (iout,*) "Unmatched sends; terminating program"
911 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
912 c write (iout,*) "flag broadcast ended flag=",flag
915 call MPI_Finalize(IERROR)
916 stop "Error in INIT_INT_TABLE: unmatched send/receive."
918 call MPI_Comm_group(FG_COMM,fg_group,IERR)
919 c write (iout,*) "MPI_Comm_group ended"
921 call MPI_Group_incl(fg_group,ntask_cont_from+1,
922 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
923 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
924 & CONT_TO_GROUP,IERR)
927 iaux=4*(ielend(ii)-ielstart(ii)+1)
928 call MPI_Group_translate_ranks(fg_group,iaux,
929 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
930 & iint_sent_local(1,ielstart(ii),i),IERR )
931 c write (iout,*) "Ranks translated i=",i
934 iaux=4*(iturn3_end-iturn3_start+1)
935 call MPI_Group_translate_ranks(fg_group,iaux,
936 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
937 & iturn3_sent_local(1,iturn3_start),IERR)
938 iaux=4*(iturn4_end-iturn4_start+1)
939 call MPI_Group_translate_ranks(fg_group,iaux,
940 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
941 & iturn4_sent_local(1,iturn4_start),IERR)
943 write (iout,*) "iint_sent_local"
946 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
947 & j=ielstart(ii),ielend(ii))
950 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
951 & " iturn3_end",iturn3_end
952 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
953 & i=iturn3_start,iturn3_end)
954 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
955 & " iturn4_end",iturn4_end
956 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
957 & i=iturn4_start,iturn4_end)
960 call MPI_Group_free(fg_group,ierr)
961 call MPI_Group_free(cont_from_group,ierr)
962 call MPI_Group_free(cont_to_group,ierr)
963 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
964 call MPI_Type_commit(MPI_UYZ,IERROR)
965 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
967 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
968 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
969 call MPI_Type_commit(MPI_MU,IERROR)
970 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
971 call MPI_Type_commit(MPI_MAT1,IERROR)
972 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
973 call MPI_Type_commit(MPI_MAT2,IERROR)
974 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
975 call MPI_Type_commit(MPI_THET,IERROR)
976 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
977 call MPI_Type_commit(MPI_GAM,IERROR)
979 c 9/22/08 Derived types to send matrices which appear in correlation terms
981 if (ivec_count(i).eq.ivec_count(0)) then
987 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
988 if (ind_typ.eq.0) then
998 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1001 c blocklengths(i)=blocklengths(i)*ichunk
1003 c write (iout,*) "blocklengths and displs"
1005 c write (iout,*) i,blocklengths(i),displs(i)
1008 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1009 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1010 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1011 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1017 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1020 c blocklengths(i)=blocklengths(i)*ichunk
1022 c write (iout,*) "blocklengths and displs"
1024 c write (iout,*) i,blocklengths(i),displs(i)
1027 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1028 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1029 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1030 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1036 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1039 blocklengths(i)=blocklengths(i)*ichunk
1041 call MPI_Type_indexed(8,blocklengths,displs,
1042 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1043 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1049 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1052 blocklengths(i)=blocklengths(i)*ichunk
1054 call MPI_Type_indexed(8,blocklengths,displs,
1055 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1056 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1062 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1065 blocklengths(i)=blocklengths(i)*ichunk
1067 call MPI_Type_indexed(6,blocklengths,displs,
1068 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1069 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1075 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1078 blocklengths(i)=blocklengths(i)*ichunk
1080 call MPI_Type_indexed(2,blocklengths,displs,
1081 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1082 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1088 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1091 blocklengths(i)=blocklengths(i)*ichunk
1093 call MPI_Type_indexed(4,blocklengths,displs,
1094 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1095 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1099 iint_start=ivec_start+1
1102 iint_count(i)=ivec_count(i)
1103 iint_displ(i)=ivec_displ(i)
1104 ivec_displ(i)=ivec_displ(i)-1
1105 iset_displ(i)=iset_displ(i)-1
1106 ithet_displ(i)=ithet_displ(i)-1
1107 iphi_displ(i)=iphi_displ(i)-1
1108 iphi1_displ(i)=iphi1_displ(i)-1
1109 ibond_displ(i)=ibond_displ(i)-1
1111 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1112 & .and. (me.eq.0 .or. .not. out1file)) then
1113 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1115 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1118 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1119 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1120 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1122 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1125 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1126 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1127 & ' SC-p interactions','were distributed among',nfgtasks,
1128 & ' fine-grain processors.'
1144 idihconstr_end=ndih_constr
1145 iphid_start=iphi_start
1146 iphid_end=iphi_end-1
1163 c---------------------------------------------------------------------------
1164 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1166 include "DIMENSIONS"
1167 include "COMMON.INTERACT"
1168 include "COMMON.SETUP"
1169 include "COMMON.IOUNITS"
1170 integer ii,jj,itask(4),ntask_cont_to,
1171 &itask_cont_to(0:max_fg_procs-1)
1173 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1174 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1175 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1176 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1177 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1178 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1179 & ielend_all(maxres,0:max_fg_procs-1)
1180 integer iproc,isent,k,l
1181 c Determines whether to send interaction ii,jj to other processors; a given
1182 c interaction can be sent to at most 2 processors.
1183 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1184 c one processor, otherwise flag is unchanged from the input value.
1190 c write (iout,*) "ii",ii," jj",jj
1191 c Loop over processors to check if anybody could need interaction ii,jj
1192 do iproc=0,fg_rank-1
1193 c Check if the interaction matches any turn3 at iproc
1194 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1196 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1197 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1199 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1202 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1203 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1206 call add_task(iproc,ntask_cont_to,itask_cont_to)
1210 C Check if the interaction matches any turn4 at iproc
1211 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1213 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1214 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1216 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1219 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1220 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1223 call add_task(iproc,ntask_cont_to,itask_cont_to)
1227 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1228 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1229 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1230 & ielend_all(ii-1,iproc).ge.jj-1) then
1232 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1233 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1236 call add_task(iproc,ntask_cont_to,itask_cont_to)
1239 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1240 & ielend_all(ii-1,iproc).ge.jj+1) then
1242 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1243 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1246 call add_task(iproc,ntask_cont_to,itask_cont_to)
1253 c---------------------------------------------------------------------------
1254 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1256 include "DIMENSIONS"
1257 include "COMMON.INTERACT"
1258 include "COMMON.SETUP"
1259 include "COMMON.IOUNITS"
1260 integer ii,jj,itask(2),ntask_cont_from,
1261 & itask_cont_from(0:max_fg_procs-1)
1263 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1264 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1265 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1266 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1267 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1268 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1269 & ielend_all(maxres,0:max_fg_procs-1)
1271 do iproc=fg_rank+1,nfgtasks-1
1272 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1274 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1275 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1277 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1278 call add_task(iproc,ntask_cont_from,itask_cont_from)
1281 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1283 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1284 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1286 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1287 call add_task(iproc,ntask_cont_from,itask_cont_from)
1290 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1291 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1293 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1294 & jj+1.le.ielend_all(ii+1,iproc)) then
1295 call add_task(iproc,ntask_cont_from,itask_cont_from)
1297 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1298 & jj-1.le.ielend_all(ii+1,iproc)) then
1299 call add_task(iproc,ntask_cont_from,itask_cont_from)
1302 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1304 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1305 & jj-1.le.ielend_all(ii-1,iproc)) then
1306 call add_task(iproc,ntask_cont_from,itask_cont_from)
1308 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1309 & jj+1.le.ielend_all(ii-1,iproc)) then
1310 call add_task(iproc,ntask_cont_from,itask_cont_from)
1317 c---------------------------------------------------------------------------
1318 subroutine add_task(iproc,ntask_cont,itask_cont)
1320 include "DIMENSIONS"
1321 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1324 if (itask_cont(ii).eq.iproc) return
1326 ntask_cont=ntask_cont+1
1327 itask_cont(ntask_cont)=iproc
1330 c---------------------------------------------------------------------------
1331 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1332 implicit real*8 (a-h,o-z)
1333 include 'DIMENSIONS'
1335 include 'COMMON.SETUP'
1336 integer total_ints,lower_bound,upper_bound
1337 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1338 nint=total_ints/nfgtasks
1342 nexcess=total_ints-nint*nfgtasks
1344 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1348 lower_bound=lower_bound+int4proc(i)
1350 upper_bound=lower_bound+int4proc(fg_rank)
1351 lower_bound=lower_bound+1
1354 c---------------------------------------------------------------------------
1355 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1356 implicit real*8 (a-h,o-z)
1357 include 'DIMENSIONS'
1359 include 'COMMON.SETUP'
1360 integer total_ints,lower_bound,upper_bound
1361 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1362 nint=total_ints/nfgtasks1
1366 nexcess=total_ints-nint*nfgtasks1
1368 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1372 lower_bound=lower_bound+int4proc(i)
1374 upper_bound=lower_bound+int4proc(fg_rank1)
1375 lower_bound=lower_bound+1
1378 c---------------------------------------------------------------------------
1379 subroutine int_partition(int_index,lower_index,upper_index,atom,
1380 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1381 implicit real*8 (a-h,o-z)
1382 include 'DIMENSIONS'
1383 include 'COMMON.IOUNITS'
1384 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1385 & first_atom,last_atom,int_gr,jat_start,jat_end
1388 if (lprn) write (iout,*) 'int_index=',int_index
1389 int_index_old=int_index
1390 int_index=int_index+last_atom-first_atom+1
1392 & write (iout,*) 'int_index=',int_index,
1393 & ' int_index_old',int_index_old,
1394 & ' lower_index=',lower_index,
1395 & ' upper_index=',upper_index,
1396 & ' atom=',atom,' first_atom=',first_atom,
1397 & ' last_atom=',last_atom
1398 if (int_index.ge.lower_index) then
1400 if (at_start.eq.0) then
1402 jat_start=first_atom-1+lower_index-int_index_old
1404 jat_start=first_atom
1406 if (lprn) write (iout,*) 'jat_start',jat_start
1407 if (int_index.ge.upper_index) then
1409 jat_end=first_atom-1+upper_index-int_index_old
1414 if (lprn) write (iout,*) 'jat_end',jat_end
1419 c------------------------------------------------------------------------------
1420 subroutine hpb_partition
1421 implicit real*8 (a-h,o-z)
1422 include 'DIMENSIONS'
1426 include 'COMMON.SBRIDGE'
1427 include 'COMMON.IOUNITS'
1428 include 'COMMON.SETUP'
1430 call int_bounds(nhpb,link_start,link_end)
1431 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1432 & ' absolute rank',MyRank,
1433 & ' nhpb',nhpb,' link_start=',link_start,
1434 & ' link_end',link_end