7 include 'COMMON.LANGEVIN.lang0.5diag'
9 include 'COMMON.LANGEVIN.lang0'
12 include 'COMMON.LANGEVIN'
15 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
17 c Conversion from poises to molecular unit and the gas constant
18 data cPoise /2.9361d0/, Rb /0.001986d0/
20 c--------------------------------------------------------------------------
23 C Define constants and zero out tables.
33 cMS$ATTRIBUTES C :: proc_proc
36 include 'COMMON.IOUNITS'
37 include 'COMMON.CHAIN'
38 include 'COMMON.INTERACT'
40 include 'COMMON.LOCAL'
41 include 'COMMON.TORSION'
42 include 'COMMON.FFIELD'
43 include 'COMMON.SBRIDGE'
45 include 'COMMON.MINIM'
46 include 'COMMON.DERIV'
47 include 'COMMON.SPLITELE'
50 c Common blocks from the diagonalization routines
51 integer IR,IW,IP,IJK,IPK,IDAF,NAV,IODA,KDIAG,ICORFL,IXDR
52 integer i,idumm,j,k,l,ichir1,ichir2,iblock,m
54 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
55 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
56 c real*8 text1 /'initial_i'/
77 C The following is just to define auxiliary variables used in angle conversion
116 crc for write_rmsbank1
118 cdr include secondary structure prediction bias
121 C CSA I/O units (separated from others especially for Jooyoung)
132 icsa_bank_reminimized=38
135 crc for ifc error 118
138 C Lipidic input file for parameters range 60-79
140 C input file for transfer sidechain and peptide group inside the
141 C lipidic environment if lipid is implicite
143 C DNA input files for parameters range 80-99
144 C Sugar input files for parameters range 100-119
145 C All-atom input files for parameters range 120-149
147 C Set default weights of the energy terms.
158 c print '(a,$)','Inside initialize'
159 c call memmon_print_usage()
194 athet(j,i,ichir1,ichir2)=0.0D0
195 bthet(j,i,ichir1,ichir2)=0.0D0
215 gaussc(l,k,j,i)=0.0D0
225 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
229 v1(k,j,i,iblock)=0.0D0
230 v2(k,j,i,iblock)=0.0D0
240 v1c(1,l,i,j,k,iblock)=0.0D0
241 v1s(1,l,i,j,k,iblock)=0.0D0
242 v1c(2,l,i,j,k,iblock)=0.0D0
243 v1s(2,l,i,j,k,iblock)=0.0D0
247 v2c(m,l,i,j,k,iblock)=0.0D0
248 v2s(m,l,i,j,k,iblock)=0.0D0
260 C Initialize the bridge arrays
274 C Initialize correlation arrays
305 C Initialize variables used in minimization.
314 C Initialize the variables responsible for the mode of gradient storage.
320 C Initialize constants used to split the energy into long- and short-range
326 nprint_ene=nprint_ene-1
330 c-------------------------------------------------------------------------
334 include 'COMMON.NAMES'
335 include 'COMMON.FFIELD'
337 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
338 & 'DSG','DGN','DSN','DTH',
339 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
340 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
341 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
344 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
345 &'a','y','w','v','l','i','f','m','c','x',
346 &'C','M','F','I','L','V','W','Y','A','G','T',
347 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
348 data potname /'LJ','LJK','BP','GB','GBV'/
351 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
353 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ",
354 !? 15 16 17 18 19 20 21
355 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
356 ! 22 23 24 25 26 27 28
357 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD",
359 3 "WDFAT","WDFAN","WDFAB"/
393 #if defined(SCP14) && defined(SPLITELE)
395 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
396 & 24,15,26,27,28,29,30,31,22,23,25,20/
399 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
400 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
401 #elif defined(SPLITELE)
403 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
404 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
407 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
408 & 24,15,26,27,28,29,30,31,22,23,25,20,2*0/
411 #if defined(SCP14) && defined(SPLITELE)
413 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
414 & 24,15,26,27,22,23,25,20,4*0/
417 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
418 & 24,15,26,27,22,23,25,20,5*0/
419 #elif defined(SPLITELE)
421 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
422 & 24,15,26,27,22,23,25,20,5*0/
425 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
426 & 24,15,26,27,22,23,25,20,6*0/
430 c---------------------------------------------------------------------------
431 subroutine init_int_table
437 integer blocklengths(15),displs(15)
439 include 'COMMON.CONTROL'
440 include 'COMMON.SAXS'
441 include 'COMMON.SETUP'
442 include 'COMMON.CHAIN'
443 include 'COMMON.INTERACT'
444 include 'COMMON.LOCAL'
445 include 'COMMON.SBRIDGE'
446 include 'COMMON.TORCNSTR'
447 include 'COMMON.IOUNITS'
448 include 'COMMON.DERIV'
450 include 'COMMON.CONTMAT'
452 include 'COMMON.CORRMAT'
453 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
454 & iturn4_end_all,iatel_s_all,
455 & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
456 & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all
457 integer*8 n_sc_int_tot,my_sc_inds,my_sc_inde,ind_scint,
458 & ind_scint_old,nele_int_tot,ind_eleint,my_ele_inds,my_ele_inde,
459 & ind_eleint_old,nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw,
460 & ind_eleint_vdw,ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,
461 & my_scp_inde,ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,
463 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
464 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
465 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
466 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
467 & ielend_all(maxres,0:max_fg_procs-1),
468 & ntask_cont_from_all(0:max_fg_procs-1),
469 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
470 & ntask_cont_to_all(0:max_fg_procs-1),
471 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
472 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
473 logical scheck,lprint,flag
474 integer i,j,k,ii,jj,iint,npept,
475 & ijunk,iaux,ind_typ,ncheck_from,ncheck_to,ichunk
477 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
478 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
479 C... Determine the numbers of start and end SC-SC interaction
480 C... to deal with by current processor.
483 itask_cont_from(i)=fg_rank
484 itask_cont_to(i)=fg_rank
489 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
490 n_sc_int_tot=int(nct-nnt+1,8)*int(nct-nnt,8)/2-nss
491 call int_bounds8(n_sc_int_tot,my_sc_inds,my_sc_inde)
493 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
494 & ' absolute rank',MyRank,
495 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
496 & ' my_sc_inde',my_sc_inde
516 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
517 cd & (ihpb(i),jhpb(i),i=1,nss)
522 if (ihpb(ii).eq.i+nres) then
529 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
533 c write (iout,*) 'jj=i+1'
534 call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
535 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
541 else if (jj.eq.nct) then
543 c write (iout,*) 'jj=nct'
544 call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
545 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
553 call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
554 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
556 call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
557 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
568 call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
569 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
574 ind_scint=ind_scint+nct-i
578 ind_scint_old=ind_scint
586 if (iatsc_s.eq.0) iatsc_s=1
588 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
589 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
592 write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
593 write (iout,'(a)') 'Interaction array:'
595 write (iout,'(i7,2(2x,2i7))')
596 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
601 C Now partition the electrostatic-interaction array
603 nele_int_tot=int(npept-ispp,8)*int(npept-ispp+1,8)/2
604 call int_bounds8(nele_int_tot,my_ele_inds,my_ele_inde)
606 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
607 & ' absolute rank',MyRank,
608 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
609 & ' my_ele_inde',my_ele_inde
616 call int_partition8(ind_eleint,my_ele_inds,my_ele_inde,i,
617 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
620 if (iatel_s.eq.0) iatel_s=1
621 nele_int_tot_vdw=int(npept-2,8)*int(npept-2+1,8)/2
622 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
623 call int_bounds8(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
624 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
625 c & " my_ele_inde_vdw",my_ele_inde_vdw
632 call int_partition8(ind_eleint_vdw,my_ele_inds_vdw,
634 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
636 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
637 c & " ielend_vdw",ielend_vdw(i)
639 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
650 do i=iatel_s_vdw,iatel_e_vdw
656 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
657 & ' absolute rank',MyRank
658 write (iout,*) 'Electrostatic interaction array:'
660 write (iout,'(i7,2(2x,2i7))') i,ielstart(i),ielend(i)
665 C Partition the SC-p interaction array
667 nscp_int_tot=int(npept-iscp+1,8)*int(npept-iscp+1,8)
668 call int_bounds8(nscp_int_tot,my_scp_inds,my_scp_inde)
669 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
670 & ' absolute rank',myrank,
671 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
672 & ' my_scp_inde',my_scp_inde
678 if (i.lt.nnt+iscp) then
679 cd write (iout,*) 'i.le.nnt+iscp'
680 call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
681 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
683 else if (i.gt.nct-iscp) then
684 cd write (iout,*) 'i.gt.nct-iscp'
685 call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
686 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
689 call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
690 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
693 call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
694 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
703 if (i.lt.nnt+iscp) then
705 iscpstart(i,1)=i+iscp
707 elseif (i.gt.nct-iscp) then
715 iscpstart(i,2)=i+iscp
720 if (iatscp_s.eq.0) iatscp_s=1
722 write (iout,'(a)') 'SC-p interaction array:'
723 do i=iatscp_s,iatscp_e
724 write (iout,'(i7,2(2x,2i7))')
725 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
728 C Partition local interactions
730 call int_bounds(nres-2,loc_start,loc_end)
731 loc_start=loc_start+1
733 call int_bounds(nres-2,ithet_start,ithet_end)
734 call int_bounds(nsaxs,isaxs_start,isaxs_end)
735 write (iout,*) me," isaxs_start",isaxs_start,
736 & " isaxs_end",isaxs_end
737 ithet_start=ithet_start+2
738 ithet_end=ithet_end+2
739 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
740 iturn3_start=iturn3_start+nnt
741 iphi_start=iturn3_start+2
742 iturn3_end=iturn3_end+nnt
743 iphi_end=iturn3_end+2
744 iturn3_start=iturn3_start-1
745 iturn3_end=iturn3_end-1
746 call int_bounds(nres-3,itau_start,itau_end)
747 itau_start=itau_start+3
749 call int_bounds(nres-3,iphi1_start,iphi1_end)
750 iphi1_start=iphi1_start+3
751 iphi1_end=iphi1_end+3
752 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
753 iturn4_start=iturn4_start+nnt
754 iphid_start=iturn4_start+2
755 iturn4_end=iturn4_end+nnt
756 iphid_end=iturn4_end+2
757 iturn4_start=iturn4_start-1
758 iturn4_end=iturn4_end-1
759 call int_bounds(nres-2,ibond_start,ibond_end)
760 ibond_start=ibond_start+1
761 ibond_end=ibond_end+1
762 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
763 ibondp_start=ibondp_start+nnt
764 ibondp_end=ibondp_end+nnt
765 call int_bounds(nres,ilip_start,ilip_end)
766 c ilip_start=ilip_start
767 call int_bounds1(nres-1,ivec_start,ivec_end)
768 c print *,"Processor",myrank,fg_rank,fg_rank1,
769 c & " ivec_start",ivec_start," ivec_end",ivec_end
770 iset_start=loc_start+2
772 if (ndih_constr.eq.0) then
776 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
778 if (ntheta_constr.eq.0) then
783 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
785 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
787 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
789 c call int_bounds(nsumgrad,ngrad_start,ngrad_end)
790 c igrad_start=((2*nlen+1)
791 c & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
792 c jgrad_start(igrad_start)=
793 c & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
795 c jgrad_end(igrad_start)=nres
796 c igrad_end=((2*nlen+1)
797 c & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
798 c if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
799 c jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
801 c do i=igrad_start+1,igrad_end-1
806 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
807 & ' absolute rank',myrank,
808 & ' loc_start',loc_start,' loc_end',loc_end,
809 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
810 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
811 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
812 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
813 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
814 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
815 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
816 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
817 & ' iset_start',iset_start,' iset_end',iset_end,
818 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
820 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
823 c write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
824 c & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
825 c & ' ngrad_end',ngrad_end
826 c do i=igrad_start,igrad_end
827 c write(*,*) 'Processor:',fg_rank,myrank,i,
828 c & jgrad_start(i),jgrad_end(i)
831 if (nfgtasks.gt.1) then
832 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
833 & MPI_INTEGER,FG_COMM1,IERROR)
834 iaux=ivec_end-ivec_start+1
835 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
836 & MPI_INTEGER,FG_COMM1,IERROR)
837 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
838 & MPI_INTEGER,FG_COMM,IERROR)
839 iaux=iset_end-iset_start+1
840 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
841 & MPI_INTEGER,FG_COMM,IERROR)
842 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
843 & MPI_INTEGER,FG_COMM,IERROR)
844 iaux=ibond_end-ibond_start+1
845 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
846 & MPI_INTEGER,FG_COMM,IERROR)
847 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
848 & MPI_INTEGER,FG_COMM,IERROR)
849 iaux=ithet_end-ithet_start+1
850 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
851 & MPI_INTEGER,FG_COMM,IERROR)
852 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
853 & MPI_INTEGER,FG_COMM,IERROR)
854 iaux=iphi_end-iphi_start+1
855 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
856 & MPI_INTEGER,FG_COMM,IERROR)
857 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
858 & MPI_INTEGER,FG_COMM,IERROR)
859 iaux=iphi1_end-iphi1_start+1
860 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
861 & MPI_INTEGER,FG_COMM,IERROR)
862 do i=0,max_fg_procs-1
868 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
869 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
870 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
871 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
872 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
873 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
874 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
875 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
876 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
877 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
878 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
879 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
880 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
881 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
882 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
883 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
885 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
886 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
887 write (iout,*) "iturn3_start_all",
888 & (iturn3_start_all(i),i=0,nfgtasks-1)
889 write (iout,*) "iturn3_end_all",
890 & (iturn3_end_all(i),i=0,nfgtasks-1)
891 write (iout,*) "iturn4_start_all",
892 & (iturn4_start_all(i),i=0,nfgtasks-1)
893 write (iout,*) "iturn4_end_all",
894 & (iturn4_end_all(i),i=0,nfgtasks-1)
895 write (iout,*) "The ielstart_all array"
897 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
899 write (iout,*) "The ielend_all array"
901 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
908 itask_cont_from(0)=fg_rank
909 itask_cont_to(0)=fg_rank
911 do ii=iturn3_start,iturn3_end
912 call add_int(ii,ii+2,iturn3_sent(1,ii),
913 & ntask_cont_to,itask_cont_to,flag)
915 do ii=iturn4_start,iturn4_end
916 call add_int(ii,ii+3,iturn4_sent(1,ii),
917 & ntask_cont_to,itask_cont_to,flag)
919 do ii=iturn3_start,iturn3_end
920 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
922 do ii=iturn4_start,iturn4_end
923 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
926 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
927 & " ntask_cont_to",ntask_cont_to
928 write (iout,*) "itask_cont_from",
929 & (itask_cont_from(i),i=1,ntask_cont_from)
930 write (iout,*) "itask_cont_to",
931 & (itask_cont_to(i),i=1,ntask_cont_to)
934 c write (iout,*) "Loop forward"
937 c write (iout,*) "from loop i=",i
939 do j=ielstart(i),ielend(i)
940 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
943 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
944 c & " iatel_e",iatel_e
948 c write (iout,*) "i",i," ielstart",ielstart(i),
949 c & " ielend",ielend(i)
952 do j=ielstart(i),ielend(i)
953 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
954 & itask_cont_to,flag)
962 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
963 & " ntask_cont_to",ntask_cont_to
964 write (iout,*) "itask_cont_from",
965 & (itask_cont_from(i),i=1,ntask_cont_from)
966 write (iout,*) "itask_cont_to",
967 & (itask_cont_to(i),i=1,ntask_cont_to)
969 write (iout,*) "iint_sent"
972 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
973 & j=ielstart(ii),ielend(ii))
975 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
976 & " iturn3_end",iturn3_end
977 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
978 & i=iturn3_start,iturn3_end)
979 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
980 & " iturn4_end",iturn4_end
981 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
982 & i=iturn4_start,iturn4_end)
985 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
986 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
987 c write (iout,*) "Gather ntask_cont_from ended"
989 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
990 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
992 c write (iout,*) "Gather itask_cont_from ended"
994 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
995 & 1,MPI_INTEGER,king,FG_COMM,IERR)
996 c write (iout,*) "Gather ntask_cont_to ended"
998 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
999 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
1000 c write (iout,*) "Gather itask_cont_to ended"
1002 if (fg_rank.eq.king) then
1003 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
1005 write (iout,'(20i4)') i,ntask_cont_from_all(i),
1006 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
1010 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
1012 write (iout,'(20i4)') i,ntask_cont_to_all(i),
1013 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1017 C Check if every send will have a matching receive
1021 ncheck_to=ncheck_to+ntask_cont_to_all(i)
1022 ncheck_from=ncheck_from+ntask_cont_from_all(i)
1024 write (iout,*) "Control sums",ncheck_from,ncheck_to
1025 if (ncheck_from.ne.ncheck_to) then
1026 write (iout,*) "Error: #receive differs from #send."
1027 write (iout,*) "Terminating program...!"
1033 do j=1,ntask_cont_to_all(i)
1034 ii=itask_cont_to_all(j,i)
1035 do k=1,ntask_cont_from_all(ii)
1036 if (itask_cont_from_all(k,ii).eq.i) then
1037 if(lprint)write(iout,*)"Matching send/receive",i,ii
1041 if (k.eq.ntask_cont_from_all(ii)+1) then
1043 write (iout,*) "Error: send by",j," to",ii,
1044 & " would have no matching receive"
1050 write (iout,*) "Unmatched sends; terminating program"
1054 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1055 c write (iout,*) "flag broadcast ended flag=",flag
1058 call MPI_Finalize(IERROR)
1059 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1061 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1062 c write (iout,*) "MPI_Comm_group ended"
1064 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1065 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1066 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1067 & CONT_TO_GROUP,IERR)
1070 iaux=4*(ielend(ii)-ielstart(ii)+1)
1071 call MPI_Group_translate_ranks(fg_group,iaux,
1072 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1073 & iint_sent_local(1,ielstart(ii),i),IERR )
1074 c write (iout,*) "Ranks translated i=",i
1077 iaux=4*(iturn3_end-iturn3_start+1)
1078 call MPI_Group_translate_ranks(fg_group,iaux,
1079 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1080 & iturn3_sent_local(1,iturn3_start),IERR)
1081 iaux=4*(iturn4_end-iturn4_start+1)
1082 call MPI_Group_translate_ranks(fg_group,iaux,
1083 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1084 & iturn4_sent_local(1,iturn4_start),IERR)
1086 write (iout,*) "iint_sent_local"
1089 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1090 & j=ielstart(ii),ielend(ii))
1093 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1094 & " iturn3_end",iturn3_end
1095 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1096 & i=iturn3_start,iturn3_end)
1097 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1098 & " iturn4_end",iturn4_end
1099 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1100 & i=iturn4_start,iturn4_end)
1103 call MPI_Group_free(fg_group,ierr)
1104 call MPI_Group_free(cont_from_group,ierr)
1105 call MPI_Group_free(cont_to_group,ierr)
1107 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1108 call MPI_Type_commit(MPI_UYZ,IERROR)
1109 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1111 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1112 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1113 call MPI_Type_commit(MPI_MU,IERROR)
1114 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1115 call MPI_Type_commit(MPI_MAT1,IERROR)
1116 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1117 call MPI_Type_commit(MPI_MAT2,IERROR)
1118 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1119 call MPI_Type_commit(MPI_THET,IERROR)
1120 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1121 call MPI_Type_commit(MPI_GAM,IERROR)
1123 c 9/22/08 Derived types to send matrices which appear in correlation terms
1125 if (ivec_count(i).eq.ivec_count(0)) then
1131 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1132 if (ind_typ.eq.0) then
1133 ichunk=ivec_count(0)
1135 ichunk=ivec_count(1)
1142 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1145 c blocklengths(i)=blocklengths(i)*ichunk
1147 c write (iout,*) "blocklengths and displs"
1149 c write (iout,*) i,blocklengths(i),displs(i)
1152 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1153 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1154 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1155 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1161 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1164 c blocklengths(i)=blocklengths(i)*ichunk
1166 c write (iout,*) "blocklengths and displs"
1168 c write (iout,*) i,blocklengths(i),displs(i)
1171 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1172 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1173 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1174 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1180 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1183 blocklengths(i)=blocklengths(i)*ichunk
1185 call MPI_Type_indexed(8,blocklengths,displs,
1186 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1187 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1193 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1196 blocklengths(i)=blocklengths(i)*ichunk
1198 call MPI_Type_indexed(8,blocklengths,displs,
1199 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1200 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1206 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1209 blocklengths(i)=blocklengths(i)*ichunk
1211 call MPI_Type_indexed(6,blocklengths,displs,
1212 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1213 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1219 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1222 blocklengths(i)=blocklengths(i)*ichunk
1224 call MPI_Type_indexed(2,blocklengths,displs,
1225 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1226 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1232 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1235 blocklengths(i)=blocklengths(i)*ichunk
1237 call MPI_Type_indexed(4,blocklengths,displs,
1238 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1239 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1243 iint_start=ivec_start+1
1246 iint_count(i)=ivec_count(i)
1247 iint_displ(i)=ivec_displ(i)
1248 ivec_displ(i)=ivec_displ(i)-1
1249 iset_displ(i)=iset_displ(i)-1
1250 ithet_displ(i)=ithet_displ(i)-1
1251 iphi_displ(i)=iphi_displ(i)-1
1252 iphi1_displ(i)=iphi1_displ(i)-1
1253 ibond_displ(i)=ibond_displ(i)-1
1255 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1256 & .and. (me.eq.0 .or. .not. out1file)) then
1257 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1259 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1262 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1263 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1264 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1266 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1269 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1270 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1271 & ' SC-p interactions','were distributed among',nfgtasks,
1272 & ' fine-grain processors.'
1288 idihconstr_end=ndih_constr
1289 ithetaconstr_start=1
1290 ithetaconstr_end=ntheta_constr
1291 iphid_start=iphi_start
1292 iphid_end=iphi_end-1
1314 c---------------------------------------------------------------------------
1315 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1317 include "DIMENSIONS"
1318 include "COMMON.INTERACT"
1319 include "COMMON.SETUP"
1320 include "COMMON.IOUNITS"
1321 integer ii,jj,itask(4),ntask_cont_to,
1322 &itask_cont_to(0:max_fg_procs-1)
1324 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1325 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1326 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1327 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1328 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1329 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1330 & ielend_all(maxres,0:max_fg_procs-1)
1331 integer iproc,isent,k,l
1332 c Determines whether to send interaction ii,jj to other processors; a given
1333 c interaction can be sent to at most 2 processors.
1334 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1335 c one processor, otherwise flag is unchanged from the input value.
1341 c write (iout,*) "ii",ii," jj",jj
1342 c Loop over processors to check if anybody could need interaction ii,jj
1343 do iproc=0,fg_rank-1
1344 c Check if the interaction matches any turn3 at iproc
1345 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1347 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1348 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1350 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1353 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1354 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1357 call add_task(iproc,ntask_cont_to,itask_cont_to)
1361 C Check if the interaction matches any turn4 at iproc
1362 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1364 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1365 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1367 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1370 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1371 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1374 call add_task(iproc,ntask_cont_to,itask_cont_to)
1378 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1379 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1380 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1381 & ielend_all(ii-1,iproc).ge.jj-1) then
1383 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1384 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1387 call add_task(iproc,ntask_cont_to,itask_cont_to)
1390 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1391 & ielend_all(ii-1,iproc).ge.jj+1) then
1393 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1394 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1397 call add_task(iproc,ntask_cont_to,itask_cont_to)
1404 c---------------------------------------------------------------------------
1405 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1407 include "DIMENSIONS"
1408 include "COMMON.INTERACT"
1409 include "COMMON.SETUP"
1410 include "COMMON.IOUNITS"
1411 integer ii,jj,itask(2),ntask_cont_from,
1412 & itask_cont_from(0:max_fg_procs-1)
1414 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1415 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1416 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1417 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1418 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1419 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1420 & ielend_all(maxres,0:max_fg_procs-1)
1422 do iproc=fg_rank+1,nfgtasks-1
1423 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1425 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1426 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1428 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1429 call add_task(iproc,ntask_cont_from,itask_cont_from)
1432 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1434 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1435 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1437 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1438 call add_task(iproc,ntask_cont_from,itask_cont_from)
1441 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1442 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1444 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1445 & jj+1.le.ielend_all(ii+1,iproc)) then
1446 call add_task(iproc,ntask_cont_from,itask_cont_from)
1448 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1449 & jj-1.le.ielend_all(ii+1,iproc)) then
1450 call add_task(iproc,ntask_cont_from,itask_cont_from)
1453 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1455 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1456 & jj-1.le.ielend_all(ii-1,iproc)) then
1457 call add_task(iproc,ntask_cont_from,itask_cont_from)
1459 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1460 & jj+1.le.ielend_all(ii-1,iproc)) then
1461 call add_task(iproc,ntask_cont_from,itask_cont_from)
1468 c---------------------------------------------------------------------------
1469 subroutine add_task(iproc,ntask_cont,itask_cont)
1471 include "DIMENSIONS"
1472 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1475 if (itask_cont(ii).eq.iproc) return
1477 ntask_cont=ntask_cont+1
1478 itask_cont(ntask_cont)=iproc
1481 c---------------------------------------------------------------------------
1482 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1484 include 'DIMENSIONS'
1486 include 'COMMON.SETUP'
1487 integer total_ints,lower_bound,upper_bound
1488 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1489 integer i,nint,nexcess
1490 nint=total_ints/nfgtasks
1494 nexcess=total_ints-nint*nfgtasks
1496 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1500 lower_bound=lower_bound+int4proc(i)
1502 upper_bound=lower_bound+int4proc(fg_rank)
1503 lower_bound=lower_bound+1
1506 c---------------------------------------------------------------------------
1507 subroutine int_bounds8(total_ints,lower_bound,upper_bound)
1509 include 'DIMENSIONS'
1511 include 'COMMON.SETUP'
1512 integer*8 total_ints,lower_bound,upper_bound,nint
1513 integer*8 int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1515 nint=total_ints/nfgtasks
1519 nexcess=total_ints-nint*nfgtasks
1521 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1525 lower_bound=lower_bound+int4proc(i)
1527 upper_bound=lower_bound+int4proc(fg_rank)
1528 lower_bound=lower_bound+1
1531 c---------------------------------------------------------------------------
1532 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1534 include 'DIMENSIONS'
1536 include 'COMMON.SETUP'
1537 integer total_ints,lower_bound,upper_bound
1538 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1539 integer i,nint,nexcess
1540 nint=total_ints/nfgtasks1
1544 nexcess=total_ints-nint*nfgtasks1
1546 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1550 lower_bound=lower_bound+int4proc(i)
1552 upper_bound=lower_bound+int4proc(fg_rank1)
1553 lower_bound=lower_bound+1
1556 c---------------------------------------------------------------------------
1557 subroutine int_partition(int_index,lower_index,upper_index,atom,
1558 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1560 include 'DIMENSIONS'
1561 include 'COMMON.IOUNITS'
1562 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1563 & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1566 if (lprn) write (iout,*) 'int_index=',int_index
1567 int_index_old=int_index
1568 int_index=int_index+last_atom-first_atom+1
1570 & write (iout,*) 'int_index=',int_index,
1571 & ' int_index_old',int_index_old,
1572 & ' lower_index=',lower_index,
1573 & ' upper_index=',upper_index,
1574 & ' atom=',atom,' first_atom=',first_atom,
1575 & ' last_atom=',last_atom
1576 if (int_index.ge.lower_index) then
1578 if (at_start.eq.0) then
1580 jat_start=first_atom-1+lower_index-int_index_old
1582 jat_start=first_atom
1584 if (lprn) write (iout,*) 'jat_start',jat_start
1585 if (int_index.ge.upper_index) then
1587 jat_end=first_atom-1+upper_index-int_index_old
1592 if (lprn) write (iout,*) 'jat_end',jat_end
1596 c---------------------------------------------------------------------------
1597 subroutine int_partition8(int_index,lower_index,upper_index,atom,
1598 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1600 include 'DIMENSIONS'
1601 include 'COMMON.IOUNITS'
1602 integer*8 int_index,lower_index,upper_index
1603 integer atom,at_start,at_end,
1604 & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1607 if (lprn) write (iout,*) 'int_index=',int_index
1608 int_index_old=int_index
1609 int_index=int_index+last_atom-first_atom+1
1611 & write (iout,*) 'int_index=',int_index,
1612 & ' int_index_old',int_index_old,
1613 & ' lower_index=',lower_index,
1614 & ' upper_index=',upper_index,
1615 & ' atom=',atom,' first_atom=',first_atom,
1616 & ' last_atom=',last_atom
1617 if (int_index.ge.lower_index) then
1619 if (at_start.eq.0) then
1621 jat_start=first_atom-1+lower_index-int_index_old
1623 jat_start=first_atom
1625 if (lprn) write (iout,*) 'jat_start',jat_start
1626 if (int_index.ge.upper_index) then
1628 jat_end=first_atom-1+upper_index-int_index_old
1633 if (lprn) write (iout,*) 'jat_end',jat_end
1638 c------------------------------------------------------------------------------
1639 subroutine hpb_partition
1641 include 'DIMENSIONS'
1645 include 'COMMON.SBRIDGE'
1646 include 'COMMON.IOUNITS'
1647 include 'COMMON.SETUP'
1649 call int_bounds(nhpb,link_start,link_end)
1650 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1651 & ' absolute rank',MyRank,
1652 & ' nhpb',nhpb,' link_start=',link_start,
1653 & ' link_end',link_end
1660 c------------------------------------------------------------------------------
1661 subroutine homology_partition
1663 include 'DIMENSIONS'
1667 include 'COMMON.SBRIDGE'
1668 include 'COMMON.IOUNITS'
1669 include 'COMMON.SETUP'
1670 include 'COMMON.CONTROL'
1671 include 'COMMON.INTERACT'
1672 include 'COMMON.HOMOLOGY'
1673 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1674 cd & " lim_dih",lim_dih
1676 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1677 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1678 call int_bounds(lim_dih,idihconstr_start_homo,
1679 & idihconstr_end_homo)
1680 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1681 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1682 if (me.eq.king .or. .not. out1file)
1683 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1684 & ' absolute rank',MyRank,
1685 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1686 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1687 & ' idihconstr_start_homo',idihconstr_start_homo,
1688 & ' idihconstr_end_homo',idihconstr_end_homo
1690 write (iout,*) "Not MPI"
1692 link_end_homo=lim_odl
1693 idihconstr_start_homo=nnt+3
1694 idihconstr_end_homo=lim_dih+nnt-1+3
1696 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1697 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1698 & ' idihconstr_start_homo',idihconstr_start_homo,
1699 & ' idihconstr_end_homo',idihconstr_end_homo
1703 c------------------------------------------------------------------------------
1704 subroutine NMRpeak_partition
1706 include 'DIMENSIONS'
1710 include 'COMMON.SBRIDGE'
1711 include 'COMMON.IOUNITS'
1712 include 'COMMON.SETUP'
1714 call int_bounds(npeak,link_start_peak,link_end_peak)
1715 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1716 & ' absolute rank',MyRank,
1717 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1718 & ' link_end_peak',link_end_peak