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'
449 include 'COMMON.CORRMAT'
450 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
451 & iturn4_end_all,iatel_s_all,
452 & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
453 & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all,
454 & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
455 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
456 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
457 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
458 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
459 & ielend_all(maxres,0:max_fg_procs-1),
460 & ntask_cont_from_all(0:max_fg_procs-1),
461 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
462 & ntask_cont_to_all(0:max_fg_procs-1),
463 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
464 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
465 logical scheck,lprint,flag
466 integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint,
467 & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
468 & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
469 & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
470 & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
471 & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
473 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
474 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
475 C... Determine the numbers of start and end SC-SC interaction
476 C... to deal with by current processor.
479 itask_cont_from(i)=fg_rank
480 itask_cont_to(i)=fg_rank
485 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
486 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
487 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
489 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
490 & ' absolute rank',MyRank,
491 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
492 & ' my_sc_inde',my_sc_inde
512 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
513 cd & (ihpb(i),jhpb(i),i=1,nss)
518 if (ihpb(ii).eq.i+nres) then
525 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
529 c write (iout,*) 'jj=i+1'
530 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
531 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
537 else if (jj.eq.nct) then
539 c write (iout,*) 'jj=nct'
540 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
541 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
549 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
550 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
552 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
553 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
564 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
565 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
570 ind_scint=ind_scint+nct-i
574 ind_scint_old=ind_scint
582 if (iatsc_s.eq.0) iatsc_s=1
584 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
585 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
588 write (iout,'(a)') 'Interaction array:'
590 write (iout,'(i3,2(2x,2i3))')
591 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
596 C Now partition the electrostatic-interaction array
598 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
599 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
601 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
602 & ' absolute rank',MyRank,
603 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
604 & ' my_ele_inde',my_ele_inde
611 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
612 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
615 if (iatel_s.eq.0) iatel_s=1
616 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
617 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
618 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
619 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
620 c & " my_ele_inde_vdw",my_ele_inde_vdw
627 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
629 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
631 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
632 c & " ielend_vdw",ielend_vdw(i)
634 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
645 do i=iatel_s_vdw,iatel_e_vdw
651 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
652 & ' absolute rank',MyRank
653 write (iout,*) 'Electrostatic interaction array:'
655 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
660 C Partition the SC-p interaction array
662 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
663 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
664 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
665 & ' absolute rank',myrank,
666 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
667 & ' my_scp_inde',my_scp_inde
673 if (i.lt.nnt+iscp) then
674 cd write (iout,*) 'i.le.nnt+iscp'
675 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
676 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
678 else if (i.gt.nct-iscp) then
679 cd write (iout,*) 'i.gt.nct-iscp'
680 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
681 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
684 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
685 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
688 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
689 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
698 if (i.lt.nnt+iscp) then
700 iscpstart(i,1)=i+iscp
702 elseif (i.gt.nct-iscp) then
710 iscpstart(i,2)=i+iscp
715 if (iatscp_s.eq.0) iatscp_s=1
717 write (iout,'(a)') 'SC-p interaction array:'
718 do i=iatscp_s,iatscp_e
719 write (iout,'(i3,2(2x,2i3))')
720 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
723 C Partition local interactions
725 call int_bounds(nres-2,loc_start,loc_end)
726 loc_start=loc_start+1
728 call int_bounds(nres-2,ithet_start,ithet_end)
729 call int_bounds(nsaxs,isaxs_start,isaxs_end)
730 write (iout,*) me," isaxs_start",isaxs_start,
731 & " isaxs_end",isaxs_end
732 ithet_start=ithet_start+2
733 ithet_end=ithet_end+2
734 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
735 iturn3_start=iturn3_start+nnt
736 iphi_start=iturn3_start+2
737 iturn3_end=iturn3_end+nnt
738 iphi_end=iturn3_end+2
739 iturn3_start=iturn3_start-1
740 iturn3_end=iturn3_end-1
741 call int_bounds(nres-3,itau_start,itau_end)
742 itau_start=itau_start+3
744 call int_bounds(nres-3,iphi1_start,iphi1_end)
745 iphi1_start=iphi1_start+3
746 iphi1_end=iphi1_end+3
747 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
748 iturn4_start=iturn4_start+nnt
749 iphid_start=iturn4_start+2
750 iturn4_end=iturn4_end+nnt
751 iphid_end=iturn4_end+2
752 iturn4_start=iturn4_start-1
753 iturn4_end=iturn4_end-1
754 call int_bounds(nres-2,ibond_start,ibond_end)
755 ibond_start=ibond_start+1
756 ibond_end=ibond_end+1
757 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
758 ibondp_start=ibondp_start+nnt
759 ibondp_end=ibondp_end+nnt
760 call int_bounds(nres,ilip_start,ilip_end)
761 c ilip_start=ilip_start
762 call int_bounds1(nres-1,ivec_start,ivec_end)
763 c print *,"Processor",myrank,fg_rank,fg_rank1,
764 c & " ivec_start",ivec_start," ivec_end",ivec_end
765 iset_start=loc_start+2
767 if (ndih_constr.eq.0) then
771 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
773 if (ntheta_constr.eq.0) then
778 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
780 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
782 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
784 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
785 igrad_start=((2*nlen+1)
786 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
787 jgrad_start(igrad_start)=
788 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
790 jgrad_end(igrad_start)=nres
791 igrad_end=((2*nlen+1)
792 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
793 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
794 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
796 do i=igrad_start+1,igrad_end-1
801 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
802 & ' absolute rank',myrank,
803 & ' loc_start',loc_start,' loc_end',loc_end,
804 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
805 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
806 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
807 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
808 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
809 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
810 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
811 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
812 & ' iset_start',iset_start,' iset_end',iset_end,
813 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
815 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
818 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
819 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
820 & ' ngrad_end',ngrad_end
821 do i=igrad_start,igrad_end
822 write(*,*) 'Processor:',fg_rank,myrank,i,
823 & jgrad_start(i),jgrad_end(i)
826 if (nfgtasks.gt.1) then
827 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
828 & MPI_INTEGER,FG_COMM1,IERROR)
829 iaux=ivec_end-ivec_start+1
830 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
831 & MPI_INTEGER,FG_COMM1,IERROR)
832 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
833 & MPI_INTEGER,FG_COMM,IERROR)
834 iaux=iset_end-iset_start+1
835 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
836 & MPI_INTEGER,FG_COMM,IERROR)
837 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
838 & MPI_INTEGER,FG_COMM,IERROR)
839 iaux=ibond_end-ibond_start+1
840 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
841 & MPI_INTEGER,FG_COMM,IERROR)
842 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
843 & MPI_INTEGER,FG_COMM,IERROR)
844 iaux=ithet_end-ithet_start+1
845 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
846 & MPI_INTEGER,FG_COMM,IERROR)
847 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
848 & MPI_INTEGER,FG_COMM,IERROR)
849 iaux=iphi_end-iphi_start+1
850 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
851 & MPI_INTEGER,FG_COMM,IERROR)
852 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
853 & MPI_INTEGER,FG_COMM,IERROR)
854 iaux=iphi1_end-iphi1_start+1
855 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
856 & MPI_INTEGER,FG_COMM,IERROR)
857 do i=0,max_fg_procs-1
863 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
864 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
865 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
866 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
867 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
868 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
869 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
870 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
871 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
872 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
873 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
874 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
875 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
876 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
877 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
878 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
880 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
881 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
882 write (iout,*) "iturn3_start_all",
883 & (iturn3_start_all(i),i=0,nfgtasks-1)
884 write (iout,*) "iturn3_end_all",
885 & (iturn3_end_all(i),i=0,nfgtasks-1)
886 write (iout,*) "iturn4_start_all",
887 & (iturn4_start_all(i),i=0,nfgtasks-1)
888 write (iout,*) "iturn4_end_all",
889 & (iturn4_end_all(i),i=0,nfgtasks-1)
890 write (iout,*) "The ielstart_all array"
892 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
894 write (iout,*) "The ielend_all array"
896 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
903 itask_cont_from(0)=fg_rank
904 itask_cont_to(0)=fg_rank
906 do ii=iturn3_start,iturn3_end
907 call add_int(ii,ii+2,iturn3_sent(1,ii),
908 & ntask_cont_to,itask_cont_to,flag)
910 do ii=iturn4_start,iturn4_end
911 call add_int(ii,ii+3,iturn4_sent(1,ii),
912 & ntask_cont_to,itask_cont_to,flag)
914 do ii=iturn3_start,iturn3_end
915 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
917 do ii=iturn4_start,iturn4_end
918 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
921 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
922 & " ntask_cont_to",ntask_cont_to
923 write (iout,*) "itask_cont_from",
924 & (itask_cont_from(i),i=1,ntask_cont_from)
925 write (iout,*) "itask_cont_to",
926 & (itask_cont_to(i),i=1,ntask_cont_to)
929 c write (iout,*) "Loop forward"
932 c write (iout,*) "from loop i=",i
934 do j=ielstart(i),ielend(i)
935 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
938 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
939 c & " iatel_e",iatel_e
943 c write (iout,*) "i",i," ielstart",ielstart(i),
944 c & " ielend",ielend(i)
947 do j=ielstart(i),ielend(i)
948 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
949 & itask_cont_to,flag)
957 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
958 & " ntask_cont_to",ntask_cont_to
959 write (iout,*) "itask_cont_from",
960 & (itask_cont_from(i),i=1,ntask_cont_from)
961 write (iout,*) "itask_cont_to",
962 & (itask_cont_to(i),i=1,ntask_cont_to)
964 write (iout,*) "iint_sent"
967 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
968 & j=ielstart(ii),ielend(ii))
970 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
971 & " iturn3_end",iturn3_end
972 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
973 & i=iturn3_start,iturn3_end)
974 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
975 & " iturn4_end",iturn4_end
976 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
977 & i=iturn4_start,iturn4_end)
980 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
981 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
982 c write (iout,*) "Gather ntask_cont_from ended"
984 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
985 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
987 c write (iout,*) "Gather itask_cont_from ended"
989 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
990 & 1,MPI_INTEGER,king,FG_COMM,IERR)
991 c write (iout,*) "Gather ntask_cont_to ended"
993 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
994 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
995 c write (iout,*) "Gather itask_cont_to ended"
997 if (fg_rank.eq.king) then
998 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
1000 write (iout,'(20i4)') i,ntask_cont_from_all(i),
1001 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
1005 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
1007 write (iout,'(20i4)') i,ntask_cont_to_all(i),
1008 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1012 C Check if every send will have a matching receive
1016 ncheck_to=ncheck_to+ntask_cont_to_all(i)
1017 ncheck_from=ncheck_from+ntask_cont_from_all(i)
1019 write (iout,*) "Control sums",ncheck_from,ncheck_to
1020 if (ncheck_from.ne.ncheck_to) then
1021 write (iout,*) "Error: #receive differs from #send."
1022 write (iout,*) "Terminating program...!"
1028 do j=1,ntask_cont_to_all(i)
1029 ii=itask_cont_to_all(j,i)
1030 do k=1,ntask_cont_from_all(ii)
1031 if (itask_cont_from_all(k,ii).eq.i) then
1032 if(lprint)write(iout,*)"Matching send/receive",i,ii
1036 if (k.eq.ntask_cont_from_all(ii)+1) then
1038 write (iout,*) "Error: send by",j," to",ii,
1039 & " would have no matching receive"
1045 write (iout,*) "Unmatched sends; terminating program"
1049 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1050 c write (iout,*) "flag broadcast ended flag=",flag
1053 call MPI_Finalize(IERROR)
1054 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1056 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1057 c write (iout,*) "MPI_Comm_group ended"
1059 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1060 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1061 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1062 & CONT_TO_GROUP,IERR)
1065 iaux=4*(ielend(ii)-ielstart(ii)+1)
1066 call MPI_Group_translate_ranks(fg_group,iaux,
1067 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1068 & iint_sent_local(1,ielstart(ii),i),IERR )
1069 c write (iout,*) "Ranks translated i=",i
1072 iaux=4*(iturn3_end-iturn3_start+1)
1073 call MPI_Group_translate_ranks(fg_group,iaux,
1074 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1075 & iturn3_sent_local(1,iturn3_start),IERR)
1076 iaux=4*(iturn4_end-iturn4_start+1)
1077 call MPI_Group_translate_ranks(fg_group,iaux,
1078 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1079 & iturn4_sent_local(1,iturn4_start),IERR)
1081 write (iout,*) "iint_sent_local"
1084 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1085 & j=ielstart(ii),ielend(ii))
1088 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1089 & " iturn3_end",iturn3_end
1090 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1091 & i=iturn3_start,iturn3_end)
1092 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1093 & " iturn4_end",iturn4_end
1094 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1095 & i=iturn4_start,iturn4_end)
1098 call MPI_Group_free(fg_group,ierr)
1099 call MPI_Group_free(cont_from_group,ierr)
1100 call MPI_Group_free(cont_to_group,ierr)
1102 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1103 call MPI_Type_commit(MPI_UYZ,IERROR)
1104 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1106 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1107 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1108 call MPI_Type_commit(MPI_MU,IERROR)
1109 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1110 call MPI_Type_commit(MPI_MAT1,IERROR)
1111 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1112 call MPI_Type_commit(MPI_MAT2,IERROR)
1113 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1114 call MPI_Type_commit(MPI_THET,IERROR)
1115 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1116 call MPI_Type_commit(MPI_GAM,IERROR)
1118 c 9/22/08 Derived types to send matrices which appear in correlation terms
1120 if (ivec_count(i).eq.ivec_count(0)) then
1126 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1127 if (ind_typ.eq.0) then
1128 ichunk=ivec_count(0)
1130 ichunk=ivec_count(1)
1137 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1140 c blocklengths(i)=blocklengths(i)*ichunk
1142 c write (iout,*) "blocklengths and displs"
1144 c write (iout,*) i,blocklengths(i),displs(i)
1147 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1148 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1149 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1150 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1156 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1159 c blocklengths(i)=blocklengths(i)*ichunk
1161 c write (iout,*) "blocklengths and displs"
1163 c write (iout,*) i,blocklengths(i),displs(i)
1166 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1167 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1168 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1169 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1175 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1178 blocklengths(i)=blocklengths(i)*ichunk
1180 call MPI_Type_indexed(8,blocklengths,displs,
1181 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1182 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1188 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1191 blocklengths(i)=blocklengths(i)*ichunk
1193 call MPI_Type_indexed(8,blocklengths,displs,
1194 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1195 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1201 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1204 blocklengths(i)=blocklengths(i)*ichunk
1206 call MPI_Type_indexed(6,blocklengths,displs,
1207 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1208 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1214 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1217 blocklengths(i)=blocklengths(i)*ichunk
1219 call MPI_Type_indexed(2,blocklengths,displs,
1220 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1221 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1227 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1230 blocklengths(i)=blocklengths(i)*ichunk
1232 call MPI_Type_indexed(4,blocklengths,displs,
1233 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1234 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1238 iint_start=ivec_start+1
1241 iint_count(i)=ivec_count(i)
1242 iint_displ(i)=ivec_displ(i)
1243 ivec_displ(i)=ivec_displ(i)-1
1244 iset_displ(i)=iset_displ(i)-1
1245 ithet_displ(i)=ithet_displ(i)-1
1246 iphi_displ(i)=iphi_displ(i)-1
1247 iphi1_displ(i)=iphi1_displ(i)-1
1248 ibond_displ(i)=ibond_displ(i)-1
1250 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1251 & .and. (me.eq.0 .or. .not. out1file)) then
1252 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1254 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1257 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1258 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1259 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1261 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1264 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1265 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1266 & ' SC-p interactions','were distributed among',nfgtasks,
1267 & ' fine-grain processors.'
1283 idihconstr_end=ndih_constr
1284 ithetaconstr_start=1
1285 ithetaconstr_end=ntheta_constr
1286 iphid_start=iphi_start
1287 iphid_end=iphi_end-1
1309 c---------------------------------------------------------------------------
1310 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1312 include "DIMENSIONS"
1313 include "COMMON.INTERACT"
1314 include "COMMON.SETUP"
1315 include "COMMON.IOUNITS"
1316 integer ii,jj,itask(4),ntask_cont_to,
1317 &itask_cont_to(0:max_fg_procs-1)
1319 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1320 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1321 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1322 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1323 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1324 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1325 & ielend_all(maxres,0:max_fg_procs-1)
1326 integer iproc,isent,k,l
1327 c Determines whether to send interaction ii,jj to other processors; a given
1328 c interaction can be sent to at most 2 processors.
1329 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1330 c one processor, otherwise flag is unchanged from the input value.
1336 c write (iout,*) "ii",ii," jj",jj
1337 c Loop over processors to check if anybody could need interaction ii,jj
1338 do iproc=0,fg_rank-1
1339 c Check if the interaction matches any turn3 at iproc
1340 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1342 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1343 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1345 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1348 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1349 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1352 call add_task(iproc,ntask_cont_to,itask_cont_to)
1356 C Check if the interaction matches any turn4 at iproc
1357 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1359 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1360 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1362 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1365 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1366 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1369 call add_task(iproc,ntask_cont_to,itask_cont_to)
1373 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1374 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1375 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1376 & ielend_all(ii-1,iproc).ge.jj-1) then
1378 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1379 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1382 call add_task(iproc,ntask_cont_to,itask_cont_to)
1385 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1386 & ielend_all(ii-1,iproc).ge.jj+1) then
1388 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1389 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1392 call add_task(iproc,ntask_cont_to,itask_cont_to)
1399 c---------------------------------------------------------------------------
1400 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1402 include "DIMENSIONS"
1403 include "COMMON.INTERACT"
1404 include "COMMON.SETUP"
1405 include "COMMON.IOUNITS"
1406 integer ii,jj,itask(2),ntask_cont_from,
1407 & itask_cont_from(0:max_fg_procs-1)
1409 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1410 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1411 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1412 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1413 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1414 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1415 & ielend_all(maxres,0:max_fg_procs-1)
1417 do iproc=fg_rank+1,nfgtasks-1
1418 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1420 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1421 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1423 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1424 call add_task(iproc,ntask_cont_from,itask_cont_from)
1427 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1429 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1430 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1432 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1433 call add_task(iproc,ntask_cont_from,itask_cont_from)
1436 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1437 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1439 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1440 & jj+1.le.ielend_all(ii+1,iproc)) then
1441 call add_task(iproc,ntask_cont_from,itask_cont_from)
1443 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1444 & jj-1.le.ielend_all(ii+1,iproc)) then
1445 call add_task(iproc,ntask_cont_from,itask_cont_from)
1448 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1450 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1451 & jj-1.le.ielend_all(ii-1,iproc)) then
1452 call add_task(iproc,ntask_cont_from,itask_cont_from)
1454 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1455 & jj+1.le.ielend_all(ii-1,iproc)) then
1456 call add_task(iproc,ntask_cont_from,itask_cont_from)
1463 c---------------------------------------------------------------------------
1464 subroutine add_task(iproc,ntask_cont,itask_cont)
1466 include "DIMENSIONS"
1467 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1470 if (itask_cont(ii).eq.iproc) return
1472 ntask_cont=ntask_cont+1
1473 itask_cont(ntask_cont)=iproc
1476 c---------------------------------------------------------------------------
1477 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1479 include 'DIMENSIONS'
1481 include 'COMMON.SETUP'
1482 integer total_ints,lower_bound,upper_bound
1483 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1484 integer i,nint,nexcess
1485 nint=total_ints/nfgtasks
1489 nexcess=total_ints-nint*nfgtasks
1491 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1495 lower_bound=lower_bound+int4proc(i)
1497 upper_bound=lower_bound+int4proc(fg_rank)
1498 lower_bound=lower_bound+1
1501 c---------------------------------------------------------------------------
1502 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1504 include 'DIMENSIONS'
1506 include 'COMMON.SETUP'
1507 integer total_ints,lower_bound,upper_bound
1508 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1509 integer i,nint,nexcess
1510 nint=total_ints/nfgtasks1
1514 nexcess=total_ints-nint*nfgtasks1
1516 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1520 lower_bound=lower_bound+int4proc(i)
1522 upper_bound=lower_bound+int4proc(fg_rank1)
1523 lower_bound=lower_bound+1
1526 c---------------------------------------------------------------------------
1527 subroutine int_partition(int_index,lower_index,upper_index,atom,
1528 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1530 include 'DIMENSIONS'
1531 include 'COMMON.IOUNITS'
1532 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1533 & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1536 if (lprn) write (iout,*) 'int_index=',int_index
1537 int_index_old=int_index
1538 int_index=int_index+last_atom-first_atom+1
1540 & write (iout,*) 'int_index=',int_index,
1541 & ' int_index_old',int_index_old,
1542 & ' lower_index=',lower_index,
1543 & ' upper_index=',upper_index,
1544 & ' atom=',atom,' first_atom=',first_atom,
1545 & ' last_atom=',last_atom
1546 if (int_index.ge.lower_index) then
1548 if (at_start.eq.0) then
1550 jat_start=first_atom-1+lower_index-int_index_old
1552 jat_start=first_atom
1554 if (lprn) write (iout,*) 'jat_start',jat_start
1555 if (int_index.ge.upper_index) then
1557 jat_end=first_atom-1+upper_index-int_index_old
1562 if (lprn) write (iout,*) 'jat_end',jat_end
1567 c------------------------------------------------------------------------------
1568 subroutine hpb_partition
1570 include 'DIMENSIONS'
1574 include 'COMMON.SBRIDGE'
1575 include 'COMMON.IOUNITS'
1576 include 'COMMON.SETUP'
1578 call int_bounds(nhpb,link_start,link_end)
1579 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1580 & ' absolute rank',MyRank,
1581 & ' nhpb',nhpb,' link_start=',link_start,
1582 & ' link_end',link_end
1589 c------------------------------------------------------------------------------
1590 subroutine homology_partition
1592 include 'DIMENSIONS'
1596 include 'COMMON.SBRIDGE'
1597 include 'COMMON.IOUNITS'
1598 include 'COMMON.SETUP'
1599 include 'COMMON.CONTROL'
1600 include 'COMMON.INTERACT'
1601 include 'COMMON.HOMOLOGY'
1602 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1603 cd & " lim_dih",lim_dih
1605 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1606 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1607 call int_bounds(lim_dih,idihconstr_start_homo,
1608 & idihconstr_end_homo)
1609 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1610 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1611 if (me.eq.king .or. .not. out1file)
1612 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1613 & ' absolute rank',MyRank,
1614 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1615 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1616 & ' idihconstr_start_homo',idihconstr_start_homo,
1617 & ' idihconstr_end_homo',idihconstr_end_homo
1619 write (iout,*) "Not MPI"
1621 link_end_homo=lim_odl
1622 idihconstr_start_homo=nnt+3
1623 idihconstr_end_homo=lim_dih+nnt-1+3
1625 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1626 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1627 & ' idihconstr_start_homo',idihconstr_start_homo,
1628 & ' idihconstr_end_homo',idihconstr_end_homo
1632 c------------------------------------------------------------------------------
1633 subroutine NMRpeak_partition
1635 include 'DIMENSIONS'
1639 include 'COMMON.SBRIDGE'
1640 include 'COMMON.IOUNITS'
1641 include 'COMMON.SETUP'
1643 call int_bounds(npeak,link_start_peak,link_end_peak)
1644 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1645 & ' absolute rank',MyRank,
1646 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1647 & ' link_end_peak',link_end_peak