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
122 C Lipidic input file for parameters range 60-79
124 C input file for transfer sidechain and peptide group inside the
125 C lipidic environment if lipid is implicite
127 C DNA input files for parameters range 80-99
128 C Suger input files for parameters range 100-119
129 C All-atom input files for parameters range 120-149
131 C Set default weights of the energy terms.
142 c print '(a,$)','Inside initialize'
143 c call memmon_print_usage()
178 athet(j,i,ichir1,ichir2)=0.0D0
179 bthet(j,i,ichir1,ichir2)=0.0D0
199 gaussc(l,k,j,i)=0.0D0
209 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
213 v1(k,j,i,iblock)=0.0D0
214 v2(k,j,i,iblock)=0.0D0
224 v1c(1,l,i,j,k,iblock)=0.0D0
225 v1s(1,l,i,j,k,iblock)=0.0D0
226 v1c(2,l,i,j,k,iblock)=0.0D0
227 v1s(2,l,i,j,k,iblock)=0.0D0
231 v2c(m,l,i,j,k,iblock)=0.0D0
232 v2s(m,l,i,j,k,iblock)=0.0D0
244 C Initialize the bridge arrays
258 C Initialize correlation arrays
279 C Initialize variables used in minimization.
288 C Initialize the variables responsible for the mode of gradient storage.
293 C Initialize constants used to split the energy into long- and short-range
299 nprint_ene=nprint_ene-1
303 c-------------------------------------------------------------------------
305 implicit real*8 (a-h,o-z)
307 include 'COMMON.NAMES'
308 include 'COMMON.FFIELD'
310 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
311 & 'DSG','DGN','DSN','DTH',
312 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
313 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
314 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
317 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
318 &'a','y','w','v','l','i','f','m','c','x',
319 &'C','M','F','I','L','V','W','Y','A','G','T',
320 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
321 data potname /'LJ','LJK','BP','GB','GBV'/
323 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
324 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
325 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
326 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
328 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
329 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
330 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
332 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
335 c---------------------------------------------------------------------------
336 subroutine init_int_table
337 implicit real*8 (a-h,o-z)
341 integer blocklengths(15),displs(15)
343 include 'COMMON.CONTROL'
344 include 'COMMON.SETUP'
345 include 'COMMON.CHAIN'
346 include 'COMMON.INTERACT'
347 include 'COMMON.LOCAL'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.TORCNSTR'
350 include 'COMMON.IOUNITS'
351 include 'COMMON.DERIV'
352 include 'COMMON.CONTACTS'
353 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
354 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
355 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
356 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
357 & ielend_all(maxres,0:max_fg_procs-1),
358 & ntask_cont_from_all(0:max_fg_procs-1),
359 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
360 & ntask_cont_to_all(0:max_fg_procs-1),
361 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
362 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
363 logical scheck,lprint,flag
365 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
366 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
367 C... Determine the numbers of start and end SC-SC interaction
368 C... to deal with by current processor.
370 itask_cont_from(i)=fg_rank
371 itask_cont_to(i)=fg_rank
375 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
376 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
377 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
379 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
380 & ' absolute rank',MyRank,
381 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
382 & ' my_sc_inde',my_sc_inde
402 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
403 cd & (ihpb(i),jhpb(i),i=1,nss)
408 if (ihpb(ii).eq.i+nres) then
415 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
419 c write (iout,*) 'jj=i+1'
420 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
421 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
427 else if (jj.eq.nct) then
429 c write (iout,*) 'jj=nct'
430 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
431 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
439 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
440 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
442 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
443 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
454 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
455 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
460 ind_scint=ind_scint+nct-i
464 ind_scint_old=ind_scint
473 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
474 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
477 write (iout,'(a)') 'Interaction array:'
479 write (iout,'(i3,2(2x,2i3))')
480 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
485 C Now partition the electrostatic-interaction array
487 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
488 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
490 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
491 & ' absolute rank',MyRank,
492 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
493 & ' my_ele_inde',my_ele_inde
500 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
501 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
504 if (iatel_s.eq.0) iatel_s=1
505 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
506 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
507 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
508 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
509 c & " my_ele_inde_vdw",my_ele_inde_vdw
516 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
518 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
520 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
521 c & " ielend_vdw",ielend_vdw(i)
523 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
534 do i=iatel_s_vdw,iatel_e_vdw
540 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
541 & ' absolute rank',MyRank
542 write (iout,*) 'Electrostatic interaction array:'
544 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
549 C Partition the SC-p interaction array
551 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
552 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
553 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
554 & ' absolute rank',myrank,
555 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
556 & ' my_scp_inde',my_scp_inde
562 if (i.lt.nnt+iscp) then
563 cd write (iout,*) 'i.le.nnt+iscp'
564 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
565 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
567 else if (i.gt.nct-iscp) then
568 cd write (iout,*) 'i.gt.nct-iscp'
569 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
570 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
573 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
574 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
577 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
578 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
587 if (i.lt.nnt+iscp) then
589 iscpstart(i,1)=i+iscp
591 elseif (i.gt.nct-iscp) then
599 iscpstart(i,2)=i+iscp
605 write (iout,'(a)') 'SC-p interaction array:'
606 do i=iatscp_s,iatscp_e
607 write (iout,'(i3,2(2x,2i3))')
608 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
611 C Partition local interactions
613 call int_bounds(nres-2,loc_start,loc_end)
614 loc_start=loc_start+1
616 call int_bounds(nres-2,ithet_start,ithet_end)
617 ithet_start=ithet_start+2
618 ithet_end=ithet_end+2
619 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
620 iturn3_start=iturn3_start+nnt
621 iphi_start=iturn3_start+2
622 iturn3_end=iturn3_end+nnt
623 iphi_end=iturn3_end+2
624 iturn3_start=iturn3_start-1
625 iturn3_end=iturn3_end-1
626 call int_bounds(nres-3,itau_start,itau_end)
627 itau_start=itau_start+3
629 call int_bounds(nres-3,iphi1_start,iphi1_end)
630 iphi1_start=iphi1_start+3
631 iphi1_end=iphi1_end+3
632 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
633 iturn4_start=iturn4_start+nnt
634 iphid_start=iturn4_start+2
635 iturn4_end=iturn4_end+nnt
636 iphid_end=iturn4_end+2
637 iturn4_start=iturn4_start-1
638 iturn4_end=iturn4_end-1
639 call int_bounds(nres-2,ibond_start,ibond_end)
640 ibond_start=ibond_start+1
641 ibond_end=ibond_end+1
642 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
643 ibondp_start=ibondp_start+nnt
644 ibondp_end=ibondp_end+nnt
645 call int_bounds(nres,ilip_start,ilip_end)
646 ilip_start=ilip_start
647 call int_bounds1(nres-1,ivec_start,ivec_end)
648 c print *,"Processor",myrank,fg_rank,fg_rank1,
649 c & " ivec_start",ivec_start," ivec_end",ivec_end
650 iset_start=loc_start+2
652 if (ndih_constr.eq.0) then
656 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
658 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
660 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
662 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
663 igrad_start=((2*nlen+1)
664 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
665 jgrad_start(igrad_start)=
666 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
668 jgrad_end(igrad_start)=nres
669 igrad_end=((2*nlen+1)
670 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
671 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
672 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
674 do i=igrad_start+1,igrad_end-1
679 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
680 & ' absolute rank',myrank,
681 & ' loc_start',loc_start,' loc_end',loc_end,
682 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
683 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
684 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
685 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
686 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
687 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
688 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
689 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
690 & ' iset_start',iset_start,' iset_end',iset_end,
691 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
693 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
694 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
695 & ' ngrad_end',ngrad_end
696 do i=igrad_start,igrad_end
697 write(*,*) 'Processor:',fg_rank,myrank,i,
698 & jgrad_start(i),jgrad_end(i)
701 if (nfgtasks.gt.1) then
702 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
703 & MPI_INTEGER,FG_COMM1,IERROR)
704 iaux=ivec_end-ivec_start+1
705 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
706 & MPI_INTEGER,FG_COMM1,IERROR)
707 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
708 & MPI_INTEGER,FG_COMM,IERROR)
709 iaux=iset_end-iset_start+1
710 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
711 & MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
713 & MPI_INTEGER,FG_COMM,IERROR)
714 iaux=ibond_end-ibond_start+1
715 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
716 & MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
718 & MPI_INTEGER,FG_COMM,IERROR)
719 iaux=ithet_end-ithet_start+1
720 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
721 & MPI_INTEGER,FG_COMM,IERROR)
722 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
723 & MPI_INTEGER,FG_COMM,IERROR)
724 iaux=iphi_end-iphi_start+1
725 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
726 & MPI_INTEGER,FG_COMM,IERROR)
727 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
728 & MPI_INTEGER,FG_COMM,IERROR)
729 iaux=iphi1_end-iphi1_start+1
730 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
731 & MPI_INTEGER,FG_COMM,IERROR)
738 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
739 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
740 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
741 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
742 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
743 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
744 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
745 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
746 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
747 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
748 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
749 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
750 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
751 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
752 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
753 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
755 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
756 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
757 write (iout,*) "iturn3_start_all",
758 & (iturn3_start_all(i),i=0,nfgtasks-1)
759 write (iout,*) "iturn3_end_all",
760 & (iturn3_end_all(i),i=0,nfgtasks-1)
761 write (iout,*) "iturn4_start_all",
762 & (iturn4_start_all(i),i=0,nfgtasks-1)
763 write (iout,*) "iturn4_end_all",
764 & (iturn4_end_all(i),i=0,nfgtasks-1)
765 write (iout,*) "The ielstart_all array"
767 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
769 write (iout,*) "The ielend_all array"
771 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
777 itask_cont_from(0)=fg_rank
778 itask_cont_to(0)=fg_rank
780 do ii=iturn3_start,iturn3_end
781 call add_int(ii,ii+2,iturn3_sent(1,ii),
782 & ntask_cont_to,itask_cont_to,flag)
784 do ii=iturn4_start,iturn4_end
785 call add_int(ii,ii+3,iturn4_sent(1,ii),
786 & ntask_cont_to,itask_cont_to,flag)
788 do ii=iturn3_start,iturn3_end
789 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
791 do ii=iturn4_start,iturn4_end
792 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
795 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
796 & " ntask_cont_to",ntask_cont_to
797 write (iout,*) "itask_cont_from",
798 & (itask_cont_from(i),i=1,ntask_cont_from)
799 write (iout,*) "itask_cont_to",
800 & (itask_cont_to(i),i=1,ntask_cont_to)
803 c write (iout,*) "Loop forward"
806 c write (iout,*) "from loop i=",i
808 do j=ielstart(i),ielend(i)
809 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
812 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
813 c & " iatel_e",iatel_e
817 c write (iout,*) "i",i," ielstart",ielstart(i),
818 c & " ielend",ielend(i)
821 do j=ielstart(i),ielend(i)
822 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
823 & itask_cont_to,flag)
831 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
832 & " ntask_cont_to",ntask_cont_to
833 write (iout,*) "itask_cont_from",
834 & (itask_cont_from(i),i=1,ntask_cont_from)
835 write (iout,*) "itask_cont_to",
836 & (itask_cont_to(i),i=1,ntask_cont_to)
838 write (iout,*) "iint_sent"
841 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
842 & j=ielstart(ii),ielend(ii))
844 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
845 & " iturn3_end",iturn3_end
846 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
847 & i=iturn3_start,iturn3_end)
848 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
849 & " iturn4_end",iturn4_end
850 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
851 & i=iturn4_start,iturn4_end)
854 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
855 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
856 c write (iout,*) "Gather ntask_cont_from ended"
858 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
859 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
861 c write (iout,*) "Gather itask_cont_from ended"
863 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
864 & 1,MPI_INTEGER,king,FG_COMM,IERR)
865 c write (iout,*) "Gather ntask_cont_to ended"
867 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
868 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
869 c write (iout,*) "Gather itask_cont_to ended"
871 if (fg_rank.eq.king) then
872 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
874 write (iout,'(20i4)') i,ntask_cont_from_all(i),
875 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
879 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
881 write (iout,'(20i4)') i,ntask_cont_to_all(i),
882 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
886 C Check if every send will have a matching receive
890 ncheck_to=ncheck_to+ntask_cont_to_all(i)
891 ncheck_from=ncheck_from+ntask_cont_from_all(i)
893 write (iout,*) "Control sums",ncheck_from,ncheck_to
894 if (ncheck_from.ne.ncheck_to) then
895 write (iout,*) "Error: #receive differs from #send."
896 write (iout,*) "Terminating program...!"
902 do j=1,ntask_cont_to_all(i)
903 ii=itask_cont_to_all(j,i)
904 do k=1,ntask_cont_from_all(ii)
905 if (itask_cont_from_all(k,ii).eq.i) then
906 if(lprint)write(iout,*)"Matching send/receive",i,ii
910 if (k.eq.ntask_cont_from_all(ii)+1) then
912 write (iout,*) "Error: send by",j," to",ii,
913 & " would have no matching receive"
919 write (iout,*) "Unmatched sends; terminating program"
923 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
924 c write (iout,*) "flag broadcast ended flag=",flag
927 call MPI_Finalize(IERROR)
928 stop "Error in INIT_INT_TABLE: unmatched send/receive."
930 call MPI_Comm_group(FG_COMM,fg_group,IERR)
931 c write (iout,*) "MPI_Comm_group ended"
933 call MPI_Group_incl(fg_group,ntask_cont_from+1,
934 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
935 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
936 & CONT_TO_GROUP,IERR)
939 iaux=4*(ielend(ii)-ielstart(ii)+1)
940 call MPI_Group_translate_ranks(fg_group,iaux,
941 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
942 & iint_sent_local(1,ielstart(ii),i),IERR )
943 c write (iout,*) "Ranks translated i=",i
946 iaux=4*(iturn3_end-iturn3_start+1)
947 call MPI_Group_translate_ranks(fg_group,iaux,
948 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
949 & iturn3_sent_local(1,iturn3_start),IERR)
950 iaux=4*(iturn4_end-iturn4_start+1)
951 call MPI_Group_translate_ranks(fg_group,iaux,
952 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
953 & iturn4_sent_local(1,iturn4_start),IERR)
955 write (iout,*) "iint_sent_local"
958 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
959 & j=ielstart(ii),ielend(ii))
962 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
963 & " iturn3_end",iturn3_end
964 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
965 & i=iturn3_start,iturn3_end)
966 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
967 & " iturn4_end",iturn4_end
968 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
969 & i=iturn4_start,iturn4_end)
972 call MPI_Group_free(fg_group,ierr)
973 call MPI_Group_free(cont_from_group,ierr)
974 call MPI_Group_free(cont_to_group,ierr)
975 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
976 call MPI_Type_commit(MPI_UYZ,IERROR)
977 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
979 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
980 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
981 call MPI_Type_commit(MPI_MU,IERROR)
982 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
983 call MPI_Type_commit(MPI_MAT1,IERROR)
984 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
985 call MPI_Type_commit(MPI_MAT2,IERROR)
986 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
987 call MPI_Type_commit(MPI_THET,IERROR)
988 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
989 call MPI_Type_commit(MPI_GAM,IERROR)
991 c 9/22/08 Derived types to send matrices which appear in correlation terms
993 if (ivec_count(i).eq.ivec_count(0)) then
999 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1000 if (ind_typ.eq.0) then
1001 ichunk=ivec_count(0)
1003 ichunk=ivec_count(1)
1010 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1013 c blocklengths(i)=blocklengths(i)*ichunk
1015 c write (iout,*) "blocklengths and displs"
1017 c write (iout,*) i,blocklengths(i),displs(i)
1020 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1021 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1022 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1023 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1029 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1032 c blocklengths(i)=blocklengths(i)*ichunk
1034 c write (iout,*) "blocklengths and displs"
1036 c write (iout,*) i,blocklengths(i),displs(i)
1039 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1040 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1041 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1042 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1048 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1051 blocklengths(i)=blocklengths(i)*ichunk
1053 call MPI_Type_indexed(8,blocklengths,displs,
1054 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1055 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1061 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1064 blocklengths(i)=blocklengths(i)*ichunk
1066 call MPI_Type_indexed(8,blocklengths,displs,
1067 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1068 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1074 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1077 blocklengths(i)=blocklengths(i)*ichunk
1079 call MPI_Type_indexed(6,blocklengths,displs,
1080 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1081 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1087 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1090 blocklengths(i)=blocklengths(i)*ichunk
1092 call MPI_Type_indexed(2,blocklengths,displs,
1093 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1094 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1100 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1103 blocklengths(i)=blocklengths(i)*ichunk
1105 call MPI_Type_indexed(4,blocklengths,displs,
1106 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1107 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1111 iint_start=ivec_start+1
1114 iint_count(i)=ivec_count(i)
1115 iint_displ(i)=ivec_displ(i)
1116 ivec_displ(i)=ivec_displ(i)-1
1117 iset_displ(i)=iset_displ(i)-1
1118 ithet_displ(i)=ithet_displ(i)-1
1119 iphi_displ(i)=iphi_displ(i)-1
1120 iphi1_displ(i)=iphi1_displ(i)-1
1121 ibond_displ(i)=ibond_displ(i)-1
1123 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1124 & .and. (me.eq.0 .or. .not. out1file)) then
1125 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1127 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1130 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1131 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1132 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1134 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1137 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1138 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1139 & ' SC-p interactions','were distributed among',nfgtasks,
1140 & ' fine-grain processors.'
1156 idihconstr_end=ndih_constr
1157 iphid_start=iphi_start
1158 iphid_end=iphi_end-1
1177 c---------------------------------------------------------------------------
1178 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1180 include "DIMENSIONS"
1181 include "COMMON.INTERACT"
1182 include "COMMON.SETUP"
1183 include "COMMON.IOUNITS"
1184 integer ii,jj,itask(4),ntask_cont_to,
1185 &itask_cont_to(0:max_fg_procs-1)
1187 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1188 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1189 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1190 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1191 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1192 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1193 & ielend_all(maxres,0:max_fg_procs-1)
1194 integer iproc,isent,k,l
1195 c Determines whether to send interaction ii,jj to other processors; a given
1196 c interaction can be sent to at most 2 processors.
1197 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1198 c one processor, otherwise flag is unchanged from the input value.
1204 c write (iout,*) "ii",ii," jj",jj
1205 c Loop over processors to check if anybody could need interaction ii,jj
1206 do iproc=0,fg_rank-1
1207 c Check if the interaction matches any turn3 at iproc
1208 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1210 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1211 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1213 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1216 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1217 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1220 call add_task(iproc,ntask_cont_to,itask_cont_to)
1224 C Check if the interaction matches any turn4 at iproc
1225 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1227 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1228 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1230 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1233 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1234 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1237 call add_task(iproc,ntask_cont_to,itask_cont_to)
1241 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1242 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1243 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1244 & ielend_all(ii-1,iproc).ge.jj-1) then
1246 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1247 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1250 call add_task(iproc,ntask_cont_to,itask_cont_to)
1253 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1254 & ielend_all(ii-1,iproc).ge.jj+1) then
1256 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1257 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1260 call add_task(iproc,ntask_cont_to,itask_cont_to)
1267 c---------------------------------------------------------------------------
1268 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1270 include "DIMENSIONS"
1271 include "COMMON.INTERACT"
1272 include "COMMON.SETUP"
1273 include "COMMON.IOUNITS"
1274 integer ii,jj,itask(2),ntask_cont_from,
1275 & itask_cont_from(0:max_fg_procs-1)
1277 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1278 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1279 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1280 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1281 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1282 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1283 & ielend_all(maxres,0:max_fg_procs-1)
1285 do iproc=fg_rank+1,nfgtasks-1
1286 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1288 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1289 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1291 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1292 call add_task(iproc,ntask_cont_from,itask_cont_from)
1295 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1297 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1298 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1300 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1301 call add_task(iproc,ntask_cont_from,itask_cont_from)
1304 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1305 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1307 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1308 & jj+1.le.ielend_all(ii+1,iproc)) then
1309 call add_task(iproc,ntask_cont_from,itask_cont_from)
1311 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1312 & jj-1.le.ielend_all(ii+1,iproc)) then
1313 call add_task(iproc,ntask_cont_from,itask_cont_from)
1316 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1318 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1319 & jj-1.le.ielend_all(ii-1,iproc)) then
1320 call add_task(iproc,ntask_cont_from,itask_cont_from)
1322 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1323 & jj+1.le.ielend_all(ii-1,iproc)) then
1324 call add_task(iproc,ntask_cont_from,itask_cont_from)
1331 c---------------------------------------------------------------------------
1332 subroutine add_task(iproc,ntask_cont,itask_cont)
1334 include "DIMENSIONS"
1335 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1338 if (itask_cont(ii).eq.iproc) return
1340 ntask_cont=ntask_cont+1
1341 itask_cont(ntask_cont)=iproc
1344 c---------------------------------------------------------------------------
1345 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1346 implicit real*8 (a-h,o-z)
1347 include 'DIMENSIONS'
1349 include 'COMMON.SETUP'
1350 integer total_ints,lower_bound,upper_bound
1351 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1352 nint=total_ints/nfgtasks
1356 nexcess=total_ints-nint*nfgtasks
1358 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1362 lower_bound=lower_bound+int4proc(i)
1364 upper_bound=lower_bound+int4proc(fg_rank)
1365 lower_bound=lower_bound+1
1368 c---------------------------------------------------------------------------
1369 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1370 implicit real*8 (a-h,o-z)
1371 include 'DIMENSIONS'
1373 include 'COMMON.SETUP'
1374 integer total_ints,lower_bound,upper_bound
1375 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1376 nint=total_ints/nfgtasks1
1380 nexcess=total_ints-nint*nfgtasks1
1382 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1386 lower_bound=lower_bound+int4proc(i)
1388 upper_bound=lower_bound+int4proc(fg_rank1)
1389 lower_bound=lower_bound+1
1392 c---------------------------------------------------------------------------
1393 subroutine int_partition(int_index,lower_index,upper_index,atom,
1394 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1395 implicit real*8 (a-h,o-z)
1396 include 'DIMENSIONS'
1397 include 'COMMON.IOUNITS'
1398 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1399 & first_atom,last_atom,int_gr,jat_start,jat_end
1402 if (lprn) write (iout,*) 'int_index=',int_index
1403 int_index_old=int_index
1404 int_index=int_index+last_atom-first_atom+1
1406 & write (iout,*) 'int_index=',int_index,
1407 & ' int_index_old',int_index_old,
1408 & ' lower_index=',lower_index,
1409 & ' upper_index=',upper_index,
1410 & ' atom=',atom,' first_atom=',first_atom,
1411 & ' last_atom=',last_atom
1412 if (int_index.ge.lower_index) then
1414 if (at_start.eq.0) then
1416 jat_start=first_atom-1+lower_index-int_index_old
1418 jat_start=first_atom
1420 if (lprn) write (iout,*) 'jat_start',jat_start
1421 if (int_index.ge.upper_index) then
1423 jat_end=first_atom-1+upper_index-int_index_old
1428 if (lprn) write (iout,*) 'jat_end',jat_end
1433 c------------------------------------------------------------------------------
1434 subroutine hpb_partition
1435 implicit real*8 (a-h,o-z)
1436 include 'DIMENSIONS'
1440 include 'COMMON.SBRIDGE'
1441 include 'COMMON.IOUNITS'
1442 include 'COMMON.SETUP'
1444 call int_bounds(nhpb,link_start,link_end)
1445 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1446 & ' absolute rank',MyRank,
1447 & ' nhpb',nhpb,' link_start=',link_start,
1448 & ' link_end',link_end