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
125 C Lipidic input file for parameters range 60-79
127 C input file for transfer sidechain and peptide group inside the
128 C lipidic environment if lipid is implicite
130 C DNA input files for parameters range 80-99
131 C Suger input files for parameters range 100-119
132 C All-atom input files for parameters range 120-149
134 C Set default weights of the energy terms.
145 c print '(a,$)','Inside initialize'
146 c call memmon_print_usage()
181 athet(j,i,ichir1,ichir2)=0.0D0
182 bthet(j,i,ichir1,ichir2)=0.0D0
202 gaussc(l,k,j,i)=0.0D0
212 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
216 v1(k,j,i,iblock)=0.0D0
217 v2(k,j,i,iblock)=0.0D0
227 v1c(1,l,i,j,k,iblock)=0.0D0
228 v1s(1,l,i,j,k,iblock)=0.0D0
229 v1c(2,l,i,j,k,iblock)=0.0D0
230 v1s(2,l,i,j,k,iblock)=0.0D0
234 v2c(m,l,i,j,k,iblock)=0.0D0
235 v2s(m,l,i,j,k,iblock)=0.0D0
247 C Initialize the bridge arrays
261 C Initialize correlation arrays
292 C Initialize variables used in minimization.
301 C Initialize the variables responsible for the mode of gradient storage.
306 C Initialize constants used to split the energy into long- and short-range
312 nprint_ene=nprint_ene-1
316 c-------------------------------------------------------------------------
318 implicit real*8 (a-h,o-z)
320 include 'COMMON.NAMES'
321 include 'COMMON.FFIELD'
323 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
324 & 'DSG','DGN','DSN','DTH',
325 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
326 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
327 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
330 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
331 &'a','y','w','v','l','i','f','m','c','x',
332 &'C','M','F','I','L','V','W','Y','A','G','T',
333 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
334 data potname /'LJ','LJK','BP','GB','GBV'/
336 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
337 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
338 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
339 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR",
340 & "ELIPTRAN", "EAFM", "ETHETCNSTR", " "/
342 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
343 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
344 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
345 & "WLT", "WAFM", "WTHETCNSR", " "/
347 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
350 c---------------------------------------------------------------------------
351 subroutine init_int_table
352 implicit real*8 (a-h,o-z)
356 integer blocklengths(15),displs(15)
358 include 'COMMON.CONTROL'
359 include 'COMMON.SETUP'
360 include 'COMMON.CHAIN'
361 include 'COMMON.INTERACT'
362 include 'COMMON.LOCAL'
363 include 'COMMON.SBRIDGE'
364 include 'COMMON.TORCNSTR'
365 include 'COMMON.IOUNITS'
366 include 'COMMON.DERIV'
367 include 'COMMON.CONTACTS'
368 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
369 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
370 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
371 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
372 & ielend_all(maxres,0:max_fg_procs-1),
373 & ntask_cont_from_all(0:max_fg_procs-1),
374 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
375 & ntask_cont_to_all(0:max_fg_procs-1),
376 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
377 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
378 logical scheck,lprint,flag
380 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
381 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
382 C... Determine the numbers of start and end SC-SC interaction
383 C... to deal with by current processor.
385 itask_cont_from(i)=fg_rank
386 itask_cont_to(i)=fg_rank
390 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
391 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
392 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
394 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
395 & ' absolute rank',MyRank,
396 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
397 & ' my_sc_inde',my_sc_inde
417 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
418 cd & (ihpb(i),jhpb(i),i=1,nss)
423 if (ihpb(ii).eq.i+nres) then
430 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
434 c write (iout,*) 'jj=i+1'
435 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
436 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
442 else if (jj.eq.nct) then
444 c write (iout,*) 'jj=nct'
445 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
446 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
454 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
455 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
457 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
458 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
469 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
470 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
475 ind_scint=ind_scint+nct-i
479 ind_scint_old=ind_scint
487 if (iatsc_s.eq.0) iatsc_s=1
489 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
490 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
493 write (iout,'(a)') 'Interaction array:'
495 write (iout,'(i3,2(2x,2i3))')
496 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
501 C Now partition the electrostatic-interaction array
503 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
504 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
506 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
507 & ' absolute rank',MyRank,
508 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
509 & ' my_ele_inde',my_ele_inde
516 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
517 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
520 if (iatel_s.eq.0) iatel_s=1
521 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
522 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
523 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
524 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
525 c & " my_ele_inde_vdw",my_ele_inde_vdw
532 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
534 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
536 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
537 c & " ielend_vdw",ielend_vdw(i)
539 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
550 do i=iatel_s_vdw,iatel_e_vdw
556 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
557 & ' absolute rank',MyRank
558 write (iout,*) 'Electrostatic interaction array:'
560 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
565 C Partition the SC-p interaction array
567 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
568 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
569 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
570 & ' absolute rank',myrank,
571 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
572 & ' my_scp_inde',my_scp_inde
578 if (i.lt.nnt+iscp) then
579 cd write (iout,*) 'i.le.nnt+iscp'
580 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
581 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
583 else if (i.gt.nct-iscp) then
584 cd write (iout,*) 'i.gt.nct-iscp'
585 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
586 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
589 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
590 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
593 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
594 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
603 if (i.lt.nnt+iscp) then
605 iscpstart(i,1)=i+iscp
607 elseif (i.gt.nct-iscp) then
615 iscpstart(i,2)=i+iscp
620 if (iatscp_s.eq.0) iatscp_s=1
622 write (iout,'(a)') 'SC-p interaction array:'
623 do i=iatscp_s,iatscp_e
624 write (iout,'(i3,2(2x,2i3))')
625 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
628 C Partition local interactions
630 call int_bounds(nres-2,loc_start,loc_end)
631 loc_start=loc_start+1
633 call int_bounds(nres-2,ithet_start,ithet_end)
634 ithet_start=ithet_start+2
635 ithet_end=ithet_end+2
636 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
637 iturn3_start=iturn3_start+nnt
638 iphi_start=iturn3_start+2
639 iturn3_end=iturn3_end+nnt
640 iphi_end=iturn3_end+2
641 iturn3_start=iturn3_start-1
642 iturn3_end=iturn3_end-1
643 call int_bounds(nres-3,itau_start,itau_end)
644 itau_start=itau_start+3
646 call int_bounds(nres-3,iphi1_start,iphi1_end)
647 iphi1_start=iphi1_start+3
648 iphi1_end=iphi1_end+3
649 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
650 iturn4_start=iturn4_start+nnt
651 iphid_start=iturn4_start+2
652 iturn4_end=iturn4_end+nnt
653 iphid_end=iturn4_end+2
654 iturn4_start=iturn4_start-1
655 iturn4_end=iturn4_end-1
656 call int_bounds(nres-2,ibond_start,ibond_end)
657 ibond_start=ibond_start+1
658 ibond_end=ibond_end+1
659 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
660 ibondp_start=ibondp_start+nnt
661 ibondp_end=ibondp_end+nnt
662 call int_bounds(nres,ilip_start,ilip_end)
663 ilip_start=ilip_start
664 call int_bounds1(nres-1,ivec_start,ivec_end)
665 c print *,"Processor",myrank,fg_rank,fg_rank1,
666 c & " ivec_start",ivec_start," ivec_end",ivec_end
667 iset_start=loc_start+2
669 if (ndih_constr.eq.0) then
673 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
675 if (ntheta_constr.eq.0) then
680 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
682 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
684 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
686 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
687 igrad_start=((2*nlen+1)
688 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
689 jgrad_start(igrad_start)=
690 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
692 jgrad_end(igrad_start)=nres
693 igrad_end=((2*nlen+1)
694 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
695 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
696 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
698 do i=igrad_start+1,igrad_end-1
703 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
704 & ' absolute rank',myrank,
705 & ' loc_start',loc_start,' loc_end',loc_end,
706 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
707 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
708 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
709 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
710 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
711 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
712 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
713 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
714 & ' iset_start',iset_start,' iset_end',iset_end,
715 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
717 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
720 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
721 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
722 & ' ngrad_end',ngrad_end
723 do i=igrad_start,igrad_end
724 write(*,*) 'Processor:',fg_rank,myrank,i,
725 & jgrad_start(i),jgrad_end(i)
728 if (nfgtasks.gt.1) then
729 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
730 & MPI_INTEGER,FG_COMM1,IERROR)
731 iaux=ivec_end-ivec_start+1
732 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
733 & MPI_INTEGER,FG_COMM1,IERROR)
734 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
735 & MPI_INTEGER,FG_COMM,IERROR)
736 iaux=iset_end-iset_start+1
737 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
738 & MPI_INTEGER,FG_COMM,IERROR)
739 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
740 & MPI_INTEGER,FG_COMM,IERROR)
741 iaux=ibond_end-ibond_start+1
742 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
743 & MPI_INTEGER,FG_COMM,IERROR)
744 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
745 & MPI_INTEGER,FG_COMM,IERROR)
746 iaux=ithet_end-ithet_start+1
747 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
748 & MPI_INTEGER,FG_COMM,IERROR)
749 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
750 & MPI_INTEGER,FG_COMM,IERROR)
751 iaux=iphi_end-iphi_start+1
752 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
753 & MPI_INTEGER,FG_COMM,IERROR)
754 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
755 & MPI_INTEGER,FG_COMM,IERROR)
756 iaux=iphi1_end-iphi1_start+1
757 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
758 & MPI_INTEGER,FG_COMM,IERROR)
765 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
766 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
767 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
768 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
769 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
770 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
771 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
772 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
773 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
774 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
775 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
776 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
777 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
778 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
779 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
780 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
782 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
783 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
784 write (iout,*) "iturn3_start_all",
785 & (iturn3_start_all(i),i=0,nfgtasks-1)
786 write (iout,*) "iturn3_end_all",
787 & (iturn3_end_all(i),i=0,nfgtasks-1)
788 write (iout,*) "iturn4_start_all",
789 & (iturn4_start_all(i),i=0,nfgtasks-1)
790 write (iout,*) "iturn4_end_all",
791 & (iturn4_end_all(i),i=0,nfgtasks-1)
792 write (iout,*) "The ielstart_all array"
794 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
796 write (iout,*) "The ielend_all array"
798 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
804 itask_cont_from(0)=fg_rank
805 itask_cont_to(0)=fg_rank
807 do ii=iturn3_start,iturn3_end
808 call add_int(ii,ii+2,iturn3_sent(1,ii),
809 & ntask_cont_to,itask_cont_to,flag)
811 do ii=iturn4_start,iturn4_end
812 call add_int(ii,ii+3,iturn4_sent(1,ii),
813 & ntask_cont_to,itask_cont_to,flag)
815 do ii=iturn3_start,iturn3_end
816 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
818 do ii=iturn4_start,iturn4_end
819 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
822 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
823 & " ntask_cont_to",ntask_cont_to
824 write (iout,*) "itask_cont_from",
825 & (itask_cont_from(i),i=1,ntask_cont_from)
826 write (iout,*) "itask_cont_to",
827 & (itask_cont_to(i),i=1,ntask_cont_to)
830 c write (iout,*) "Loop forward"
833 c write (iout,*) "from loop i=",i
835 do j=ielstart(i),ielend(i)
836 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
839 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
840 c & " iatel_e",iatel_e
844 c write (iout,*) "i",i," ielstart",ielstart(i),
845 c & " ielend",ielend(i)
848 do j=ielstart(i),ielend(i)
849 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
850 & itask_cont_to,flag)
858 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
859 & " ntask_cont_to",ntask_cont_to
860 write (iout,*) "itask_cont_from",
861 & (itask_cont_from(i),i=1,ntask_cont_from)
862 write (iout,*) "itask_cont_to",
863 & (itask_cont_to(i),i=1,ntask_cont_to)
865 write (iout,*) "iint_sent"
868 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
869 & j=ielstart(ii),ielend(ii))
871 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
872 & " iturn3_end",iturn3_end
873 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
874 & i=iturn3_start,iturn3_end)
875 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
876 & " iturn4_end",iturn4_end
877 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
878 & i=iturn4_start,iturn4_end)
881 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
882 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
883 c write (iout,*) "Gather ntask_cont_from ended"
885 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
886 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
888 c write (iout,*) "Gather itask_cont_from ended"
890 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
891 & 1,MPI_INTEGER,king,FG_COMM,IERR)
892 c write (iout,*) "Gather ntask_cont_to ended"
894 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
895 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
896 c write (iout,*) "Gather itask_cont_to ended"
898 if (fg_rank.eq.king) then
899 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
901 write (iout,'(20i4)') i,ntask_cont_from_all(i),
902 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
906 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
908 write (iout,'(20i4)') i,ntask_cont_to_all(i),
909 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
913 C Check if every send will have a matching receive
917 ncheck_to=ncheck_to+ntask_cont_to_all(i)
918 ncheck_from=ncheck_from+ntask_cont_from_all(i)
920 write (iout,*) "Control sums",ncheck_from,ncheck_to
921 if (ncheck_from.ne.ncheck_to) then
922 write (iout,*) "Error: #receive differs from #send."
923 write (iout,*) "Terminating program...!"
929 do j=1,ntask_cont_to_all(i)
930 ii=itask_cont_to_all(j,i)
931 do k=1,ntask_cont_from_all(ii)
932 if (itask_cont_from_all(k,ii).eq.i) then
933 if(lprint)write(iout,*)"Matching send/receive",i,ii
937 if (k.eq.ntask_cont_from_all(ii)+1) then
939 write (iout,*) "Error: send by",j," to",ii,
940 & " would have no matching receive"
946 write (iout,*) "Unmatched sends; terminating program"
950 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
951 c write (iout,*) "flag broadcast ended flag=",flag
954 call MPI_Finalize(IERROR)
955 stop "Error in INIT_INT_TABLE: unmatched send/receive."
957 call MPI_Comm_group(FG_COMM,fg_group,IERR)
958 c write (iout,*) "MPI_Comm_group ended"
960 call MPI_Group_incl(fg_group,ntask_cont_from+1,
961 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
962 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
963 & CONT_TO_GROUP,IERR)
966 iaux=4*(ielend(ii)-ielstart(ii)+1)
967 call MPI_Group_translate_ranks(fg_group,iaux,
968 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
969 & iint_sent_local(1,ielstart(ii),i),IERR )
970 c write (iout,*) "Ranks translated i=",i
973 iaux=4*(iturn3_end-iturn3_start+1)
974 call MPI_Group_translate_ranks(fg_group,iaux,
975 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
976 & iturn3_sent_local(1,iturn3_start),IERR)
977 iaux=4*(iturn4_end-iturn4_start+1)
978 call MPI_Group_translate_ranks(fg_group,iaux,
979 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
980 & iturn4_sent_local(1,iturn4_start),IERR)
982 write (iout,*) "iint_sent_local"
985 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
986 & j=ielstart(ii),ielend(ii))
989 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
990 & " iturn3_end",iturn3_end
991 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
992 & i=iturn3_start,iturn3_end)
993 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
994 & " iturn4_end",iturn4_end
995 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
996 & i=iturn4_start,iturn4_end)
999 call MPI_Group_free(fg_group,ierr)
1000 call MPI_Group_free(cont_from_group,ierr)
1001 call MPI_Group_free(cont_to_group,ierr)
1002 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1003 call MPI_Type_commit(MPI_UYZ,IERROR)
1004 call MPI_Type_contiguous(maxcontsshi,MPI_INTEGER,MPI_I50,IERROR)
1005 call MPI_Type_commit(MPI_I50,IERROR)
1006 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1008 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1009 impishi=maxcontsshi*3
1010 call MPI_Type_contiguous(impishi,MPI_DOUBLE_PRECISION,
1012 call MPI_Type_commit(MPI_SHI,IERROR)
1013 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1014 call MPI_Type_commit(MPI_MU,IERROR)
1015 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1016 call MPI_Type_commit(MPI_MAT1,IERROR)
1017 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1018 call MPI_Type_commit(MPI_MAT2,IERROR)
1019 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1020 call MPI_Type_commit(MPI_THET,IERROR)
1021 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1022 call MPI_Type_commit(MPI_GAM,IERROR)
1024 c 9/22/08 Derived types to send matrices which appear in correlation terms
1026 if (ivec_count(i).eq.ivec_count(0)) then
1032 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1033 if (ind_typ.eq.0) then
1034 ichunk=ivec_count(0)
1036 ichunk=ivec_count(1)
1043 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1046 c blocklengths(i)=blocklengths(i)*ichunk
1048 c write (iout,*) "blocklengths and displs"
1050 c write (iout,*) i,blocklengths(i),displs(i)
1053 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1054 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1055 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1056 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1062 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1065 c blocklengths(i)=blocklengths(i)*ichunk
1067 c write (iout,*) "blocklengths and displs"
1069 c write (iout,*) i,blocklengths(i),displs(i)
1072 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1073 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1074 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1075 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1081 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1084 blocklengths(i)=blocklengths(i)*ichunk
1086 call MPI_Type_indexed(8,blocklengths,displs,
1087 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1088 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1094 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1097 blocklengths(i)=blocklengths(i)*ichunk
1099 call MPI_Type_indexed(8,blocklengths,displs,
1100 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1101 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1107 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1110 blocklengths(i)=blocklengths(i)*ichunk
1112 call MPI_Type_indexed(6,blocklengths,displs,
1113 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1114 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1120 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1123 blocklengths(i)=blocklengths(i)*ichunk
1125 call MPI_Type_indexed(2,blocklengths,displs,
1126 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1127 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1133 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1136 blocklengths(i)=blocklengths(i)*ichunk
1138 call MPI_Type_indexed(4,blocklengths,displs,
1139 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1140 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1144 iint_start=ivec_start+1
1147 iint_count(i)=ivec_count(i)
1148 iint_displ(i)=ivec_displ(i)
1149 ivec_displ(i)=ivec_displ(i)-1
1150 iset_displ(i)=iset_displ(i)-1
1151 ithet_displ(i)=ithet_displ(i)-1
1152 iphi_displ(i)=iphi_displ(i)-1
1153 iphi1_displ(i)=iphi1_displ(i)-1
1154 ibond_displ(i)=ibond_displ(i)-1
1156 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1157 & .and. (me.eq.0 .or. .not. out1file)) then
1158 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1160 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1163 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1164 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1165 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1167 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1170 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1171 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1172 & ' SC-p interactions','were distributed among',nfgtasks,
1173 & ' fine-grain processors.'
1189 idihconstr_end=ndih_constr
1190 ithetaconstr_start=1
1191 ithetaconstr_end=ntheta_constr
1192 iphid_start=iphi_start
1193 iphid_end=iphi_end-1
1213 c---------------------------------------------------------------------------
1214 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1216 include "DIMENSIONS"
1217 include "COMMON.INTERACT"
1218 include "COMMON.SETUP"
1219 include "COMMON.IOUNITS"
1220 integer ii,jj,itask(4),ntask_cont_to,
1221 &itask_cont_to(0:max_fg_procs-1)
1223 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1224 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1225 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1226 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1227 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1228 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1229 & ielend_all(maxres,0:max_fg_procs-1)
1230 integer iproc,isent,k,l
1231 c Determines whether to send interaction ii,jj to other processors; a given
1232 c interaction can be sent to at most 2 processors.
1233 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1234 c one processor, otherwise flag is unchanged from the input value.
1240 c write (iout,*) "ii",ii," jj",jj
1241 c Loop over processors to check if anybody could need interaction ii,jj
1242 do iproc=0,fg_rank-1
1243 c Check if the interaction matches any turn3 at iproc
1244 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1246 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1247 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1249 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1252 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1253 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1256 call add_task(iproc,ntask_cont_to,itask_cont_to)
1260 C Check if the interaction matches any turn4 at iproc
1261 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1263 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1264 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1266 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1269 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1270 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1273 call add_task(iproc,ntask_cont_to,itask_cont_to)
1277 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1278 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1279 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1280 & ielend_all(ii-1,iproc).ge.jj-1) then
1282 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1283 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1286 call add_task(iproc,ntask_cont_to,itask_cont_to)
1289 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1290 & ielend_all(ii-1,iproc).ge.jj+1) then
1292 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1293 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1296 call add_task(iproc,ntask_cont_to,itask_cont_to)
1303 c---------------------------------------------------------------------------
1304 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1306 include "DIMENSIONS"
1307 include "COMMON.INTERACT"
1308 include "COMMON.SETUP"
1309 include "COMMON.IOUNITS"
1310 integer ii,jj,itask(2),ntask_cont_from,
1311 & itask_cont_from(0:max_fg_procs-1)
1313 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1314 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1315 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1316 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1317 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1318 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1319 & ielend_all(maxres,0:max_fg_procs-1)
1321 do iproc=fg_rank+1,nfgtasks-1
1322 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1324 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1325 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1327 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1328 call add_task(iproc,ntask_cont_from,itask_cont_from)
1331 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1333 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1334 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1336 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1337 call add_task(iproc,ntask_cont_from,itask_cont_from)
1340 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1341 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1343 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1344 & jj+1.le.ielend_all(ii+1,iproc)) then
1345 call add_task(iproc,ntask_cont_from,itask_cont_from)
1347 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1348 & jj-1.le.ielend_all(ii+1,iproc)) then
1349 call add_task(iproc,ntask_cont_from,itask_cont_from)
1352 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1354 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1355 & jj-1.le.ielend_all(ii-1,iproc)) then
1356 call add_task(iproc,ntask_cont_from,itask_cont_from)
1358 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1359 & jj+1.le.ielend_all(ii-1,iproc)) then
1360 call add_task(iproc,ntask_cont_from,itask_cont_from)
1367 c---------------------------------------------------------------------------
1368 subroutine add_task(iproc,ntask_cont,itask_cont)
1370 include "DIMENSIONS"
1371 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1374 if (itask_cont(ii).eq.iproc) return
1376 ntask_cont=ntask_cont+1
1377 itask_cont(ntask_cont)=iproc
1380 c---------------------------------------------------------------------------
1381 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1382 implicit real*8 (a-h,o-z)
1383 include 'DIMENSIONS'
1385 include 'COMMON.SETUP'
1386 integer total_ints,lower_bound,upper_bound
1387 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1388 nint=total_ints/nfgtasks
1392 nexcess=total_ints-nint*nfgtasks
1394 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1398 lower_bound=lower_bound+int4proc(i)
1400 upper_bound=lower_bound+int4proc(fg_rank)
1401 lower_bound=lower_bound+1
1404 c---------------------------------------------------------------------------
1405 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1409 include 'COMMON.SETUP'
1410 integer total_ints,lower_bound,upper_bound
1411 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1412 nint=total_ints/nfgtasks1
1416 nexcess=total_ints-nint*nfgtasks1
1418 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1422 lower_bound=lower_bound+int4proc(i)
1424 upper_bound=lower_bound+int4proc(fg_rank1)
1425 lower_bound=lower_bound+1
1428 c---------------------------------------------------------------------------
1429 subroutine int_partition(int_index,lower_index,upper_index,atom,
1430 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1431 implicit real*8 (a-h,o-z)
1432 include 'DIMENSIONS'
1433 include 'COMMON.IOUNITS'
1434 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1435 & first_atom,last_atom,int_gr,jat_start,jat_end
1438 if (lprn) write (iout,*) 'int_index=',int_index
1439 int_index_old=int_index
1440 int_index=int_index+last_atom-first_atom+1
1442 & write (iout,*) 'int_index=',int_index,
1443 & ' int_index_old',int_index_old,
1444 & ' lower_index=',lower_index,
1445 & ' upper_index=',upper_index,
1446 & ' atom=',atom,' first_atom=',first_atom,
1447 & ' last_atom=',last_atom
1448 if (int_index.ge.lower_index) then
1450 if (at_start.eq.0) then
1452 jat_start=first_atom-1+lower_index-int_index_old
1454 jat_start=first_atom
1456 if (lprn) write (iout,*) 'jat_start',jat_start
1457 if (int_index.ge.upper_index) then
1459 jat_end=first_atom-1+upper_index-int_index_old
1464 if (lprn) write (iout,*) 'jat_end',jat_end
1469 c------------------------------------------------------------------------------
1470 subroutine hpb_partition
1471 implicit real*8 (a-h,o-z)
1472 include 'DIMENSIONS'
1476 include 'COMMON.SBRIDGE'
1477 include 'COMMON.IOUNITS'
1478 include 'COMMON.SETUP'
1480 call int_bounds(nhpb,link_start,link_end)
1481 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1482 & ' absolute rank',MyRank,
1483 & ' nhpb',nhpb,' link_start=',link_start,
1484 & ' link_end',link_end