2 implicit real*8 (a-h,o-z)
6 include 'COMMON.LANGEVIN'
8 include 'COMMON.LANGEVIN.lang0'
11 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
13 c Conversion from poises to molecular unit and the gas constant
14 data cPoise /2.9361d0/, Rb /0.001986d0/
16 c--------------------------------------------------------------------------
19 C Define constants and zero out tables.
21 implicit real*8 (a-h,o-z)
29 cMS$ATTRIBUTES C :: proc_proc
32 include 'COMMON.IOUNITS'
33 include 'COMMON.CHAIN'
34 include 'COMMON.INTERACT'
36 include 'COMMON.LOCAL'
37 include 'COMMON.TORSION'
38 include 'COMMON.FFIELD'
39 include 'COMMON.SBRIDGE'
41 include 'COMMON.MINIM'
42 include 'COMMON.DERIV'
43 include 'COMMON.SPLITELE'
44 c Common blocks from the diagonalization routines
45 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
46 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
48 c real*8 text1 /'initial_i'/
66 C The following is just to define auxiliary variables used in angle conversion
105 crc for write_rmsbank1
107 cdr include secondary structure prediction bias
110 C CSA I/O units (separated from others especially for Jooyoung)
121 icsa_bank_reminimized=38
124 crc for ifc error 118
127 C Lipidic input file for parameters range 60-79
129 C input file for transfer sidechain and peptide group inside the
130 C lipidic environment if lipid is implicite
132 C DNA input files for parameters range 80-99
133 C Suger input files for parameters range 100-119
134 C All-atom input files for parameters range 120-149
136 C Set default weights of the energy terms.
147 c print '(a,$)','Inside initialize'
148 c call memmon_print_usage()
183 athet(j,i,ichir1,ichir2)=0.0D0
184 bthet(j,i,ichir1,ichir2)=0.0D0
204 gaussc(l,k,j,i)=0.0D0
214 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
218 v1(k,j,i,iblock)=0.0D0
219 v2(k,j,i,iblock)=0.0D0
229 v1c(1,l,i,j,k,iblock)=0.0D0
230 v1s(1,l,i,j,k,iblock)=0.0D0
231 v1c(2,l,i,j,k,iblock)=0.0D0
232 v1s(2,l,i,j,k,iblock)=0.0D0
236 v2c(m,l,i,j,k,iblock)=0.0D0
237 v2s(m,l,i,j,k,iblock)=0.0D0
249 C Initialize the bridge arrays
263 C Initialize correlation arrays
294 C Initialize variables used in minimization.
303 C Initialize the variables responsible for the mode of gradient storage.
308 C Initialize constants used to split the energy into long- and short-range
314 nprint_ene=nprint_ene-1
318 c-------------------------------------------------------------------------
320 implicit real*8 (a-h,o-z)
322 include 'COMMON.NAMES'
323 include 'COMMON.FFIELD'
325 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
326 & 'DSG','DGN','DSN','DTH',
327 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
328 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
329 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
332 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
333 &'a','y','w','v','l','i','f','m','c','x',
334 &'C','M','F','I','L','V','W','Y','A','G','T',
335 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
336 data potname /'LJ','LJK','BP','GB','GBV'/
339 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
341 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ",
342 ! 15 16 17 18 19 20 21
343 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
344 ! 22 23 24 25 26 27 28
345 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFADIS",
347 3 "WDFATOR","WDFANEI","WDFABET"/
381 #if defined(SCP14) && defined(SPLITELE)
383 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
384 & 24,15,26,27,28,29,30,31,22,23,25,20/
387 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
388 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
389 #elif defined(SPLITELE)
391 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
392 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
395 data print_order/1,2,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,2*0/
399 #if defined(SCP14) && defined(SPLITELE)
401 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
402 & 24,15,26,27,22,23,25,20,4*0/
405 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
406 & 24,15,26,27,22,23,25,20,5*0/
407 #elif defined(SPLITELE)
409 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
410 & 24,15,26,27,22,23,25,20,5*0/
413 data print_order/1,2,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,6*0/
418 c---------------------------------------------------------------------------
419 subroutine init_int_table
420 implicit real*8 (a-h,o-z)
424 integer blocklengths(15),displs(15)
426 include 'COMMON.CONTROL'
427 include 'COMMON.SETUP'
428 include 'COMMON.CHAIN'
429 include 'COMMON.INTERACT'
430 include 'COMMON.LOCAL'
431 include 'COMMON.SBRIDGE'
432 include 'COMMON.TORCNSTR'
433 include 'COMMON.IOUNITS'
434 include 'COMMON.DERIV'
435 include 'COMMON.CONTACTS'
436 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
437 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
438 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
439 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
440 & ielend_all(maxres,0:max_fg_procs-1),
441 & ntask_cont_from_all(0:max_fg_procs-1),
442 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
443 & ntask_cont_to_all(0:max_fg_procs-1),
444 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
445 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
446 logical scheck,lprint,flag
448 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
449 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
450 C... Determine the numbers of start and end SC-SC interaction
451 C... to deal with by current processor.
453 itask_cont_from(i)=fg_rank
454 itask_cont_to(i)=fg_rank
458 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
459 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
460 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
462 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
463 & ' absolute rank',MyRank,
464 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
465 & ' my_sc_inde',my_sc_inde
485 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
486 cd & (ihpb(i),jhpb(i),i=1,nss)
491 if (ihpb(ii).eq.i+nres) then
498 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
502 c write (iout,*) 'jj=i+1'
503 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
504 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
510 else if (jj.eq.nct) then
512 c write (iout,*) 'jj=nct'
513 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
514 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
522 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
523 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
525 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
526 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
537 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
538 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
543 ind_scint=ind_scint+nct-i
547 ind_scint_old=ind_scint
555 if (iatsc_s.eq.0) iatsc_s=1
557 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
558 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
561 write (iout,'(a)') 'Interaction array:'
563 write (iout,'(i3,2(2x,2i3))')
564 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
569 C Now partition the electrostatic-interaction array
571 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
572 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
574 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
575 & ' absolute rank',MyRank,
576 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
577 & ' my_ele_inde',my_ele_inde
584 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
585 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
588 if (iatel_s.eq.0) iatel_s=1
589 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
590 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
591 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
592 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
593 c & " my_ele_inde_vdw",my_ele_inde_vdw
600 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
602 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
604 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
605 c & " ielend_vdw",ielend_vdw(i)
607 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
618 do i=iatel_s_vdw,iatel_e_vdw
624 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
625 & ' absolute rank',MyRank
626 write (iout,*) 'Electrostatic interaction array:'
628 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
633 C Partition the SC-p interaction array
635 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
636 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
637 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
638 & ' absolute rank',myrank,
639 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
640 & ' my_scp_inde',my_scp_inde
646 if (i.lt.nnt+iscp) then
647 cd write (iout,*) 'i.le.nnt+iscp'
648 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
649 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
651 else if (i.gt.nct-iscp) then
652 cd write (iout,*) 'i.gt.nct-iscp'
653 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
654 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
657 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
658 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
661 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
662 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
671 if (i.lt.nnt+iscp) then
673 iscpstart(i,1)=i+iscp
675 elseif (i.gt.nct-iscp) then
683 iscpstart(i,2)=i+iscp
688 if (iatscp_s.eq.0) iatscp_s=1
690 write (iout,'(a)') 'SC-p interaction array:'
691 do i=iatscp_s,iatscp_e
692 write (iout,'(i3,2(2x,2i3))')
693 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
696 C Partition local interactions
698 call int_bounds(nres-2,loc_start,loc_end)
699 loc_start=loc_start+1
701 call int_bounds(nres-2,ithet_start,ithet_end)
702 call int_bounds(nsaxs,isaxs_start,isaxs_end)
703 write (iout,*) me," isaxs_start",isaxs_start,
704 & " isaxs_end",isaxs_end
705 ithet_start=ithet_start+2
706 ithet_end=ithet_end+2
707 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
708 iturn3_start=iturn3_start+nnt
709 iphi_start=iturn3_start+2
710 iturn3_end=iturn3_end+nnt
711 iphi_end=iturn3_end+2
712 iturn3_start=iturn3_start-1
713 iturn3_end=iturn3_end-1
714 call int_bounds(nres-3,itau_start,itau_end)
715 itau_start=itau_start+3
717 call int_bounds(nres-3,iphi1_start,iphi1_end)
718 iphi1_start=iphi1_start+3
719 iphi1_end=iphi1_end+3
720 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
721 iturn4_start=iturn4_start+nnt
722 iphid_start=iturn4_start+2
723 iturn4_end=iturn4_end+nnt
724 iphid_end=iturn4_end+2
725 iturn4_start=iturn4_start-1
726 iturn4_end=iturn4_end-1
727 call int_bounds(nres-2,ibond_start,ibond_end)
728 ibond_start=ibond_start+1
729 ibond_end=ibond_end+1
730 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
731 ibondp_start=ibondp_start+nnt
732 ibondp_end=ibondp_end+nnt
733 call int_bounds(nres,ilip_start,ilip_end)
734 c ilip_start=ilip_start
735 call int_bounds1(nres-1,ivec_start,ivec_end)
736 c print *,"Processor",myrank,fg_rank,fg_rank1,
737 c & " ivec_start",ivec_start," ivec_end",ivec_end
738 iset_start=loc_start+2
740 if (ndih_constr.eq.0) then
744 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
746 if (ntheta_constr.eq.0) then
751 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
753 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
755 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
757 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
758 igrad_start=((2*nlen+1)
759 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
760 jgrad_start(igrad_start)=
761 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
763 jgrad_end(igrad_start)=nres
764 igrad_end=((2*nlen+1)
765 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
766 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
767 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
769 do i=igrad_start+1,igrad_end-1
774 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
775 & ' absolute rank',myrank,
776 & ' loc_start',loc_start,' loc_end',loc_end,
777 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
778 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
779 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
780 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
781 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
782 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
783 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
784 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
785 & ' iset_start',iset_start,' iset_end',iset_end,
786 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
788 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
791 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
792 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
793 & ' ngrad_end',ngrad_end
794 do i=igrad_start,igrad_end
795 write(*,*) 'Processor:',fg_rank,myrank,i,
796 & jgrad_start(i),jgrad_end(i)
799 if (nfgtasks.gt.1) then
800 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
801 & MPI_INTEGER,FG_COMM1,IERROR)
802 iaux=ivec_end-ivec_start+1
803 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
804 & MPI_INTEGER,FG_COMM1,IERROR)
805 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
806 & MPI_INTEGER,FG_COMM,IERROR)
807 iaux=iset_end-iset_start+1
808 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
809 & MPI_INTEGER,FG_COMM,IERROR)
810 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
811 & MPI_INTEGER,FG_COMM,IERROR)
812 iaux=ibond_end-ibond_start+1
813 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
814 & MPI_INTEGER,FG_COMM,IERROR)
815 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
816 & MPI_INTEGER,FG_COMM,IERROR)
817 iaux=ithet_end-ithet_start+1
818 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
819 & MPI_INTEGER,FG_COMM,IERROR)
820 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
821 & MPI_INTEGER,FG_COMM,IERROR)
822 iaux=iphi_end-iphi_start+1
823 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
824 & MPI_INTEGER,FG_COMM,IERROR)
825 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
826 & MPI_INTEGER,FG_COMM,IERROR)
827 iaux=iphi1_end-iphi1_start+1
828 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
829 & MPI_INTEGER,FG_COMM,IERROR)
830 do i=0,max_fg_procs-1
836 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
837 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
838 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
839 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
840 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
841 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
842 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
843 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
844 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
845 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
846 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
847 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
848 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
849 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
850 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
851 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
853 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
854 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
855 write (iout,*) "iturn3_start_all",
856 & (iturn3_start_all(i),i=0,nfgtasks-1)
857 write (iout,*) "iturn3_end_all",
858 & (iturn3_end_all(i),i=0,nfgtasks-1)
859 write (iout,*) "iturn4_start_all",
860 & (iturn4_start_all(i),i=0,nfgtasks-1)
861 write (iout,*) "iturn4_end_all",
862 & (iturn4_end_all(i),i=0,nfgtasks-1)
863 write (iout,*) "The ielstart_all array"
865 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
867 write (iout,*) "The ielend_all array"
869 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
875 itask_cont_from(0)=fg_rank
876 itask_cont_to(0)=fg_rank
878 do ii=iturn3_start,iturn3_end
879 call add_int(ii,ii+2,iturn3_sent(1,ii),
880 & ntask_cont_to,itask_cont_to,flag)
882 do ii=iturn4_start,iturn4_end
883 call add_int(ii,ii+3,iturn4_sent(1,ii),
884 & ntask_cont_to,itask_cont_to,flag)
886 do ii=iturn3_start,iturn3_end
887 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
889 do ii=iturn4_start,iturn4_end
890 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
893 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
894 & " ntask_cont_to",ntask_cont_to
895 write (iout,*) "itask_cont_from",
896 & (itask_cont_from(i),i=1,ntask_cont_from)
897 write (iout,*) "itask_cont_to",
898 & (itask_cont_to(i),i=1,ntask_cont_to)
901 c write (iout,*) "Loop forward"
904 c write (iout,*) "from loop i=",i
906 do j=ielstart(i),ielend(i)
907 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
910 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
911 c & " iatel_e",iatel_e
915 c write (iout,*) "i",i," ielstart",ielstart(i),
916 c & " ielend",ielend(i)
919 do j=ielstart(i),ielend(i)
920 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
921 & itask_cont_to,flag)
929 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
930 & " ntask_cont_to",ntask_cont_to
931 write (iout,*) "itask_cont_from",
932 & (itask_cont_from(i),i=1,ntask_cont_from)
933 write (iout,*) "itask_cont_to",
934 & (itask_cont_to(i),i=1,ntask_cont_to)
936 write (iout,*) "iint_sent"
939 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
940 & j=ielstart(ii),ielend(ii))
942 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
943 & " iturn3_end",iturn3_end
944 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
945 & i=iturn3_start,iturn3_end)
946 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
947 & " iturn4_end",iturn4_end
948 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
949 & i=iturn4_start,iturn4_end)
952 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
953 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
954 c write (iout,*) "Gather ntask_cont_from ended"
956 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
957 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
959 c write (iout,*) "Gather itask_cont_from ended"
961 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
962 & 1,MPI_INTEGER,king,FG_COMM,IERR)
963 c write (iout,*) "Gather ntask_cont_to ended"
965 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
966 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
967 c write (iout,*) "Gather itask_cont_to ended"
969 if (fg_rank.eq.king) then
970 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
972 write (iout,'(20i4)') i,ntask_cont_from_all(i),
973 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
977 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
979 write (iout,'(20i4)') i,ntask_cont_to_all(i),
980 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
984 C Check if every send will have a matching receive
988 ncheck_to=ncheck_to+ntask_cont_to_all(i)
989 ncheck_from=ncheck_from+ntask_cont_from_all(i)
991 write (iout,*) "Control sums",ncheck_from,ncheck_to
992 if (ncheck_from.ne.ncheck_to) then
993 write (iout,*) "Error: #receive differs from #send."
994 write (iout,*) "Terminating program...!"
1000 do j=1,ntask_cont_to_all(i)
1001 ii=itask_cont_to_all(j,i)
1002 do k=1,ntask_cont_from_all(ii)
1003 if (itask_cont_from_all(k,ii).eq.i) then
1004 if(lprint)write(iout,*)"Matching send/receive",i,ii
1008 if (k.eq.ntask_cont_from_all(ii)+1) then
1010 write (iout,*) "Error: send by",j," to",ii,
1011 & " would have no matching receive"
1017 write (iout,*) "Unmatched sends; terminating program"
1021 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1022 c write (iout,*) "flag broadcast ended flag=",flag
1025 call MPI_Finalize(IERROR)
1026 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1028 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1029 c write (iout,*) "MPI_Comm_group ended"
1031 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1032 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1033 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1034 & CONT_TO_GROUP,IERR)
1037 iaux=4*(ielend(ii)-ielstart(ii)+1)
1038 call MPI_Group_translate_ranks(fg_group,iaux,
1039 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1040 & iint_sent_local(1,ielstart(ii),i),IERR )
1041 c write (iout,*) "Ranks translated i=",i
1044 iaux=4*(iturn3_end-iturn3_start+1)
1045 call MPI_Group_translate_ranks(fg_group,iaux,
1046 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1047 & iturn3_sent_local(1,iturn3_start),IERR)
1048 iaux=4*(iturn4_end-iturn4_start+1)
1049 call MPI_Group_translate_ranks(fg_group,iaux,
1050 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1051 & iturn4_sent_local(1,iturn4_start),IERR)
1053 write (iout,*) "iint_sent_local"
1056 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1057 & j=ielstart(ii),ielend(ii))
1060 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1061 & " iturn3_end",iturn3_end
1062 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1063 & i=iturn3_start,iturn3_end)
1064 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1065 & " iturn4_end",iturn4_end
1066 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1067 & i=iturn4_start,iturn4_end)
1070 call MPI_Group_free(fg_group,ierr)
1071 call MPI_Group_free(cont_from_group,ierr)
1072 call MPI_Group_free(cont_to_group,ierr)
1073 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1074 call MPI_Type_commit(MPI_UYZ,IERROR)
1075 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1077 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1078 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1079 call MPI_Type_commit(MPI_MU,IERROR)
1080 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1081 call MPI_Type_commit(MPI_MAT1,IERROR)
1082 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1083 call MPI_Type_commit(MPI_MAT2,IERROR)
1084 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1085 call MPI_Type_commit(MPI_THET,IERROR)
1086 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1087 call MPI_Type_commit(MPI_GAM,IERROR)
1089 c 9/22/08 Derived types to send matrices which appear in correlation terms
1091 if (ivec_count(i).eq.ivec_count(0)) then
1097 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1098 if (ind_typ.eq.0) then
1099 ichunk=ivec_count(0)
1101 ichunk=ivec_count(1)
1108 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1111 c blocklengths(i)=blocklengths(i)*ichunk
1113 c write (iout,*) "blocklengths and displs"
1115 c write (iout,*) i,blocklengths(i),displs(i)
1118 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1119 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1120 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1121 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1127 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1130 c blocklengths(i)=blocklengths(i)*ichunk
1132 c write (iout,*) "blocklengths and displs"
1134 c write (iout,*) i,blocklengths(i),displs(i)
1137 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1138 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1139 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1140 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1146 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1149 blocklengths(i)=blocklengths(i)*ichunk
1151 call MPI_Type_indexed(8,blocklengths,displs,
1152 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1153 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1159 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1162 blocklengths(i)=blocklengths(i)*ichunk
1164 call MPI_Type_indexed(8,blocklengths,displs,
1165 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1166 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1172 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1175 blocklengths(i)=blocklengths(i)*ichunk
1177 call MPI_Type_indexed(6,blocklengths,displs,
1178 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1179 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1185 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1188 blocklengths(i)=blocklengths(i)*ichunk
1190 call MPI_Type_indexed(2,blocklengths,displs,
1191 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1192 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1198 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1201 blocklengths(i)=blocklengths(i)*ichunk
1203 call MPI_Type_indexed(4,blocklengths,displs,
1204 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1205 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1209 iint_start=ivec_start+1
1212 iint_count(i)=ivec_count(i)
1213 iint_displ(i)=ivec_displ(i)
1214 ivec_displ(i)=ivec_displ(i)-1
1215 iset_displ(i)=iset_displ(i)-1
1216 ithet_displ(i)=ithet_displ(i)-1
1217 iphi_displ(i)=iphi_displ(i)-1
1218 iphi1_displ(i)=iphi1_displ(i)-1
1219 ibond_displ(i)=ibond_displ(i)-1
1221 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1222 & .and. (me.eq.0 .or. .not. out1file)) then
1223 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1225 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1228 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1229 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1230 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1232 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1235 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1236 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1237 & ' SC-p interactions','were distributed among',nfgtasks,
1238 & ' fine-grain processors.'
1254 idihconstr_end=ndih_constr
1255 ithetaconstr_start=1
1256 ithetaconstr_end=ntheta_constr
1257 iphid_start=iphi_start
1258 iphid_end=iphi_end-1
1280 c---------------------------------------------------------------------------
1281 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1283 include "DIMENSIONS"
1284 include "COMMON.INTERACT"
1285 include "COMMON.SETUP"
1286 include "COMMON.IOUNITS"
1287 integer ii,jj,itask(4),ntask_cont_to,
1288 &itask_cont_to(0:max_fg_procs-1)
1290 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1291 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1292 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1293 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1294 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1295 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1296 & ielend_all(maxres,0:max_fg_procs-1)
1297 integer iproc,isent,k,l
1298 c Determines whether to send interaction ii,jj to other processors; a given
1299 c interaction can be sent to at most 2 processors.
1300 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1301 c one processor, otherwise flag is unchanged from the input value.
1307 c write (iout,*) "ii",ii," jj",jj
1308 c Loop over processors to check if anybody could need interaction ii,jj
1309 do iproc=0,fg_rank-1
1310 c Check if the interaction matches any turn3 at iproc
1311 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1313 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1314 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1316 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1319 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1320 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1323 call add_task(iproc,ntask_cont_to,itask_cont_to)
1327 C Check if the interaction matches any turn4 at iproc
1328 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1330 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1331 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1333 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1336 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1337 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1340 call add_task(iproc,ntask_cont_to,itask_cont_to)
1344 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1345 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1346 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1347 & ielend_all(ii-1,iproc).ge.jj-1) then
1349 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1350 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1353 call add_task(iproc,ntask_cont_to,itask_cont_to)
1356 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1357 & ielend_all(ii-1,iproc).ge.jj+1) then
1359 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1360 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1363 call add_task(iproc,ntask_cont_to,itask_cont_to)
1370 c---------------------------------------------------------------------------
1371 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1373 include "DIMENSIONS"
1374 include "COMMON.INTERACT"
1375 include "COMMON.SETUP"
1376 include "COMMON.IOUNITS"
1377 integer ii,jj,itask(2),ntask_cont_from,
1378 & itask_cont_from(0:max_fg_procs-1)
1380 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1381 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1382 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1383 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1384 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1385 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1386 & ielend_all(maxres,0:max_fg_procs-1)
1388 do iproc=fg_rank+1,nfgtasks-1
1389 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1391 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1392 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1394 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1395 call add_task(iproc,ntask_cont_from,itask_cont_from)
1398 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1400 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1401 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1403 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1404 call add_task(iproc,ntask_cont_from,itask_cont_from)
1407 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1408 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1410 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1411 & jj+1.le.ielend_all(ii+1,iproc)) then
1412 call add_task(iproc,ntask_cont_from,itask_cont_from)
1414 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1415 & jj-1.le.ielend_all(ii+1,iproc)) then
1416 call add_task(iproc,ntask_cont_from,itask_cont_from)
1419 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1421 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1422 & jj-1.le.ielend_all(ii-1,iproc)) then
1423 call add_task(iproc,ntask_cont_from,itask_cont_from)
1425 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1426 & jj+1.le.ielend_all(ii-1,iproc)) then
1427 call add_task(iproc,ntask_cont_from,itask_cont_from)
1434 c---------------------------------------------------------------------------
1435 subroutine add_task(iproc,ntask_cont,itask_cont)
1437 include "DIMENSIONS"
1438 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1441 if (itask_cont(ii).eq.iproc) return
1443 ntask_cont=ntask_cont+1
1444 itask_cont(ntask_cont)=iproc
1447 c---------------------------------------------------------------------------
1448 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1449 implicit real*8 (a-h,o-z)
1450 include 'DIMENSIONS'
1452 include 'COMMON.SETUP'
1453 integer total_ints,lower_bound,upper_bound
1454 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1455 nint=total_ints/nfgtasks
1459 nexcess=total_ints-nint*nfgtasks
1461 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1465 lower_bound=lower_bound+int4proc(i)
1467 upper_bound=lower_bound+int4proc(fg_rank)
1468 lower_bound=lower_bound+1
1471 c---------------------------------------------------------------------------
1472 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1473 implicit real*8 (a-h,o-z)
1474 include 'DIMENSIONS'
1476 include 'COMMON.SETUP'
1477 integer total_ints,lower_bound,upper_bound
1478 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1479 nint=total_ints/nfgtasks1
1483 nexcess=total_ints-nint*nfgtasks1
1485 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1489 lower_bound=lower_bound+int4proc(i)
1491 upper_bound=lower_bound+int4proc(fg_rank1)
1492 lower_bound=lower_bound+1
1495 c---------------------------------------------------------------------------
1496 subroutine int_partition(int_index,lower_index,upper_index,atom,
1497 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1498 implicit real*8 (a-h,o-z)
1499 include 'DIMENSIONS'
1500 include 'COMMON.IOUNITS'
1501 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1502 & first_atom,last_atom,int_gr,jat_start,jat_end
1505 if (lprn) write (iout,*) 'int_index=',int_index
1506 int_index_old=int_index
1507 int_index=int_index+last_atom-first_atom+1
1509 & write (iout,*) 'int_index=',int_index,
1510 & ' int_index_old',int_index_old,
1511 & ' lower_index=',lower_index,
1512 & ' upper_index=',upper_index,
1513 & ' atom=',atom,' first_atom=',first_atom,
1514 & ' last_atom=',last_atom
1515 if (int_index.ge.lower_index) then
1517 if (at_start.eq.0) then
1519 jat_start=first_atom-1+lower_index-int_index_old
1521 jat_start=first_atom
1523 if (lprn) write (iout,*) 'jat_start',jat_start
1524 if (int_index.ge.upper_index) then
1526 jat_end=first_atom-1+upper_index-int_index_old
1531 if (lprn) write (iout,*) 'jat_end',jat_end
1536 c------------------------------------------------------------------------------
1537 subroutine hpb_partition
1538 implicit real*8 (a-h,o-z)
1539 include 'DIMENSIONS'
1543 include 'COMMON.SBRIDGE'
1544 include 'COMMON.IOUNITS'
1545 include 'COMMON.SETUP'
1547 call int_bounds(nhpb,link_start,link_end)
1548 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1549 & ' absolute rank',MyRank,
1550 & ' nhpb',nhpb,' link_start=',link_start,
1551 & ' link_end',link_end
1558 c------------------------------------------------------------------------------
1559 subroutine homology_partition
1560 implicit real*8 (a-h,o-z)
1561 include 'DIMENSIONS'
1565 include 'COMMON.SBRIDGE'
1566 include 'COMMON.IOUNITS'
1567 include 'COMMON.SETUP'
1568 include 'COMMON.CONTROL'
1570 include 'COMMON.INTERACT'
1571 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1572 cd & " lim_dih",lim_dih
1574 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1575 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1576 call int_bounds(lim_dih,idihconstr_start_homo,
1577 & idihconstr_end_homo)
1578 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1579 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1580 if (me.eq.king .or. .not. out1file)
1581 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1582 & ' absolute rank',MyRank,
1583 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1584 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1585 & ' idihconstr_start_homo',idihconstr_start_homo,
1586 & ' idihconstr_end_homo',idihconstr_end_homo
1588 write (iout,*) "Not MPI"
1590 link_end_homo=lim_odl
1591 idihconstr_start_homo=nnt+3
1592 idihconstr_end_homo=lim_dih+nnt-1+3
1594 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1595 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1596 & ' idihconstr_start_homo',idihconstr_start_homo,
1597 & ' idihconstr_end_homo',idihconstr_end_homo
1601 c------------------------------------------------------------------------------
1602 subroutine NMRpeak_partition
1603 implicit real*8 (a-h,o-z)
1604 include 'DIMENSIONS'
1608 include 'COMMON.SBRIDGE'
1609 include 'COMMON.IOUNITS'
1610 include 'COMMON.SETUP'
1612 call int_bounds(npeak,link_start_peak,link_end_peak)
1613 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1614 & ' absolute rank',MyRank,
1615 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1616 & ' link_end_peak',link_end_peak