2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
123 C Lipidic input file for parameters range 60-79
125 C input file for transfer sidechain and peptide group inside the
126 C lipidic environment if lipid is implicite
128 C DNA input files for parameters range 80-99
129 C Suger input files for parameters range 100-119
130 C All-atom input files for parameters range 120-149
132 C Set default weights of the energy terms.
143 c print '(a,$)','Inside initialize'
144 c call memmon_print_usage()
179 athet(j,i,ichir1,ichir2)=0.0D0
180 bthet(j,i,ichir1,ichir2)=0.0D0
200 gaussc(l,k,j,i)=0.0D0
210 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
214 v1(k,j,i,iblock)=0.0D0
215 v2(k,j,i,iblock)=0.0D0
225 v1c(1,l,i,j,k,iblock)=0.0D0
226 v1s(1,l,i,j,k,iblock)=0.0D0
227 v1c(2,l,i,j,k,iblock)=0.0D0
228 v1s(2,l,i,j,k,iblock)=0.0D0
232 v2c(m,l,i,j,k,iblock)=0.0D0
233 v2s(m,l,i,j,k,iblock)=0.0D0
245 C Initialize the bridge arrays
259 C Initialize correlation arrays
290 C Initialize variables used in minimization.
299 C Initialize the variables responsible for the mode of gradient storage.
304 C Initialize constants used to split the energy into long- and short-range
310 nprint_ene=nprint_ene-1
314 c-------------------------------------------------------------------------
316 implicit real*8 (a-h,o-z)
318 include 'COMMON.NAMES'
319 include 'COMMON.FFIELD'
321 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
322 & 'DSG','DGN','DSN','DTH',
323 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
324 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
325 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
328 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
329 &'a','y','w','v','l','i','f','m','c','x',
330 &'C','M','F','I','L','V','W','Y','A','G','T',
331 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
332 data potname /'LJ','LJK','BP','GB','GBV'/
335 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
337 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ",
338 ! 15 16 17 18 19 20 21
339 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
340 ! 22 23 24 25 26 27 28
341 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD",
343 3 "WDFAT","WDFAN","WDFAB"/
377 #if defined(SCP14) && defined(SPLITELE)
379 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
380 & 24,15,26,27,28,29,30,31,22,23,25,20/
383 data print_order/1,2,18,3,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,0/
385 #elif defined(SPLITELE)
387 data print_order/1,2,3,16,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/
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,2*0/
395 #if defined(SCP14) && defined(SPLITELE)
397 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
398 & 24,15,26,27,22,23,25,20,4*0/
401 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
402 & 24,15,26,27,22,23,25,20,5*0/
403 #elif defined(SPLITELE)
405 data print_order/1,2,3,16,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/
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,6*0/
414 c---------------------------------------------------------------------------
415 subroutine init_int_table
416 implicit real*8 (a-h,o-z)
420 integer blocklengths(15),displs(15)
422 include 'COMMON.CONTROL'
423 include 'COMMON.SETUP'
424 include 'COMMON.CHAIN'
425 include 'COMMON.INTERACT'
426 include 'COMMON.LOCAL'
427 include 'COMMON.SBRIDGE'
428 include 'COMMON.TORCNSTR'
429 include 'COMMON.IOUNITS'
430 include 'COMMON.DERIV'
431 include 'COMMON.CONTACTS'
432 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
433 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
434 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
435 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
436 & ielend_all(maxres,0:max_fg_procs-1),
437 & ntask_cont_from_all(0:max_fg_procs-1),
438 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
439 & ntask_cont_to_all(0:max_fg_procs-1),
440 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
441 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
442 logical scheck,lprint,flag
444 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
445 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
446 C... Determine the numbers of start and end SC-SC interaction
447 C... to deal with by current processor.
449 itask_cont_from(i)=fg_rank
450 itask_cont_to(i)=fg_rank
454 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
455 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
456 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
458 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
459 & ' absolute rank',MyRank,
460 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
461 & ' my_sc_inde',my_sc_inde
481 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
482 cd & (ihpb(i),jhpb(i),i=1,nss)
487 if (ihpb(ii).eq.i+nres) then
494 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
498 c write (iout,*) 'jj=i+1'
499 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
500 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
506 else if (jj.eq.nct) then
508 c write (iout,*) 'jj=nct'
509 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
510 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
518 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
519 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
521 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
522 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
533 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
534 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
539 ind_scint=ind_scint+nct-i
543 ind_scint_old=ind_scint
551 if (iatsc_s.eq.0) iatsc_s=1
553 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
554 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
557 write (iout,'(a)') 'Interaction array:'
559 write (iout,'(i3,2(2x,2i3))')
560 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
565 C Now partition the electrostatic-interaction array
567 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
568 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
570 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
571 & ' absolute rank',MyRank,
572 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
573 & ' my_ele_inde',my_ele_inde
580 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
581 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
584 if (iatel_s.eq.0) iatel_s=1
585 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
586 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
587 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
588 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
589 c & " my_ele_inde_vdw",my_ele_inde_vdw
596 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
598 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
600 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
601 c & " ielend_vdw",ielend_vdw(i)
603 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
614 do i=iatel_s_vdw,iatel_e_vdw
620 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
621 & ' absolute rank',MyRank
622 write (iout,*) 'Electrostatic interaction array:'
624 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
629 C Partition the SC-p interaction array
631 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
632 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
633 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
634 & ' absolute rank',myrank,
635 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
636 & ' my_scp_inde',my_scp_inde
642 if (i.lt.nnt+iscp) then
643 cd write (iout,*) 'i.le.nnt+iscp'
644 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
645 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
647 else if (i.gt.nct-iscp) then
648 cd write (iout,*) 'i.gt.nct-iscp'
649 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
650 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
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,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
667 if (i.lt.nnt+iscp) then
669 iscpstart(i,1)=i+iscp
671 elseif (i.gt.nct-iscp) then
679 iscpstart(i,2)=i+iscp
684 if (iatscp_s.eq.0) iatscp_s=1
686 write (iout,'(a)') 'SC-p interaction array:'
687 do i=iatscp_s,iatscp_e
688 write (iout,'(i3,2(2x,2i3))')
689 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
692 C Partition local interactions
694 call int_bounds(nres-2,loc_start,loc_end)
695 loc_start=loc_start+1
697 call int_bounds(nres-2,ithet_start,ithet_end)
698 call int_bounds(nsaxs,isaxs_start,isaxs_end)
699 write (iout,*) me," isaxs_start",isaxs_start,
700 & " isaxs_end",isaxs_end
701 ithet_start=ithet_start+2
702 ithet_end=ithet_end+2
703 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
704 iturn3_start=iturn3_start+nnt
705 iphi_start=iturn3_start+2
706 iturn3_end=iturn3_end+nnt
707 iphi_end=iturn3_end+2
708 iturn3_start=iturn3_start-1
709 iturn3_end=iturn3_end-1
710 call int_bounds(nres-3,itau_start,itau_end)
711 itau_start=itau_start+3
713 call int_bounds(nres-3,iphi1_start,iphi1_end)
714 iphi1_start=iphi1_start+3
715 iphi1_end=iphi1_end+3
716 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
717 iturn4_start=iturn4_start+nnt
718 iphid_start=iturn4_start+2
719 iturn4_end=iturn4_end+nnt
720 iphid_end=iturn4_end+2
721 iturn4_start=iturn4_start-1
722 iturn4_end=iturn4_end-1
723 call int_bounds(nres-2,ibond_start,ibond_end)
724 ibond_start=ibond_start+1
725 ibond_end=ibond_end+1
726 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
727 ibondp_start=ibondp_start+nnt
728 ibondp_end=ibondp_end+nnt
729 call int_bounds(nres,ilip_start,ilip_end)
730 c ilip_start=ilip_start
731 call int_bounds1(nres-1,ivec_start,ivec_end)
732 c print *,"Processor",myrank,fg_rank,fg_rank1,
733 c & " ivec_start",ivec_start," ivec_end",ivec_end
734 iset_start=loc_start+2
736 if (ndih_constr.eq.0) then
740 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
742 if (ntheta_constr.eq.0) then
747 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
749 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
751 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
753 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
754 igrad_start=((2*nlen+1)
755 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
756 jgrad_start(igrad_start)=
757 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
759 jgrad_end(igrad_start)=nres
760 igrad_end=((2*nlen+1)
761 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
762 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
763 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
765 do i=igrad_start+1,igrad_end-1
770 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
771 & ' absolute rank',myrank,
772 & ' loc_start',loc_start,' loc_end',loc_end,
773 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
774 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
775 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
776 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
777 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
778 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
779 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
780 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
781 & ' iset_start',iset_start,' iset_end',iset_end,
782 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
784 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
787 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
788 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
789 & ' ngrad_end',ngrad_end
790 do i=igrad_start,igrad_end
791 write(*,*) 'Processor:',fg_rank,myrank,i,
792 & jgrad_start(i),jgrad_end(i)
795 if (nfgtasks.gt.1) then
796 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
797 & MPI_INTEGER,FG_COMM1,IERROR)
798 iaux=ivec_end-ivec_start+1
799 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
800 & MPI_INTEGER,FG_COMM1,IERROR)
801 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
802 & MPI_INTEGER,FG_COMM,IERROR)
803 iaux=iset_end-iset_start+1
804 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
805 & MPI_INTEGER,FG_COMM,IERROR)
806 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
807 & MPI_INTEGER,FG_COMM,IERROR)
808 iaux=ibond_end-ibond_start+1
809 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
810 & MPI_INTEGER,FG_COMM,IERROR)
811 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
812 & MPI_INTEGER,FG_COMM,IERROR)
813 iaux=ithet_end-ithet_start+1
814 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
815 & MPI_INTEGER,FG_COMM,IERROR)
816 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
817 & MPI_INTEGER,FG_COMM,IERROR)
818 iaux=iphi_end-iphi_start+1
819 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
820 & MPI_INTEGER,FG_COMM,IERROR)
821 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
822 & MPI_INTEGER,FG_COMM,IERROR)
823 iaux=iphi1_end-iphi1_start+1
824 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
825 & MPI_INTEGER,FG_COMM,IERROR)
826 do i=0,max_fg_procs-1
832 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
833 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
834 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
835 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
836 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
837 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
838 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
839 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
840 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
841 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
842 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
843 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
844 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
845 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
846 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
847 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
849 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
850 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
851 write (iout,*) "iturn3_start_all",
852 & (iturn3_start_all(i),i=0,nfgtasks-1)
853 write (iout,*) "iturn3_end_all",
854 & (iturn3_end_all(i),i=0,nfgtasks-1)
855 write (iout,*) "iturn4_start_all",
856 & (iturn4_start_all(i),i=0,nfgtasks-1)
857 write (iout,*) "iturn4_end_all",
858 & (iturn4_end_all(i),i=0,nfgtasks-1)
859 write (iout,*) "The ielstart_all array"
861 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
863 write (iout,*) "The ielend_all array"
865 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
871 itask_cont_from(0)=fg_rank
872 itask_cont_to(0)=fg_rank
874 do ii=iturn3_start,iturn3_end
875 call add_int(ii,ii+2,iturn3_sent(1,ii),
876 & ntask_cont_to,itask_cont_to,flag)
878 do ii=iturn4_start,iturn4_end
879 call add_int(ii,ii+3,iturn4_sent(1,ii),
880 & ntask_cont_to,itask_cont_to,flag)
882 do ii=iturn3_start,iturn3_end
883 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
885 do ii=iturn4_start,iturn4_end
886 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
889 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
890 & " ntask_cont_to",ntask_cont_to
891 write (iout,*) "itask_cont_from",
892 & (itask_cont_from(i),i=1,ntask_cont_from)
893 write (iout,*) "itask_cont_to",
894 & (itask_cont_to(i),i=1,ntask_cont_to)
897 c write (iout,*) "Loop forward"
900 c write (iout,*) "from loop i=",i
902 do j=ielstart(i),ielend(i)
903 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
906 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
907 c & " iatel_e",iatel_e
911 c write (iout,*) "i",i," ielstart",ielstart(i),
912 c & " ielend",ielend(i)
915 do j=ielstart(i),ielend(i)
916 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
917 & itask_cont_to,flag)
925 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
926 & " ntask_cont_to",ntask_cont_to
927 write (iout,*) "itask_cont_from",
928 & (itask_cont_from(i),i=1,ntask_cont_from)
929 write (iout,*) "itask_cont_to",
930 & (itask_cont_to(i),i=1,ntask_cont_to)
932 write (iout,*) "iint_sent"
935 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
936 & j=ielstart(ii),ielend(ii))
938 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
939 & " iturn3_end",iturn3_end
940 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
941 & i=iturn3_start,iturn3_end)
942 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
943 & " iturn4_end",iturn4_end
944 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
945 & i=iturn4_start,iturn4_end)
948 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
949 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
950 c write (iout,*) "Gather ntask_cont_from ended"
952 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
953 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
955 c write (iout,*) "Gather itask_cont_from ended"
957 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
958 & 1,MPI_INTEGER,king,FG_COMM,IERR)
959 c write (iout,*) "Gather ntask_cont_to ended"
961 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
962 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
963 c write (iout,*) "Gather itask_cont_to ended"
965 if (fg_rank.eq.king) then
966 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
968 write (iout,'(20i4)') i,ntask_cont_from_all(i),
969 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
973 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
975 write (iout,'(20i4)') i,ntask_cont_to_all(i),
976 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
980 C Check if every send will have a matching receive
984 ncheck_to=ncheck_to+ntask_cont_to_all(i)
985 ncheck_from=ncheck_from+ntask_cont_from_all(i)
987 write (iout,*) "Control sums",ncheck_from,ncheck_to
988 if (ncheck_from.ne.ncheck_to) then
989 write (iout,*) "Error: #receive differs from #send."
990 write (iout,*) "Terminating program...!"
996 do j=1,ntask_cont_to_all(i)
997 ii=itask_cont_to_all(j,i)
998 do k=1,ntask_cont_from_all(ii)
999 if (itask_cont_from_all(k,ii).eq.i) then
1000 if(lprint)write(iout,*)"Matching send/receive",i,ii
1004 if (k.eq.ntask_cont_from_all(ii)+1) then
1006 write (iout,*) "Error: send by",j," to",ii,
1007 & " would have no matching receive"
1013 write (iout,*) "Unmatched sends; terminating program"
1017 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1018 c write (iout,*) "flag broadcast ended flag=",flag
1021 call MPI_Finalize(IERROR)
1022 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1024 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1025 c write (iout,*) "MPI_Comm_group ended"
1027 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1028 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1029 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1030 & CONT_TO_GROUP,IERR)
1033 iaux=4*(ielend(ii)-ielstart(ii)+1)
1034 call MPI_Group_translate_ranks(fg_group,iaux,
1035 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1036 & iint_sent_local(1,ielstart(ii),i),IERR )
1037 c write (iout,*) "Ranks translated i=",i
1040 iaux=4*(iturn3_end-iturn3_start+1)
1041 call MPI_Group_translate_ranks(fg_group,iaux,
1042 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1043 & iturn3_sent_local(1,iturn3_start),IERR)
1044 iaux=4*(iturn4_end-iturn4_start+1)
1045 call MPI_Group_translate_ranks(fg_group,iaux,
1046 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1047 & iturn4_sent_local(1,iturn4_start),IERR)
1049 write (iout,*) "iint_sent_local"
1052 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1053 & j=ielstart(ii),ielend(ii))
1056 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1057 & " iturn3_end",iturn3_end
1058 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1059 & i=iturn3_start,iturn3_end)
1060 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1061 & " iturn4_end",iturn4_end
1062 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1063 & i=iturn4_start,iturn4_end)
1066 call MPI_Group_free(fg_group,ierr)
1067 call MPI_Group_free(cont_from_group,ierr)
1068 call MPI_Group_free(cont_to_group,ierr)
1069 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1070 call MPI_Type_commit(MPI_UYZ,IERROR)
1071 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1073 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1074 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1075 call MPI_Type_commit(MPI_MU,IERROR)
1076 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1077 call MPI_Type_commit(MPI_MAT1,IERROR)
1078 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1079 call MPI_Type_commit(MPI_MAT2,IERROR)
1080 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1081 call MPI_Type_commit(MPI_THET,IERROR)
1082 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1083 call MPI_Type_commit(MPI_GAM,IERROR)
1085 c 9/22/08 Derived types to send matrices which appear in correlation terms
1087 if (ivec_count(i).eq.ivec_count(0)) then
1093 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1094 if (ind_typ.eq.0) then
1095 ichunk=ivec_count(0)
1097 ichunk=ivec_count(1)
1104 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1107 c blocklengths(i)=blocklengths(i)*ichunk
1109 c write (iout,*) "blocklengths and displs"
1111 c write (iout,*) i,blocklengths(i),displs(i)
1114 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1115 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1116 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1117 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1123 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1126 c blocklengths(i)=blocklengths(i)*ichunk
1128 c write (iout,*) "blocklengths and displs"
1130 c write (iout,*) i,blocklengths(i),displs(i)
1133 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1134 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1135 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1136 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1142 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1145 blocklengths(i)=blocklengths(i)*ichunk
1147 call MPI_Type_indexed(8,blocklengths,displs,
1148 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1149 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1155 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1158 blocklengths(i)=blocklengths(i)*ichunk
1160 call MPI_Type_indexed(8,blocklengths,displs,
1161 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1162 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1168 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1171 blocklengths(i)=blocklengths(i)*ichunk
1173 call MPI_Type_indexed(6,blocklengths,displs,
1174 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1175 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1181 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1184 blocklengths(i)=blocklengths(i)*ichunk
1186 call MPI_Type_indexed(2,blocklengths,displs,
1187 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1188 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1194 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1197 blocklengths(i)=blocklengths(i)*ichunk
1199 call MPI_Type_indexed(4,blocklengths,displs,
1200 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1201 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1205 iint_start=ivec_start+1
1208 iint_count(i)=ivec_count(i)
1209 iint_displ(i)=ivec_displ(i)
1210 ivec_displ(i)=ivec_displ(i)-1
1211 iset_displ(i)=iset_displ(i)-1
1212 ithet_displ(i)=ithet_displ(i)-1
1213 iphi_displ(i)=iphi_displ(i)-1
1214 iphi1_displ(i)=iphi1_displ(i)-1
1215 ibond_displ(i)=ibond_displ(i)-1
1217 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1218 & .and. (me.eq.0 .or. .not. out1file)) then
1219 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1221 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1224 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1225 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1226 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1228 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1231 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1232 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1233 & ' SC-p interactions','were distributed among',nfgtasks,
1234 & ' fine-grain processors.'
1250 idihconstr_end=ndih_constr
1251 ithetaconstr_start=1
1252 ithetaconstr_end=ntheta_constr
1253 iphid_start=iphi_start
1254 iphid_end=iphi_end-1
1276 c---------------------------------------------------------------------------
1277 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1279 include "DIMENSIONS"
1280 include "COMMON.INTERACT"
1281 include "COMMON.SETUP"
1282 include "COMMON.IOUNITS"
1283 integer ii,jj,itask(4),ntask_cont_to,
1284 &itask_cont_to(0:max_fg_procs-1)
1286 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1287 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1288 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1289 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1290 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1291 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1292 & ielend_all(maxres,0:max_fg_procs-1)
1293 integer iproc,isent,k,l
1294 c Determines whether to send interaction ii,jj to other processors; a given
1295 c interaction can be sent to at most 2 processors.
1296 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1297 c one processor, otherwise flag is unchanged from the input value.
1303 c write (iout,*) "ii",ii," jj",jj
1304 c Loop over processors to check if anybody could need interaction ii,jj
1305 do iproc=0,fg_rank-1
1306 c Check if the interaction matches any turn3 at iproc
1307 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1309 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1310 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1312 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1315 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1316 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1319 call add_task(iproc,ntask_cont_to,itask_cont_to)
1323 C Check if the interaction matches any turn4 at iproc
1324 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1326 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1327 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1329 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1332 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1333 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1336 call add_task(iproc,ntask_cont_to,itask_cont_to)
1340 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1341 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1342 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1343 & ielend_all(ii-1,iproc).ge.jj-1) then
1345 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1346 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1349 call add_task(iproc,ntask_cont_to,itask_cont_to)
1352 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1353 & ielend_all(ii-1,iproc).ge.jj+1) then
1355 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1356 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1359 call add_task(iproc,ntask_cont_to,itask_cont_to)
1366 c---------------------------------------------------------------------------
1367 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1369 include "DIMENSIONS"
1370 include "COMMON.INTERACT"
1371 include "COMMON.SETUP"
1372 include "COMMON.IOUNITS"
1373 integer ii,jj,itask(2),ntask_cont_from,
1374 & itask_cont_from(0:max_fg_procs-1)
1376 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1377 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1378 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1379 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1380 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1381 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1382 & ielend_all(maxres,0:max_fg_procs-1)
1384 do iproc=fg_rank+1,nfgtasks-1
1385 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1387 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1388 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1390 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1391 call add_task(iproc,ntask_cont_from,itask_cont_from)
1394 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1396 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1397 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1399 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1400 call add_task(iproc,ntask_cont_from,itask_cont_from)
1403 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1404 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1406 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1407 & jj+1.le.ielend_all(ii+1,iproc)) then
1408 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1415 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1417 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1418 & jj-1.le.ielend_all(ii-1,iproc)) then
1419 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1430 c---------------------------------------------------------------------------
1431 subroutine add_task(iproc,ntask_cont,itask_cont)
1433 include "DIMENSIONS"
1434 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1437 if (itask_cont(ii).eq.iproc) return
1439 ntask_cont=ntask_cont+1
1440 itask_cont(ntask_cont)=iproc
1443 c---------------------------------------------------------------------------
1444 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1445 implicit real*8 (a-h,o-z)
1446 include 'DIMENSIONS'
1448 include 'COMMON.SETUP'
1449 integer total_ints,lower_bound,upper_bound
1450 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1451 nint=total_ints/nfgtasks
1455 nexcess=total_ints-nint*nfgtasks
1457 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1461 lower_bound=lower_bound+int4proc(i)
1463 upper_bound=lower_bound+int4proc(fg_rank)
1464 lower_bound=lower_bound+1
1467 c---------------------------------------------------------------------------
1468 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1469 implicit real*8 (a-h,o-z)
1470 include 'DIMENSIONS'
1472 include 'COMMON.SETUP'
1473 integer total_ints,lower_bound,upper_bound
1474 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1475 nint=total_ints/nfgtasks1
1479 nexcess=total_ints-nint*nfgtasks1
1481 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1485 lower_bound=lower_bound+int4proc(i)
1487 upper_bound=lower_bound+int4proc(fg_rank1)
1488 lower_bound=lower_bound+1
1491 c---------------------------------------------------------------------------
1492 subroutine int_partition(int_index,lower_index,upper_index,atom,
1493 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1494 implicit real*8 (a-h,o-z)
1495 include 'DIMENSIONS'
1496 include 'COMMON.IOUNITS'
1497 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1498 & first_atom,last_atom,int_gr,jat_start,jat_end
1501 if (lprn) write (iout,*) 'int_index=',int_index
1502 int_index_old=int_index
1503 int_index=int_index+last_atom-first_atom+1
1505 & write (iout,*) 'int_index=',int_index,
1506 & ' int_index_old',int_index_old,
1507 & ' lower_index=',lower_index,
1508 & ' upper_index=',upper_index,
1509 & ' atom=',atom,' first_atom=',first_atom,
1510 & ' last_atom=',last_atom
1511 if (int_index.ge.lower_index) then
1513 if (at_start.eq.0) then
1515 jat_start=first_atom-1+lower_index-int_index_old
1517 jat_start=first_atom
1519 if (lprn) write (iout,*) 'jat_start',jat_start
1520 if (int_index.ge.upper_index) then
1522 jat_end=first_atom-1+upper_index-int_index_old
1527 if (lprn) write (iout,*) 'jat_end',jat_end
1532 c------------------------------------------------------------------------------
1533 subroutine hpb_partition
1534 implicit real*8 (a-h,o-z)
1535 include 'DIMENSIONS'
1539 include 'COMMON.SBRIDGE'
1540 include 'COMMON.IOUNITS'
1541 include 'COMMON.SETUP'
1543 call int_bounds(nhpb,link_start,link_end)
1544 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1545 & ' absolute rank',MyRank,
1546 & ' nhpb',nhpb,' link_start=',link_start,
1547 & ' link_end',link_end
1554 c------------------------------------------------------------------------------
1555 subroutine homology_partition
1556 implicit real*8 (a-h,o-z)
1557 include 'DIMENSIONS'
1561 include 'COMMON.SBRIDGE'
1562 include 'COMMON.IOUNITS'
1563 include 'COMMON.SETUP'
1564 include 'COMMON.CONTROL'
1566 include 'COMMON.INTERACT'
1567 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1568 cd & " lim_dih",lim_dih
1570 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1571 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1572 call int_bounds(lim_dih,idihconstr_start_homo,
1573 & idihconstr_end_homo)
1574 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1575 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1576 if (me.eq.king .or. .not. out1file)
1577 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1578 & ' absolute rank',MyRank,
1579 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1580 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1581 & ' idihconstr_start_homo',idihconstr_start_homo,
1582 & ' idihconstr_end_homo',idihconstr_end_homo
1584 write (iout,*) "Not MPI"
1586 link_end_homo=lim_odl
1587 idihconstr_start_homo=nnt+3
1588 idihconstr_end_homo=lim_dih+nnt-1+3
1590 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1591 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1592 & ' idihconstr_start_homo',idihconstr_start_homo,
1593 & ' idihconstr_end_homo',idihconstr_end_homo
1597 c------------------------------------------------------------------------------
1598 subroutine NMRpeak_partition
1599 implicit real*8 (a-h,o-z)
1600 include 'DIMENSIONS'
1604 include 'COMMON.SBRIDGE'
1605 include 'COMMON.IOUNITS'
1606 include 'COMMON.SETUP'
1608 call int_bounds(npeak,link_start_peak,link_end_peak)
1609 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1610 & ' absolute rank',MyRank,
1611 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1612 & ' link_end_peak',link_end_peak