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 & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
458 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
459 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
460 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
461 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
462 & ielend_all(maxres,0:max_fg_procs-1),
463 & ntask_cont_from_all(0:max_fg_procs-1),
464 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
465 & ntask_cont_to_all(0:max_fg_procs-1),
466 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
467 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
468 logical scheck,lprint,flag
469 integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint,
470 & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
471 & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
472 & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
473 & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
474 & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
476 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
477 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
478 C... Determine the numbers of start and end SC-SC interaction
479 C... to deal with by current processor.
482 itask_cont_from(i)=fg_rank
483 itask_cont_to(i)=fg_rank
488 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
489 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
490 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
492 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
493 & ' absolute rank',MyRank,
494 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
495 & ' my_sc_inde',my_sc_inde
515 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
516 cd & (ihpb(i),jhpb(i),i=1,nss)
521 if (ihpb(ii).eq.i+nres) then
528 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
532 c write (iout,*) 'jj=i+1'
533 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
534 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
540 else if (jj.eq.nct) then
542 c write (iout,*) 'jj=nct'
543 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
544 & iatsc_s,iatsc_e,i+1,nct-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,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
555 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
556 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
567 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
568 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
573 ind_scint=ind_scint+nct-i
577 ind_scint_old=ind_scint
585 if (iatsc_s.eq.0) iatsc_s=1
587 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
588 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
591 write (iout,'(a)') 'Interaction array:'
593 write (iout,'(i3,2(2x,2i3))')
594 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
599 C Now partition the electrostatic-interaction array
601 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
602 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
604 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
605 & ' absolute rank',MyRank,
606 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
607 & ' my_ele_inde',my_ele_inde
614 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
615 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
618 if (iatel_s.eq.0) iatel_s=1
619 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
620 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
621 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
622 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
623 c & " my_ele_inde_vdw",my_ele_inde_vdw
630 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
632 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
634 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
635 c & " ielend_vdw",ielend_vdw(i)
637 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
648 do i=iatel_s_vdw,iatel_e_vdw
654 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
655 & ' absolute rank',MyRank
656 write (iout,*) 'Electrostatic interaction array:'
658 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
663 C Partition the SC-p interaction array
665 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
666 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
667 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
668 & ' absolute rank',myrank,
669 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
670 & ' my_scp_inde',my_scp_inde
676 if (i.lt.nnt+iscp) then
677 cd write (iout,*) 'i.le.nnt+iscp'
678 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
679 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
681 else if (i.gt.nct-iscp) then
682 cd write (iout,*) 'i.gt.nct-iscp'
683 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
684 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
687 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
688 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
691 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
692 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
701 if (i.lt.nnt+iscp) then
703 iscpstart(i,1)=i+iscp
705 elseif (i.gt.nct-iscp) then
713 iscpstart(i,2)=i+iscp
718 if (iatscp_s.eq.0) iatscp_s=1
720 write (iout,'(a)') 'SC-p interaction array:'
721 do i=iatscp_s,iatscp_e
722 write (iout,'(i3,2(2x,2i3))')
723 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
726 C Partition local interactions
728 call int_bounds(nres-2,loc_start,loc_end)
729 loc_start=loc_start+1
731 call int_bounds(nres-2,ithet_start,ithet_end)
732 call int_bounds(nsaxs,isaxs_start,isaxs_end)
733 write (iout,*) me," isaxs_start",isaxs_start,
734 & " isaxs_end",isaxs_end
735 ithet_start=ithet_start+2
736 ithet_end=ithet_end+2
737 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
738 iturn3_start=iturn3_start+nnt
739 iphi_start=iturn3_start+2
740 iturn3_end=iturn3_end+nnt
741 iphi_end=iturn3_end+2
742 iturn3_start=iturn3_start-1
743 iturn3_end=iturn3_end-1
744 call int_bounds(nres-3,itau_start,itau_end)
745 itau_start=itau_start+3
747 call int_bounds(nres-3,iphi1_start,iphi1_end)
748 iphi1_start=iphi1_start+3
749 iphi1_end=iphi1_end+3
750 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
751 iturn4_start=iturn4_start+nnt
752 iphid_start=iturn4_start+2
753 iturn4_end=iturn4_end+nnt
754 iphid_end=iturn4_end+2
755 iturn4_start=iturn4_start-1
756 iturn4_end=iturn4_end-1
757 call int_bounds(nres-2,ibond_start,ibond_end)
758 ibond_start=ibond_start+1
759 ibond_end=ibond_end+1
760 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
761 ibondp_start=ibondp_start+nnt
762 ibondp_end=ibondp_end+nnt
763 call int_bounds(nres,ilip_start,ilip_end)
764 c ilip_start=ilip_start
765 call int_bounds1(nres-1,ivec_start,ivec_end)
766 c print *,"Processor",myrank,fg_rank,fg_rank1,
767 c & " ivec_start",ivec_start," ivec_end",ivec_end
768 iset_start=loc_start+2
770 if (ndih_constr.eq.0) then
774 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
776 if (ntheta_constr.eq.0) then
781 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
783 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
785 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
787 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
788 igrad_start=((2*nlen+1)
789 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
790 jgrad_start(igrad_start)=
791 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
793 jgrad_end(igrad_start)=nres
794 igrad_end=((2*nlen+1)
795 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
796 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
797 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
799 do i=igrad_start+1,igrad_end-1
804 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
805 & ' absolute rank',myrank,
806 & ' loc_start',loc_start,' loc_end',loc_end,
807 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
808 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
809 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
810 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
811 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
812 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
813 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
814 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
815 & ' iset_start',iset_start,' iset_end',iset_end,
816 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
818 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
821 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
822 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
823 & ' ngrad_end',ngrad_end
824 do i=igrad_start,igrad_end
825 write(*,*) 'Processor:',fg_rank,myrank,i,
826 & jgrad_start(i),jgrad_end(i)
829 if (nfgtasks.gt.1) then
830 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
831 & MPI_INTEGER,FG_COMM1,IERROR)
832 iaux=ivec_end-ivec_start+1
833 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
834 & MPI_INTEGER,FG_COMM1,IERROR)
835 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
836 & MPI_INTEGER,FG_COMM,IERROR)
837 iaux=iset_end-iset_start+1
838 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
839 & MPI_INTEGER,FG_COMM,IERROR)
840 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
841 & MPI_INTEGER,FG_COMM,IERROR)
842 iaux=ibond_end-ibond_start+1
843 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
844 & MPI_INTEGER,FG_COMM,IERROR)
845 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
846 & MPI_INTEGER,FG_COMM,IERROR)
847 iaux=ithet_end-ithet_start+1
848 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
849 & MPI_INTEGER,FG_COMM,IERROR)
850 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
851 & MPI_INTEGER,FG_COMM,IERROR)
852 iaux=iphi_end-iphi_start+1
853 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
854 & MPI_INTEGER,FG_COMM,IERROR)
855 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
856 & MPI_INTEGER,FG_COMM,IERROR)
857 iaux=iphi1_end-iphi1_start+1
858 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
859 & MPI_INTEGER,FG_COMM,IERROR)
860 do i=0,max_fg_procs-1
866 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
867 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
868 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
869 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
870 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
871 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
872 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
873 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
874 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
875 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
876 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
877 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
878 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
879 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
880 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
881 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
883 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
884 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
885 write (iout,*) "iturn3_start_all",
886 & (iturn3_start_all(i),i=0,nfgtasks-1)
887 write (iout,*) "iturn3_end_all",
888 & (iturn3_end_all(i),i=0,nfgtasks-1)
889 write (iout,*) "iturn4_start_all",
890 & (iturn4_start_all(i),i=0,nfgtasks-1)
891 write (iout,*) "iturn4_end_all",
892 & (iturn4_end_all(i),i=0,nfgtasks-1)
893 write (iout,*) "The ielstart_all array"
895 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
897 write (iout,*) "The ielend_all array"
899 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
906 itask_cont_from(0)=fg_rank
907 itask_cont_to(0)=fg_rank
909 do ii=iturn3_start,iturn3_end
910 call add_int(ii,ii+2,iturn3_sent(1,ii),
911 & ntask_cont_to,itask_cont_to,flag)
913 do ii=iturn4_start,iturn4_end
914 call add_int(ii,ii+3,iturn4_sent(1,ii),
915 & ntask_cont_to,itask_cont_to,flag)
917 do ii=iturn3_start,iturn3_end
918 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
920 do ii=iturn4_start,iturn4_end
921 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
924 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
925 & " ntask_cont_to",ntask_cont_to
926 write (iout,*) "itask_cont_from",
927 & (itask_cont_from(i),i=1,ntask_cont_from)
928 write (iout,*) "itask_cont_to",
929 & (itask_cont_to(i),i=1,ntask_cont_to)
932 c write (iout,*) "Loop forward"
935 c write (iout,*) "from loop i=",i
937 do j=ielstart(i),ielend(i)
938 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
941 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
942 c & " iatel_e",iatel_e
946 c write (iout,*) "i",i," ielstart",ielstart(i),
947 c & " ielend",ielend(i)
950 do j=ielstart(i),ielend(i)
951 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
952 & itask_cont_to,flag)
960 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
961 & " ntask_cont_to",ntask_cont_to
962 write (iout,*) "itask_cont_from",
963 & (itask_cont_from(i),i=1,ntask_cont_from)
964 write (iout,*) "itask_cont_to",
965 & (itask_cont_to(i),i=1,ntask_cont_to)
967 write (iout,*) "iint_sent"
970 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
971 & j=ielstart(ii),ielend(ii))
973 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
974 & " iturn3_end",iturn3_end
975 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
976 & i=iturn3_start,iturn3_end)
977 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
978 & " iturn4_end",iturn4_end
979 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
980 & i=iturn4_start,iturn4_end)
983 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
984 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
985 c write (iout,*) "Gather ntask_cont_from ended"
987 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
988 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
990 c write (iout,*) "Gather itask_cont_from ended"
992 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
993 & 1,MPI_INTEGER,king,FG_COMM,IERR)
994 c write (iout,*) "Gather ntask_cont_to ended"
996 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
997 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
998 c write (iout,*) "Gather itask_cont_to ended"
1000 if (fg_rank.eq.king) then
1001 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
1003 write (iout,'(20i4)') i,ntask_cont_from_all(i),
1004 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
1008 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
1010 write (iout,'(20i4)') i,ntask_cont_to_all(i),
1011 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1015 C Check if every send will have a matching receive
1019 ncheck_to=ncheck_to+ntask_cont_to_all(i)
1020 ncheck_from=ncheck_from+ntask_cont_from_all(i)
1022 write (iout,*) "Control sums",ncheck_from,ncheck_to
1023 if (ncheck_from.ne.ncheck_to) then
1024 write (iout,*) "Error: #receive differs from #send."
1025 write (iout,*) "Terminating program...!"
1031 do j=1,ntask_cont_to_all(i)
1032 ii=itask_cont_to_all(j,i)
1033 do k=1,ntask_cont_from_all(ii)
1034 if (itask_cont_from_all(k,ii).eq.i) then
1035 if(lprint)write(iout,*)"Matching send/receive",i,ii
1039 if (k.eq.ntask_cont_from_all(ii)+1) then
1041 write (iout,*) "Error: send by",j," to",ii,
1042 & " would have no matching receive"
1048 write (iout,*) "Unmatched sends; terminating program"
1052 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1053 c write (iout,*) "flag broadcast ended flag=",flag
1056 call MPI_Finalize(IERROR)
1057 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1059 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1060 c write (iout,*) "MPI_Comm_group ended"
1062 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1063 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1064 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1065 & CONT_TO_GROUP,IERR)
1068 iaux=4*(ielend(ii)-ielstart(ii)+1)
1069 call MPI_Group_translate_ranks(fg_group,iaux,
1070 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1071 & iint_sent_local(1,ielstart(ii),i),IERR )
1072 c write (iout,*) "Ranks translated i=",i
1075 iaux=4*(iturn3_end-iturn3_start+1)
1076 call MPI_Group_translate_ranks(fg_group,iaux,
1077 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1078 & iturn3_sent_local(1,iturn3_start),IERR)
1079 iaux=4*(iturn4_end-iturn4_start+1)
1080 call MPI_Group_translate_ranks(fg_group,iaux,
1081 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1082 & iturn4_sent_local(1,iturn4_start),IERR)
1084 write (iout,*) "iint_sent_local"
1087 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1088 & j=ielstart(ii),ielend(ii))
1091 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1092 & " iturn3_end",iturn3_end
1093 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1094 & i=iturn3_start,iturn3_end)
1095 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1096 & " iturn4_end",iturn4_end
1097 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1098 & i=iturn4_start,iturn4_end)
1101 call MPI_Group_free(fg_group,ierr)
1102 call MPI_Group_free(cont_from_group,ierr)
1103 call MPI_Group_free(cont_to_group,ierr)
1105 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1106 call MPI_Type_commit(MPI_UYZ,IERROR)
1107 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1109 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1110 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1111 call MPI_Type_commit(MPI_MU,IERROR)
1112 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1113 call MPI_Type_commit(MPI_MAT1,IERROR)
1114 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1115 call MPI_Type_commit(MPI_MAT2,IERROR)
1116 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1117 call MPI_Type_commit(MPI_THET,IERROR)
1118 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1119 call MPI_Type_commit(MPI_GAM,IERROR)
1121 c 9/22/08 Derived types to send matrices which appear in correlation terms
1123 if (ivec_count(i).eq.ivec_count(0)) then
1129 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1130 if (ind_typ.eq.0) then
1131 ichunk=ivec_count(0)
1133 ichunk=ivec_count(1)
1140 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1143 c blocklengths(i)=blocklengths(i)*ichunk
1145 c write (iout,*) "blocklengths and displs"
1147 c write (iout,*) i,blocklengths(i),displs(i)
1150 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1151 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1152 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1153 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1159 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1162 c blocklengths(i)=blocklengths(i)*ichunk
1164 c write (iout,*) "blocklengths and displs"
1166 c write (iout,*) i,blocklengths(i),displs(i)
1169 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1170 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1171 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1172 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1178 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1181 blocklengths(i)=blocklengths(i)*ichunk
1183 call MPI_Type_indexed(8,blocklengths,displs,
1184 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1185 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1191 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1194 blocklengths(i)=blocklengths(i)*ichunk
1196 call MPI_Type_indexed(8,blocklengths,displs,
1197 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1198 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1204 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1207 blocklengths(i)=blocklengths(i)*ichunk
1209 call MPI_Type_indexed(6,blocklengths,displs,
1210 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1211 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1217 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1220 blocklengths(i)=blocklengths(i)*ichunk
1222 call MPI_Type_indexed(2,blocklengths,displs,
1223 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1224 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1230 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1233 blocklengths(i)=blocklengths(i)*ichunk
1235 call MPI_Type_indexed(4,blocklengths,displs,
1236 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1237 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1241 iint_start=ivec_start+1
1244 iint_count(i)=ivec_count(i)
1245 iint_displ(i)=ivec_displ(i)
1246 ivec_displ(i)=ivec_displ(i)-1
1247 iset_displ(i)=iset_displ(i)-1
1248 ithet_displ(i)=ithet_displ(i)-1
1249 iphi_displ(i)=iphi_displ(i)-1
1250 iphi1_displ(i)=iphi1_displ(i)-1
1251 ibond_displ(i)=ibond_displ(i)-1
1253 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1254 & .and. (me.eq.0 .or. .not. out1file)) then
1255 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1257 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1260 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1261 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1262 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1264 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1267 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1268 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1269 & ' SC-p interactions','were distributed among',nfgtasks,
1270 & ' fine-grain processors.'
1286 idihconstr_end=ndih_constr
1287 ithetaconstr_start=1
1288 ithetaconstr_end=ntheta_constr
1289 iphid_start=iphi_start
1290 iphid_end=iphi_end-1
1312 c---------------------------------------------------------------------------
1313 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1315 include "DIMENSIONS"
1316 include "COMMON.INTERACT"
1317 include "COMMON.SETUP"
1318 include "COMMON.IOUNITS"
1319 integer ii,jj,itask(4),ntask_cont_to,
1320 &itask_cont_to(0:max_fg_procs-1)
1322 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1323 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1324 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1325 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1326 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1327 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1328 & ielend_all(maxres,0:max_fg_procs-1)
1329 integer iproc,isent,k,l
1330 c Determines whether to send interaction ii,jj to other processors; a given
1331 c interaction can be sent to at most 2 processors.
1332 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1333 c one processor, otherwise flag is unchanged from the input value.
1339 c write (iout,*) "ii",ii," jj",jj
1340 c Loop over processors to check if anybody could need interaction ii,jj
1341 do iproc=0,fg_rank-1
1342 c Check if the interaction matches any turn3 at iproc
1343 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1345 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1346 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1348 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1351 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1352 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1355 call add_task(iproc,ntask_cont_to,itask_cont_to)
1359 C Check if the interaction matches any turn4 at iproc
1360 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1362 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1363 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1365 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1368 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1369 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1372 call add_task(iproc,ntask_cont_to,itask_cont_to)
1376 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1377 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1378 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1379 & ielend_all(ii-1,iproc).ge.jj-1) then
1381 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1382 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1385 call add_task(iproc,ntask_cont_to,itask_cont_to)
1388 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1389 & ielend_all(ii-1,iproc).ge.jj+1) then
1391 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1392 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1395 call add_task(iproc,ntask_cont_to,itask_cont_to)
1402 c---------------------------------------------------------------------------
1403 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1405 include "DIMENSIONS"
1406 include "COMMON.INTERACT"
1407 include "COMMON.SETUP"
1408 include "COMMON.IOUNITS"
1409 integer ii,jj,itask(2),ntask_cont_from,
1410 & itask_cont_from(0:max_fg_procs-1)
1412 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1413 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1414 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1415 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1416 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1417 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1418 & ielend_all(maxres,0:max_fg_procs-1)
1420 do iproc=fg_rank+1,nfgtasks-1
1421 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1423 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1424 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1426 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1427 call add_task(iproc,ntask_cont_from,itask_cont_from)
1430 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1432 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1433 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1435 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1436 call add_task(iproc,ntask_cont_from,itask_cont_from)
1439 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1440 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1442 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1443 & jj+1.le.ielend_all(ii+1,iproc)) then
1444 call add_task(iproc,ntask_cont_from,itask_cont_from)
1446 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1447 & jj-1.le.ielend_all(ii+1,iproc)) then
1448 call add_task(iproc,ntask_cont_from,itask_cont_from)
1451 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1453 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1454 & jj-1.le.ielend_all(ii-1,iproc)) then
1455 call add_task(iproc,ntask_cont_from,itask_cont_from)
1457 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1458 & jj+1.le.ielend_all(ii-1,iproc)) then
1459 call add_task(iproc,ntask_cont_from,itask_cont_from)
1466 c---------------------------------------------------------------------------
1467 subroutine add_task(iproc,ntask_cont,itask_cont)
1469 include "DIMENSIONS"
1470 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1473 if (itask_cont(ii).eq.iproc) return
1475 ntask_cont=ntask_cont+1
1476 itask_cont(ntask_cont)=iproc
1479 c---------------------------------------------------------------------------
1480 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1482 include 'DIMENSIONS'
1484 include 'COMMON.SETUP'
1485 integer total_ints,lower_bound,upper_bound
1486 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1487 integer i,nint,nexcess
1488 nint=total_ints/nfgtasks
1492 nexcess=total_ints-nint*nfgtasks
1494 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1498 lower_bound=lower_bound+int4proc(i)
1500 upper_bound=lower_bound+int4proc(fg_rank)
1501 lower_bound=lower_bound+1
1504 c---------------------------------------------------------------------------
1505 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1507 include 'DIMENSIONS'
1509 include 'COMMON.SETUP'
1510 integer total_ints,lower_bound,upper_bound
1511 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1512 integer i,nint,nexcess
1513 nint=total_ints/nfgtasks1
1517 nexcess=total_ints-nint*nfgtasks1
1519 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1523 lower_bound=lower_bound+int4proc(i)
1525 upper_bound=lower_bound+int4proc(fg_rank1)
1526 lower_bound=lower_bound+1
1529 c---------------------------------------------------------------------------
1530 subroutine int_partition(int_index,lower_index,upper_index,atom,
1531 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1533 include 'DIMENSIONS'
1534 include 'COMMON.IOUNITS'
1535 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1536 & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1539 if (lprn) write (iout,*) 'int_index=',int_index
1540 int_index_old=int_index
1541 int_index=int_index+last_atom-first_atom+1
1543 & write (iout,*) 'int_index=',int_index,
1544 & ' int_index_old',int_index_old,
1545 & ' lower_index=',lower_index,
1546 & ' upper_index=',upper_index,
1547 & ' atom=',atom,' first_atom=',first_atom,
1548 & ' last_atom=',last_atom
1549 if (int_index.ge.lower_index) then
1551 if (at_start.eq.0) then
1553 jat_start=first_atom-1+lower_index-int_index_old
1555 jat_start=first_atom
1557 if (lprn) write (iout,*) 'jat_start',jat_start
1558 if (int_index.ge.upper_index) then
1560 jat_end=first_atom-1+upper_index-int_index_old
1565 if (lprn) write (iout,*) 'jat_end',jat_end
1570 c------------------------------------------------------------------------------
1571 subroutine hpb_partition
1573 include 'DIMENSIONS'
1577 include 'COMMON.SBRIDGE'
1578 include 'COMMON.IOUNITS'
1579 include 'COMMON.SETUP'
1581 call int_bounds(nhpb,link_start,link_end)
1582 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1583 & ' absolute rank',MyRank,
1584 & ' nhpb',nhpb,' link_start=',link_start,
1585 & ' link_end',link_end
1592 c------------------------------------------------------------------------------
1593 subroutine homology_partition
1595 include 'DIMENSIONS'
1599 include 'COMMON.SBRIDGE'
1600 include 'COMMON.IOUNITS'
1601 include 'COMMON.SETUP'
1602 include 'COMMON.CONTROL'
1603 include 'COMMON.INTERACT'
1604 include 'COMMON.HOMOLOGY'
1605 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1606 cd & " lim_dih",lim_dih
1608 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1609 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1610 call int_bounds(lim_dih,idihconstr_start_homo,
1611 & idihconstr_end_homo)
1612 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1613 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1614 if (me.eq.king .or. .not. out1file)
1615 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1616 & ' absolute rank',MyRank,
1617 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1618 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1619 & ' idihconstr_start_homo',idihconstr_start_homo,
1620 & ' idihconstr_end_homo',idihconstr_end_homo
1622 write (iout,*) "Not MPI"
1624 link_end_homo=lim_odl
1625 idihconstr_start_homo=nnt+3
1626 idihconstr_end_homo=lim_dih+nnt-1+3
1628 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1629 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1630 & ' idihconstr_start_homo',idihconstr_start_homo,
1631 & ' idihconstr_end_homo',idihconstr_end_homo
1635 c------------------------------------------------------------------------------
1636 subroutine NMRpeak_partition
1638 include 'DIMENSIONS'
1642 include 'COMMON.SBRIDGE'
1643 include 'COMMON.IOUNITS'
1644 include 'COMMON.SETUP'
1646 call int_bounds(npeak,link_start_peak,link_end_peak)
1647 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1648 & ' absolute rank',MyRank,
1649 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1650 & ' link_end_peak',link_end_peak