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'
48 c Common blocks from the diagonalization routines
49 integer IR,IW,IP,IJK,IPK,IDAF,NAV,IODA,KDIAG,ICORFL,IXDR
50 integer i,idumm,j,k,l,ichir1,ichir2,iblock,m
52 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
53 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
55 c real*8 text1 /'initial_i'/
73 C The following is just to define auxiliary variables used in angle conversion
112 crc for write_rmsbank1
114 cdr include secondary structure prediction bias
117 C CSA I/O units (separated from others especially for Jooyoung)
128 icsa_bank_reminimized=38
131 crc for ifc error 118
134 C Lipidic input file for parameters range 60-79
136 C input file for transfer sidechain and peptide group inside the
137 C lipidic environment if lipid is implicite
139 C DNA input files for parameters range 80-99
140 C Sugar input files for parameters range 100-119
141 C All-atom input files for parameters range 120-149
143 C Set default weights of the energy terms.
154 c print '(a,$)','Inside initialize'
155 c call memmon_print_usage()
190 athet(j,i,ichir1,ichir2)=0.0D0
191 bthet(j,i,ichir1,ichir2)=0.0D0
211 gaussc(l,k,j,i)=0.0D0
221 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
225 v1(k,j,i,iblock)=0.0D0
226 v2(k,j,i,iblock)=0.0D0
236 v1c(1,l,i,j,k,iblock)=0.0D0
237 v1s(1,l,i,j,k,iblock)=0.0D0
238 v1c(2,l,i,j,k,iblock)=0.0D0
239 v1s(2,l,i,j,k,iblock)=0.0D0
243 v2c(m,l,i,j,k,iblock)=0.0D0
244 v2s(m,l,i,j,k,iblock)=0.0D0
256 C Initialize the bridge arrays
270 C Initialize correlation arrays
301 C Initialize variables used in minimization.
310 C Initialize the variables responsible for the mode of gradient storage.
315 C Initialize constants used to split the energy into long- and short-range
321 nprint_ene=nprint_ene-1
325 c-------------------------------------------------------------------------
329 include 'COMMON.NAMES'
330 include 'COMMON.FFIELD'
332 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
333 & 'DSG','DGN','DSN','DTH',
334 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
335 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
336 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
339 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
340 &'a','y','w','v','l','i','f','m','c','x',
341 &'C','M','F','I','L','V','W','Y','A','G','T',
342 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
343 data potname /'LJ','LJK','BP','GB','GBV'/
346 1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
348 8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ",
349 ! 15 16 17 18 19 20 21
350 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
351 ! 22 23 24 25 26 27 28
352 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD",
354 3 "WDFAT","WDFAN","WDFAB"/
388 #if defined(SCP14) && defined(SPLITELE)
390 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
391 & 24,15,26,27,28,29,30,31,22,23,25,20/
394 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
395 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
396 #elif defined(SPLITELE)
398 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
399 & 24,15,26,27,28,29,30,31,22,23,25,20,0/
402 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
403 & 24,15,26,27,28,29,30,31,22,23,25,20,2*0/
406 #if defined(SCP14) && defined(SPLITELE)
408 data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
409 & 24,15,26,27,22,23,25,20,4*0/
412 data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
413 & 24,15,26,27,22,23,25,20,5*0/
414 #elif defined(SPLITELE)
416 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
417 & 24,15,26,27,22,23,25,20,5*0/
420 data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
421 & 24,15,26,27,22,23,25,20,6*0/
425 c---------------------------------------------------------------------------
426 subroutine init_int_table
432 integer blocklengths(15),displs(15)
434 include 'COMMON.CONTROL'
435 include 'COMMON.SAXS'
436 include 'COMMON.SETUP'
437 include 'COMMON.CHAIN'
438 include 'COMMON.INTERACT'
439 include 'COMMON.LOCAL'
440 include 'COMMON.SBRIDGE'
441 include 'COMMON.TORCNSTR'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.DERIV'
444 include 'COMMON.CONTACTS'
445 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
446 & iturn4_end_all,iatel_s_all,
447 & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
448 & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all,
449 & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
450 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
451 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
452 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
453 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
454 & ielend_all(maxres,0:max_fg_procs-1),
455 & ntask_cont_from_all(0:max_fg_procs-1),
456 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
457 & ntask_cont_to_all(0:max_fg_procs-1),
458 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
459 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
460 logical scheck,lprint,flag
461 integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint,
462 & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
463 & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
464 & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
465 & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
466 & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
468 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
469 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
470 C... Determine the numbers of start and end SC-SC interaction
471 C... to deal with by current processor.
473 itask_cont_from(i)=fg_rank
474 itask_cont_to(i)=fg_rank
478 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
479 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
480 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
482 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
483 & ' absolute rank',MyRank,
484 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
485 & ' my_sc_inde',my_sc_inde
505 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
506 cd & (ihpb(i),jhpb(i),i=1,nss)
511 if (ihpb(ii).eq.i+nres) then
518 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
522 c write (iout,*) 'jj=i+1'
523 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
524 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
530 else if (jj.eq.nct) then
532 c write (iout,*) 'jj=nct'
533 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
534 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
542 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
543 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
545 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
546 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
557 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
558 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
563 ind_scint=ind_scint+nct-i
567 ind_scint_old=ind_scint
575 if (iatsc_s.eq.0) iatsc_s=1
577 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
578 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
581 write (iout,'(a)') 'Interaction array:'
583 write (iout,'(i3,2(2x,2i3))')
584 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
589 C Now partition the electrostatic-interaction array
591 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
592 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
594 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
595 & ' absolute rank',MyRank,
596 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
597 & ' my_ele_inde',my_ele_inde
604 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
605 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
608 if (iatel_s.eq.0) iatel_s=1
609 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
610 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
611 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
612 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
613 c & " my_ele_inde_vdw",my_ele_inde_vdw
620 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
622 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
624 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
625 c & " ielend_vdw",ielend_vdw(i)
627 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
638 do i=iatel_s_vdw,iatel_e_vdw
644 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
645 & ' absolute rank',MyRank
646 write (iout,*) 'Electrostatic interaction array:'
648 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
653 C Partition the SC-p interaction array
655 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
656 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
657 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
658 & ' absolute rank',myrank,
659 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
660 & ' my_scp_inde',my_scp_inde
666 if (i.lt.nnt+iscp) then
667 cd write (iout,*) 'i.le.nnt+iscp'
668 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
669 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
671 else if (i.gt.nct-iscp) then
672 cd write (iout,*) 'i.gt.nct-iscp'
673 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
674 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
677 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
678 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
681 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
682 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
691 if (i.lt.nnt+iscp) then
693 iscpstart(i,1)=i+iscp
695 elseif (i.gt.nct-iscp) then
703 iscpstart(i,2)=i+iscp
708 if (iatscp_s.eq.0) iatscp_s=1
710 write (iout,'(a)') 'SC-p interaction array:'
711 do i=iatscp_s,iatscp_e
712 write (iout,'(i3,2(2x,2i3))')
713 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
716 C Partition local interactions
718 call int_bounds(nres-2,loc_start,loc_end)
719 loc_start=loc_start+1
721 call int_bounds(nres-2,ithet_start,ithet_end)
722 call int_bounds(nsaxs,isaxs_start,isaxs_end)
723 write (iout,*) me," isaxs_start",isaxs_start,
724 & " isaxs_end",isaxs_end
725 ithet_start=ithet_start+2
726 ithet_end=ithet_end+2
727 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
728 iturn3_start=iturn3_start+nnt
729 iphi_start=iturn3_start+2
730 iturn3_end=iturn3_end+nnt
731 iphi_end=iturn3_end+2
732 iturn3_start=iturn3_start-1
733 iturn3_end=iturn3_end-1
734 call int_bounds(nres-3,itau_start,itau_end)
735 itau_start=itau_start+3
737 call int_bounds(nres-3,iphi1_start,iphi1_end)
738 iphi1_start=iphi1_start+3
739 iphi1_end=iphi1_end+3
740 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
741 iturn4_start=iturn4_start+nnt
742 iphid_start=iturn4_start+2
743 iturn4_end=iturn4_end+nnt
744 iphid_end=iturn4_end+2
745 iturn4_start=iturn4_start-1
746 iturn4_end=iturn4_end-1
747 call int_bounds(nres-2,ibond_start,ibond_end)
748 ibond_start=ibond_start+1
749 ibond_end=ibond_end+1
750 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
751 ibondp_start=ibondp_start+nnt
752 ibondp_end=ibondp_end+nnt
753 call int_bounds(nres,ilip_start,ilip_end)
754 c ilip_start=ilip_start
755 call int_bounds1(nres-1,ivec_start,ivec_end)
756 c print *,"Processor",myrank,fg_rank,fg_rank1,
757 c & " ivec_start",ivec_start," ivec_end",ivec_end
758 iset_start=loc_start+2
760 if (ndih_constr.eq.0) then
764 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
766 if (ntheta_constr.eq.0) then
771 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
773 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
775 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
777 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
778 igrad_start=((2*nlen+1)
779 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
780 jgrad_start(igrad_start)=
781 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
783 jgrad_end(igrad_start)=nres
784 igrad_end=((2*nlen+1)
785 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
786 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
787 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
789 do i=igrad_start+1,igrad_end-1
794 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
795 & ' absolute rank',myrank,
796 & ' loc_start',loc_start,' loc_end',loc_end,
797 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
798 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
799 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
800 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
801 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
802 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
803 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
804 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
805 & ' iset_start',iset_start,' iset_end',iset_end,
806 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
808 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
811 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
812 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
813 & ' ngrad_end',ngrad_end
814 do i=igrad_start,igrad_end
815 write(*,*) 'Processor:',fg_rank,myrank,i,
816 & jgrad_start(i),jgrad_end(i)
819 if (nfgtasks.gt.1) then
820 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
821 & MPI_INTEGER,FG_COMM1,IERROR)
822 iaux=ivec_end-ivec_start+1
823 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
824 & MPI_INTEGER,FG_COMM1,IERROR)
825 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
826 & MPI_INTEGER,FG_COMM,IERROR)
827 iaux=iset_end-iset_start+1
828 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
829 & MPI_INTEGER,FG_COMM,IERROR)
830 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
831 & MPI_INTEGER,FG_COMM,IERROR)
832 iaux=ibond_end-ibond_start+1
833 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
834 & MPI_INTEGER,FG_COMM,IERROR)
835 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
836 & MPI_INTEGER,FG_COMM,IERROR)
837 iaux=ithet_end-ithet_start+1
838 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
839 & MPI_INTEGER,FG_COMM,IERROR)
840 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
841 & MPI_INTEGER,FG_COMM,IERROR)
842 iaux=iphi_end-iphi_start+1
843 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
844 & MPI_INTEGER,FG_COMM,IERROR)
845 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
846 & MPI_INTEGER,FG_COMM,IERROR)
847 iaux=iphi1_end-iphi1_start+1
848 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
849 & MPI_INTEGER,FG_COMM,IERROR)
850 do i=0,max_fg_procs-1
856 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
857 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
858 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
859 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
860 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
861 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
862 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
863 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
864 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
865 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
866 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
867 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
868 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
869 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
870 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
871 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
873 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
874 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
875 write (iout,*) "iturn3_start_all",
876 & (iturn3_start_all(i),i=0,nfgtasks-1)
877 write (iout,*) "iturn3_end_all",
878 & (iturn3_end_all(i),i=0,nfgtasks-1)
879 write (iout,*) "iturn4_start_all",
880 & (iturn4_start_all(i),i=0,nfgtasks-1)
881 write (iout,*) "iturn4_end_all",
882 & (iturn4_end_all(i),i=0,nfgtasks-1)
883 write (iout,*) "The ielstart_all array"
885 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
887 write (iout,*) "The ielend_all array"
889 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
895 itask_cont_from(0)=fg_rank
896 itask_cont_to(0)=fg_rank
898 do ii=iturn3_start,iturn3_end
899 call add_int(ii,ii+2,iturn3_sent(1,ii),
900 & ntask_cont_to,itask_cont_to,flag)
902 do ii=iturn4_start,iturn4_end
903 call add_int(ii,ii+3,iturn4_sent(1,ii),
904 & ntask_cont_to,itask_cont_to,flag)
906 do ii=iturn3_start,iturn3_end
907 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
909 do ii=iturn4_start,iturn4_end
910 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
913 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
914 & " ntask_cont_to",ntask_cont_to
915 write (iout,*) "itask_cont_from",
916 & (itask_cont_from(i),i=1,ntask_cont_from)
917 write (iout,*) "itask_cont_to",
918 & (itask_cont_to(i),i=1,ntask_cont_to)
921 c write (iout,*) "Loop forward"
924 c write (iout,*) "from loop i=",i
926 do j=ielstart(i),ielend(i)
927 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
930 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
931 c & " iatel_e",iatel_e
935 c write (iout,*) "i",i," ielstart",ielstart(i),
936 c & " ielend",ielend(i)
939 do j=ielstart(i),ielend(i)
940 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
941 & itask_cont_to,flag)
949 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
950 & " ntask_cont_to",ntask_cont_to
951 write (iout,*) "itask_cont_from",
952 & (itask_cont_from(i),i=1,ntask_cont_from)
953 write (iout,*) "itask_cont_to",
954 & (itask_cont_to(i),i=1,ntask_cont_to)
956 write (iout,*) "iint_sent"
959 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
960 & j=ielstart(ii),ielend(ii))
962 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
963 & " iturn3_end",iturn3_end
964 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
965 & i=iturn3_start,iturn3_end)
966 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
967 & " iturn4_end",iturn4_end
968 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
969 & i=iturn4_start,iturn4_end)
972 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
973 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
974 c write (iout,*) "Gather ntask_cont_from ended"
976 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
977 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
979 c write (iout,*) "Gather itask_cont_from ended"
981 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
982 & 1,MPI_INTEGER,king,FG_COMM,IERR)
983 c write (iout,*) "Gather ntask_cont_to ended"
985 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
986 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
987 c write (iout,*) "Gather itask_cont_to ended"
989 if (fg_rank.eq.king) then
990 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
992 write (iout,'(20i4)') i,ntask_cont_from_all(i),
993 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
997 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
999 write (iout,'(20i4)') i,ntask_cont_to_all(i),
1000 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1004 C Check if every send will have a matching receive
1008 ncheck_to=ncheck_to+ntask_cont_to_all(i)
1009 ncheck_from=ncheck_from+ntask_cont_from_all(i)
1011 write (iout,*) "Control sums",ncheck_from,ncheck_to
1012 if (ncheck_from.ne.ncheck_to) then
1013 write (iout,*) "Error: #receive differs from #send."
1014 write (iout,*) "Terminating program...!"
1020 do j=1,ntask_cont_to_all(i)
1021 ii=itask_cont_to_all(j,i)
1022 do k=1,ntask_cont_from_all(ii)
1023 if (itask_cont_from_all(k,ii).eq.i) then
1024 if(lprint)write(iout,*)"Matching send/receive",i,ii
1028 if (k.eq.ntask_cont_from_all(ii)+1) then
1030 write (iout,*) "Error: send by",j," to",ii,
1031 & " would have no matching receive"
1037 write (iout,*) "Unmatched sends; terminating program"
1041 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1042 c write (iout,*) "flag broadcast ended flag=",flag
1045 call MPI_Finalize(IERROR)
1046 stop "Error in INIT_INT_TABLE: unmatched send/receive."
1048 call MPI_Comm_group(FG_COMM,fg_group,IERR)
1049 c write (iout,*) "MPI_Comm_group ended"
1051 call MPI_Group_incl(fg_group,ntask_cont_from+1,
1052 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
1053 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1054 & CONT_TO_GROUP,IERR)
1057 iaux=4*(ielend(ii)-ielstart(ii)+1)
1058 call MPI_Group_translate_ranks(fg_group,iaux,
1059 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1060 & iint_sent_local(1,ielstart(ii),i),IERR )
1061 c write (iout,*) "Ranks translated i=",i
1064 iaux=4*(iturn3_end-iturn3_start+1)
1065 call MPI_Group_translate_ranks(fg_group,iaux,
1066 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1067 & iturn3_sent_local(1,iturn3_start),IERR)
1068 iaux=4*(iturn4_end-iturn4_start+1)
1069 call MPI_Group_translate_ranks(fg_group,iaux,
1070 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1071 & iturn4_sent_local(1,iturn4_start),IERR)
1073 write (iout,*) "iint_sent_local"
1076 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1077 & j=ielstart(ii),ielend(ii))
1080 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1081 & " iturn3_end",iturn3_end
1082 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1083 & i=iturn3_start,iturn3_end)
1084 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1085 & " iturn4_end",iturn4_end
1086 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1087 & i=iturn4_start,iturn4_end)
1090 call MPI_Group_free(fg_group,ierr)
1091 call MPI_Group_free(cont_from_group,ierr)
1092 call MPI_Group_free(cont_to_group,ierr)
1093 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1094 call MPI_Type_commit(MPI_UYZ,IERROR)
1095 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1097 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1098 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1099 call MPI_Type_commit(MPI_MU,IERROR)
1100 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1101 call MPI_Type_commit(MPI_MAT1,IERROR)
1102 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1103 call MPI_Type_commit(MPI_MAT2,IERROR)
1104 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1105 call MPI_Type_commit(MPI_THET,IERROR)
1106 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1107 call MPI_Type_commit(MPI_GAM,IERROR)
1109 c 9/22/08 Derived types to send matrices which appear in correlation terms
1111 if (ivec_count(i).eq.ivec_count(0)) then
1117 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1118 if (ind_typ.eq.0) then
1119 ichunk=ivec_count(0)
1121 ichunk=ivec_count(1)
1128 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1131 c blocklengths(i)=blocklengths(i)*ichunk
1133 c write (iout,*) "blocklengths and displs"
1135 c write (iout,*) i,blocklengths(i),displs(i)
1138 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1139 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1140 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1141 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1147 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1150 c blocklengths(i)=blocklengths(i)*ichunk
1152 c write (iout,*) "blocklengths and displs"
1154 c write (iout,*) i,blocklengths(i),displs(i)
1157 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1158 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1159 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1160 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1166 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1169 blocklengths(i)=blocklengths(i)*ichunk
1171 call MPI_Type_indexed(8,blocklengths,displs,
1172 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1173 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1179 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1182 blocklengths(i)=blocklengths(i)*ichunk
1184 call MPI_Type_indexed(8,blocklengths,displs,
1185 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1186 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1192 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1195 blocklengths(i)=blocklengths(i)*ichunk
1197 call MPI_Type_indexed(6,blocklengths,displs,
1198 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1199 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1205 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1208 blocklengths(i)=blocklengths(i)*ichunk
1210 call MPI_Type_indexed(2,blocklengths,displs,
1211 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1212 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1218 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1221 blocklengths(i)=blocklengths(i)*ichunk
1223 call MPI_Type_indexed(4,blocklengths,displs,
1224 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1225 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1229 iint_start=ivec_start+1
1232 iint_count(i)=ivec_count(i)
1233 iint_displ(i)=ivec_displ(i)
1234 ivec_displ(i)=ivec_displ(i)-1
1235 iset_displ(i)=iset_displ(i)-1
1236 ithet_displ(i)=ithet_displ(i)-1
1237 iphi_displ(i)=iphi_displ(i)-1
1238 iphi1_displ(i)=iphi1_displ(i)-1
1239 ibond_displ(i)=ibond_displ(i)-1
1241 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1242 & .and. (me.eq.0 .or. .not. out1file)) then
1243 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1245 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1248 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1249 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1250 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1252 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1255 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1256 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1257 & ' SC-p interactions','were distributed among',nfgtasks,
1258 & ' fine-grain processors.'
1274 idihconstr_end=ndih_constr
1275 ithetaconstr_start=1
1276 ithetaconstr_end=ntheta_constr
1277 iphid_start=iphi_start
1278 iphid_end=iphi_end-1
1300 c---------------------------------------------------------------------------
1301 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1303 include "DIMENSIONS"
1304 include "COMMON.INTERACT"
1305 include "COMMON.SETUP"
1306 include "COMMON.IOUNITS"
1307 integer ii,jj,itask(4),ntask_cont_to,
1308 &itask_cont_to(0:max_fg_procs-1)
1310 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1311 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1312 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1313 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1314 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1315 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1316 & ielend_all(maxres,0:max_fg_procs-1)
1317 integer iproc,isent,k,l
1318 c Determines whether to send interaction ii,jj to other processors; a given
1319 c interaction can be sent to at most 2 processors.
1320 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1321 c one processor, otherwise flag is unchanged from the input value.
1327 c write (iout,*) "ii",ii," jj",jj
1328 c Loop over processors to check if anybody could need interaction ii,jj
1329 do iproc=0,fg_rank-1
1330 c Check if the interaction matches any turn3 at iproc
1331 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1333 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1334 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1336 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1339 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1340 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1343 call add_task(iproc,ntask_cont_to,itask_cont_to)
1347 C Check if the interaction matches any turn4 at iproc
1348 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1350 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1351 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1353 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1356 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1357 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1360 call add_task(iproc,ntask_cont_to,itask_cont_to)
1364 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1365 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1366 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1367 & ielend_all(ii-1,iproc).ge.jj-1) then
1369 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1370 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1373 call add_task(iproc,ntask_cont_to,itask_cont_to)
1376 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1377 & ielend_all(ii-1,iproc).ge.jj+1) then
1379 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1380 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1383 call add_task(iproc,ntask_cont_to,itask_cont_to)
1390 c---------------------------------------------------------------------------
1391 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1393 include "DIMENSIONS"
1394 include "COMMON.INTERACT"
1395 include "COMMON.SETUP"
1396 include "COMMON.IOUNITS"
1397 integer ii,jj,itask(2),ntask_cont_from,
1398 & itask_cont_from(0:max_fg_procs-1)
1400 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1401 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1402 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1403 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1404 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1405 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1406 & ielend_all(maxres,0:max_fg_procs-1)
1408 do iproc=fg_rank+1,nfgtasks-1
1409 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1411 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1412 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1414 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1415 call add_task(iproc,ntask_cont_from,itask_cont_from)
1418 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1420 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1421 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1423 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1424 call add_task(iproc,ntask_cont_from,itask_cont_from)
1427 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1428 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1430 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1431 & jj+1.le.ielend_all(ii+1,iproc)) then
1432 call add_task(iproc,ntask_cont_from,itask_cont_from)
1434 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1435 & jj-1.le.ielend_all(ii+1,iproc)) then
1436 call add_task(iproc,ntask_cont_from,itask_cont_from)
1439 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1441 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1442 & jj-1.le.ielend_all(ii-1,iproc)) then
1443 call add_task(iproc,ntask_cont_from,itask_cont_from)
1445 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1446 & jj+1.le.ielend_all(ii-1,iproc)) then
1447 call add_task(iproc,ntask_cont_from,itask_cont_from)
1454 c---------------------------------------------------------------------------
1455 subroutine add_task(iproc,ntask_cont,itask_cont)
1457 include "DIMENSIONS"
1458 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1461 if (itask_cont(ii).eq.iproc) return
1463 ntask_cont=ntask_cont+1
1464 itask_cont(ntask_cont)=iproc
1467 c---------------------------------------------------------------------------
1468 subroutine int_bounds(total_ints,lower_bound,upper_bound)
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 integer i,nint,nexcess
1476 nint=total_ints/nfgtasks
1480 nexcess=total_ints-nint*nfgtasks
1482 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1486 lower_bound=lower_bound+int4proc(i)
1488 upper_bound=lower_bound+int4proc(fg_rank)
1489 lower_bound=lower_bound+1
1492 c---------------------------------------------------------------------------
1493 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1495 include 'DIMENSIONS'
1497 include 'COMMON.SETUP'
1498 integer total_ints,lower_bound,upper_bound
1499 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1500 integer i,nint,nexcess
1501 nint=total_ints/nfgtasks1
1505 nexcess=total_ints-nint*nfgtasks1
1507 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1511 lower_bound=lower_bound+int4proc(i)
1513 upper_bound=lower_bound+int4proc(fg_rank1)
1514 lower_bound=lower_bound+1
1517 c---------------------------------------------------------------------------
1518 subroutine int_partition(int_index,lower_index,upper_index,atom,
1519 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1521 include 'DIMENSIONS'
1522 include 'COMMON.IOUNITS'
1523 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1524 & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1527 if (lprn) write (iout,*) 'int_index=',int_index
1528 int_index_old=int_index
1529 int_index=int_index+last_atom-first_atom+1
1531 & write (iout,*) 'int_index=',int_index,
1532 & ' int_index_old',int_index_old,
1533 & ' lower_index=',lower_index,
1534 & ' upper_index=',upper_index,
1535 & ' atom=',atom,' first_atom=',first_atom,
1536 & ' last_atom=',last_atom
1537 if (int_index.ge.lower_index) then
1539 if (at_start.eq.0) then
1541 jat_start=first_atom-1+lower_index-int_index_old
1543 jat_start=first_atom
1545 if (lprn) write (iout,*) 'jat_start',jat_start
1546 if (int_index.ge.upper_index) then
1548 jat_end=first_atom-1+upper_index-int_index_old
1553 if (lprn) write (iout,*) 'jat_end',jat_end
1558 c------------------------------------------------------------------------------
1559 subroutine hpb_partition
1561 include 'DIMENSIONS'
1565 include 'COMMON.SBRIDGE'
1566 include 'COMMON.IOUNITS'
1567 include 'COMMON.SETUP'
1569 call int_bounds(nhpb,link_start,link_end)
1570 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1571 & ' absolute rank',MyRank,
1572 & ' nhpb',nhpb,' link_start=',link_start,
1573 & ' link_end',link_end
1580 c------------------------------------------------------------------------------
1581 subroutine homology_partition
1583 include 'DIMENSIONS'
1587 include 'COMMON.SBRIDGE'
1588 include 'COMMON.IOUNITS'
1589 include 'COMMON.SETUP'
1590 include 'COMMON.CONTROL'
1591 include 'COMMON.INTERACT'
1592 include 'COMMON.HOMOLOGY'
1593 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1594 cd & " lim_dih",lim_dih
1596 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1597 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1598 call int_bounds(lim_dih,idihconstr_start_homo,
1599 & idihconstr_end_homo)
1600 idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1601 idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1602 if (me.eq.king .or. .not. out1file)
1603 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1604 & ' absolute rank',MyRank,
1605 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1606 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1607 & ' idihconstr_start_homo',idihconstr_start_homo,
1608 & ' idihconstr_end_homo',idihconstr_end_homo
1610 write (iout,*) "Not MPI"
1612 link_end_homo=lim_odl
1613 idihconstr_start_homo=nnt+3
1614 idihconstr_end_homo=lim_dih+nnt-1+3
1616 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1617 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1618 & ' idihconstr_start_homo',idihconstr_start_homo,
1619 & ' idihconstr_end_homo',idihconstr_end_homo
1623 c------------------------------------------------------------------------------
1624 subroutine NMRpeak_partition
1626 include 'DIMENSIONS'
1630 include 'COMMON.SBRIDGE'
1631 include 'COMMON.IOUNITS'
1632 include 'COMMON.SETUP'
1634 call int_bounds(npeak,link_start_peak,link_end_peak)
1635 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1636 & ' absolute rank',MyRank,
1637 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1638 & ' link_end_peak',link_end_peak