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
289 C Initialize variables used in minimization.
298 C Initialize the variables responsible for the mode of gradient storage.
303 C Initialize constants used to split the energy into long- and short-range
309 nprint_ene=nprint_ene-1
313 c-------------------------------------------------------------------------
315 implicit real*8 (a-h,o-z)
317 include 'COMMON.NAMES'
318 include 'COMMON.FFIELD'
320 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
321 & 'DSG','DGN','DSN','DTH',
322 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
323 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
324 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
327 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
328 &'a','y','w','v','l','i','f','m','c','x',
329 &'C','M','F','I','L','V','W','Y','A','G','T',
330 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
331 data potname /'LJ','LJK','BP','GB','GBV'/
333 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
334 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
335 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
336 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
338 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
339 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
340 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
342 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
345 c---------------------------------------------------------------------------
346 subroutine init_int_table
347 implicit real*8 (a-h,o-z)
351 integer blocklengths(15),displs(15)
353 include 'COMMON.CONTROL'
354 include 'COMMON.SETUP'
355 include 'COMMON.CHAIN'
356 include 'COMMON.INTERACT'
357 include 'COMMON.LOCAL'
358 include 'COMMON.SBRIDGE'
359 include 'COMMON.TORCNSTR'
360 include 'COMMON.IOUNITS'
361 include 'COMMON.DERIV'
362 include 'COMMON.CONTACTS'
363 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
364 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
365 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
366 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
367 & ielend_all(maxres,0:max_fg_procs-1),
368 & ntask_cont_from_all(0:max_fg_procs-1),
369 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
370 & ntask_cont_to_all(0:max_fg_procs-1),
371 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
372 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
373 logical scheck,lprint,flag
375 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
376 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
377 C... Determine the numbers of start and end SC-SC interaction
378 C... to deal with by current processor.
380 itask_cont_from(i)=fg_rank
381 itask_cont_to(i)=fg_rank
385 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
386 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
387 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
389 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
390 & ' absolute rank',MyRank,
391 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
392 & ' my_sc_inde',my_sc_inde
412 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
413 cd & (ihpb(i),jhpb(i),i=1,nss)
418 if (ihpb(ii).eq.i+nres) then
425 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
429 c write (iout,*) 'jj=i+1'
430 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
431 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
437 else if (jj.eq.nct) then
439 c write (iout,*) 'jj=nct'
440 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
441 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
449 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
450 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
452 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
453 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
464 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
465 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
470 ind_scint=ind_scint+nct-i
474 ind_scint_old=ind_scint
483 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
484 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
487 write (iout,'(a)') 'Interaction array:'
489 write (iout,'(i3,2(2x,2i3))')
490 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
495 C Now partition the electrostatic-interaction array
497 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
498 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
500 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
501 & ' absolute rank',MyRank,
502 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
503 & ' my_ele_inde',my_ele_inde
510 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
511 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
514 if (iatel_s.eq.0) iatel_s=1
515 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
516 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
517 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
518 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
519 c & " my_ele_inde_vdw",my_ele_inde_vdw
526 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
528 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
530 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
531 c & " ielend_vdw",ielend_vdw(i)
533 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
544 do i=iatel_s_vdw,iatel_e_vdw
550 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
551 & ' absolute rank',MyRank
552 write (iout,*) 'Electrostatic interaction array:'
554 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
559 C Partition the SC-p interaction array
561 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
562 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
563 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
564 & ' absolute rank',myrank,
565 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
566 & ' my_scp_inde',my_scp_inde
572 if (i.lt.nnt+iscp) then
573 cd write (iout,*) 'i.le.nnt+iscp'
574 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
575 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
577 else if (i.gt.nct-iscp) then
578 cd write (iout,*) 'i.gt.nct-iscp'
579 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
580 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
583 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
584 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
587 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
588 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
597 if (i.lt.nnt+iscp) then
599 iscpstart(i,1)=i+iscp
601 elseif (i.gt.nct-iscp) then
609 iscpstart(i,2)=i+iscp
615 write (iout,'(a)') 'SC-p interaction array:'
616 do i=iatscp_s,iatscp_e
617 write (iout,'(i3,2(2x,2i3))')
618 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
621 C Partition local interactions
623 call int_bounds(nres-2,loc_start,loc_end)
624 loc_start=loc_start+1
626 call int_bounds(nres-2,ithet_start,ithet_end)
627 ithet_start=ithet_start+2
628 ithet_end=ithet_end+2
629 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
630 iturn3_start=iturn3_start+nnt
631 iphi_start=iturn3_start+2
632 iturn3_end=iturn3_end+nnt
633 iphi_end=iturn3_end+2
634 iturn3_start=iturn3_start-1
635 iturn3_end=iturn3_end-1
636 call int_bounds(nres-3,itau_start,itau_end)
637 itau_start=itau_start+3
639 call int_bounds(nres-3,iphi1_start,iphi1_end)
640 iphi1_start=iphi1_start+3
641 iphi1_end=iphi1_end+3
642 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
643 iturn4_start=iturn4_start+nnt
644 iphid_start=iturn4_start+2
645 iturn4_end=iturn4_end+nnt
646 iphid_end=iturn4_end+2
647 iturn4_start=iturn4_start-1
648 iturn4_end=iturn4_end-1
649 call int_bounds(nres-2,ibond_start,ibond_end)
650 ibond_start=ibond_start+1
651 ibond_end=ibond_end+1
652 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
653 ibondp_start=ibondp_start+nnt
654 ibondp_end=ibondp_end+nnt
655 call int_bounds(nres,ilip_start,ilip_end)
656 ilip_start=ilip_start
657 call int_bounds1(nres-1,ivec_start,ivec_end)
658 c print *,"Processor",myrank,fg_rank,fg_rank1,
659 c & " ivec_start",ivec_start," ivec_end",ivec_end
660 iset_start=loc_start+2
662 if (ndih_constr.eq.0) then
666 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
668 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
670 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
672 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
673 igrad_start=((2*nlen+1)
674 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
675 jgrad_start(igrad_start)=
676 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
678 jgrad_end(igrad_start)=nres
679 igrad_end=((2*nlen+1)
680 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
681 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
682 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
684 do i=igrad_start+1,igrad_end-1
689 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
690 & ' absolute rank',myrank,
691 & ' loc_start',loc_start,' loc_end',loc_end,
692 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
693 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
694 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
695 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
696 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
697 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
698 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
699 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
700 & ' iset_start',iset_start,' iset_end',iset_end,
701 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
703 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
704 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
705 & ' ngrad_end',ngrad_end
706 do i=igrad_start,igrad_end
707 write(*,*) 'Processor:',fg_rank,myrank,i,
708 & jgrad_start(i),jgrad_end(i)
711 if (nfgtasks.gt.1) then
712 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
713 & MPI_INTEGER,FG_COMM1,IERROR)
714 iaux=ivec_end-ivec_start+1
715 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
716 & MPI_INTEGER,FG_COMM1,IERROR)
717 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
718 & MPI_INTEGER,FG_COMM,IERROR)
719 iaux=iset_end-iset_start+1
720 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
721 & MPI_INTEGER,FG_COMM,IERROR)
722 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
723 & MPI_INTEGER,FG_COMM,IERROR)
724 iaux=ibond_end-ibond_start+1
725 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
726 & MPI_INTEGER,FG_COMM,IERROR)
727 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
728 & MPI_INTEGER,FG_COMM,IERROR)
729 iaux=ithet_end-ithet_start+1
730 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
731 & MPI_INTEGER,FG_COMM,IERROR)
732 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
733 & MPI_INTEGER,FG_COMM,IERROR)
734 iaux=iphi_end-iphi_start+1
735 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
736 & MPI_INTEGER,FG_COMM,IERROR)
737 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
738 & MPI_INTEGER,FG_COMM,IERROR)
739 iaux=iphi1_end-iphi1_start+1
740 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
741 & MPI_INTEGER,FG_COMM,IERROR)
748 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
749 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
750 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
751 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
752 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
753 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
754 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
755 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
756 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
757 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
758 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
759 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
760 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
761 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
762 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
763 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
765 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
766 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
767 write (iout,*) "iturn3_start_all",
768 & (iturn3_start_all(i),i=0,nfgtasks-1)
769 write (iout,*) "iturn3_end_all",
770 & (iturn3_end_all(i),i=0,nfgtasks-1)
771 write (iout,*) "iturn4_start_all",
772 & (iturn4_start_all(i),i=0,nfgtasks-1)
773 write (iout,*) "iturn4_end_all",
774 & (iturn4_end_all(i),i=0,nfgtasks-1)
775 write (iout,*) "The ielstart_all array"
777 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
779 write (iout,*) "The ielend_all array"
781 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
787 itask_cont_from(0)=fg_rank
788 itask_cont_to(0)=fg_rank
790 do ii=iturn3_start,iturn3_end
791 call add_int(ii,ii+2,iturn3_sent(1,ii),
792 & ntask_cont_to,itask_cont_to,flag)
794 do ii=iturn4_start,iturn4_end
795 call add_int(ii,ii+3,iturn4_sent(1,ii),
796 & ntask_cont_to,itask_cont_to,flag)
798 do ii=iturn3_start,iturn3_end
799 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
801 do ii=iturn4_start,iturn4_end
802 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
805 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
806 & " ntask_cont_to",ntask_cont_to
807 write (iout,*) "itask_cont_from",
808 & (itask_cont_from(i),i=1,ntask_cont_from)
809 write (iout,*) "itask_cont_to",
810 & (itask_cont_to(i),i=1,ntask_cont_to)
813 c write (iout,*) "Loop forward"
816 c write (iout,*) "from loop i=",i
818 do j=ielstart(i),ielend(i)
819 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
822 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
823 c & " iatel_e",iatel_e
827 c write (iout,*) "i",i," ielstart",ielstart(i),
828 c & " ielend",ielend(i)
831 do j=ielstart(i),ielend(i)
832 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
833 & itask_cont_to,flag)
841 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
842 & " ntask_cont_to",ntask_cont_to
843 write (iout,*) "itask_cont_from",
844 & (itask_cont_from(i),i=1,ntask_cont_from)
845 write (iout,*) "itask_cont_to",
846 & (itask_cont_to(i),i=1,ntask_cont_to)
848 write (iout,*) "iint_sent"
851 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
852 & j=ielstart(ii),ielend(ii))
854 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
855 & " iturn3_end",iturn3_end
856 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
857 & i=iturn3_start,iturn3_end)
858 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
859 & " iturn4_end",iturn4_end
860 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
861 & i=iturn4_start,iturn4_end)
864 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
865 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
866 c write (iout,*) "Gather ntask_cont_from ended"
868 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
869 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
871 c write (iout,*) "Gather itask_cont_from ended"
873 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
874 & 1,MPI_INTEGER,king,FG_COMM,IERR)
875 c write (iout,*) "Gather ntask_cont_to ended"
877 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
878 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
879 c write (iout,*) "Gather itask_cont_to ended"
881 if (fg_rank.eq.king) then
882 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
884 write (iout,'(20i4)') i,ntask_cont_from_all(i),
885 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
889 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
891 write (iout,'(20i4)') i,ntask_cont_to_all(i),
892 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
896 C Check if every send will have a matching receive
900 ncheck_to=ncheck_to+ntask_cont_to_all(i)
901 ncheck_from=ncheck_from+ntask_cont_from_all(i)
903 write (iout,*) "Control sums",ncheck_from,ncheck_to
904 if (ncheck_from.ne.ncheck_to) then
905 write (iout,*) "Error: #receive differs from #send."
906 write (iout,*) "Terminating program...!"
912 do j=1,ntask_cont_to_all(i)
913 ii=itask_cont_to_all(j,i)
914 do k=1,ntask_cont_from_all(ii)
915 if (itask_cont_from_all(k,ii).eq.i) then
916 if(lprint)write(iout,*)"Matching send/receive",i,ii
920 if (k.eq.ntask_cont_from_all(ii)+1) then
922 write (iout,*) "Error: send by",j," to",ii,
923 & " would have no matching receive"
929 write (iout,*) "Unmatched sends; terminating program"
933 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
934 c write (iout,*) "flag broadcast ended flag=",flag
937 call MPI_Finalize(IERROR)
938 stop "Error in INIT_INT_TABLE: unmatched send/receive."
940 call MPI_Comm_group(FG_COMM,fg_group,IERR)
941 c write (iout,*) "MPI_Comm_group ended"
943 call MPI_Group_incl(fg_group,ntask_cont_from+1,
944 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
945 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
946 & CONT_TO_GROUP,IERR)
949 iaux=4*(ielend(ii)-ielstart(ii)+1)
950 call MPI_Group_translate_ranks(fg_group,iaux,
951 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
952 & iint_sent_local(1,ielstart(ii),i),IERR )
953 c write (iout,*) "Ranks translated i=",i
956 iaux=4*(iturn3_end-iturn3_start+1)
957 call MPI_Group_translate_ranks(fg_group,iaux,
958 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
959 & iturn3_sent_local(1,iturn3_start),IERR)
960 iaux=4*(iturn4_end-iturn4_start+1)
961 call MPI_Group_translate_ranks(fg_group,iaux,
962 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
963 & iturn4_sent_local(1,iturn4_start),IERR)
965 write (iout,*) "iint_sent_local"
968 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
969 & j=ielstart(ii),ielend(ii))
972 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
973 & " iturn3_end",iturn3_end
974 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
975 & i=iturn3_start,iturn3_end)
976 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
977 & " iturn4_end",iturn4_end
978 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
979 & i=iturn4_start,iturn4_end)
982 call MPI_Group_free(fg_group,ierr)
983 call MPI_Group_free(cont_from_group,ierr)
984 call MPI_Group_free(cont_to_group,ierr)
985 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
986 call MPI_Type_commit(MPI_UYZ,IERROR)
987 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
989 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
990 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
991 call MPI_Type_commit(MPI_MU,IERROR)
992 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
993 call MPI_Type_commit(MPI_MAT1,IERROR)
994 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
995 call MPI_Type_commit(MPI_MAT2,IERROR)
996 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
997 call MPI_Type_commit(MPI_THET,IERROR)
998 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
999 call MPI_Type_commit(MPI_GAM,IERROR)
1001 c 9/22/08 Derived types to send matrices which appear in correlation terms
1003 if (ivec_count(i).eq.ivec_count(0)) then
1009 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1010 if (ind_typ.eq.0) then
1011 ichunk=ivec_count(0)
1013 ichunk=ivec_count(1)
1020 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1023 c blocklengths(i)=blocklengths(i)*ichunk
1025 c write (iout,*) "blocklengths and displs"
1027 c write (iout,*) i,blocklengths(i),displs(i)
1030 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1031 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1032 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1033 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1039 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1042 c blocklengths(i)=blocklengths(i)*ichunk
1044 c write (iout,*) "blocklengths and displs"
1046 c write (iout,*) i,blocklengths(i),displs(i)
1049 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1050 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1051 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1052 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1058 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1061 blocklengths(i)=blocklengths(i)*ichunk
1063 call MPI_Type_indexed(8,blocklengths,displs,
1064 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1065 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1071 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1074 blocklengths(i)=blocklengths(i)*ichunk
1076 call MPI_Type_indexed(8,blocklengths,displs,
1077 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1078 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1084 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1087 blocklengths(i)=blocklengths(i)*ichunk
1089 call MPI_Type_indexed(6,blocklengths,displs,
1090 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1091 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1097 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1100 blocklengths(i)=blocklengths(i)*ichunk
1102 call MPI_Type_indexed(2,blocklengths,displs,
1103 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1104 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1110 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1113 blocklengths(i)=blocklengths(i)*ichunk
1115 call MPI_Type_indexed(4,blocklengths,displs,
1116 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1117 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1121 iint_start=ivec_start+1
1124 iint_count(i)=ivec_count(i)
1125 iint_displ(i)=ivec_displ(i)
1126 ivec_displ(i)=ivec_displ(i)-1
1127 iset_displ(i)=iset_displ(i)-1
1128 ithet_displ(i)=ithet_displ(i)-1
1129 iphi_displ(i)=iphi_displ(i)-1
1130 iphi1_displ(i)=iphi1_displ(i)-1
1131 ibond_displ(i)=ibond_displ(i)-1
1133 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1134 & .and. (me.eq.0 .or. .not. out1file)) then
1135 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1137 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1140 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1141 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1142 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1144 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1147 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1148 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1149 & ' SC-p interactions','were distributed among',nfgtasks,
1150 & ' fine-grain processors.'
1166 idihconstr_end=ndih_constr
1167 iphid_start=iphi_start
1168 iphid_end=iphi_end-1
1188 c---------------------------------------------------------------------------
1189 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1191 include "DIMENSIONS"
1192 include "COMMON.INTERACT"
1193 include "COMMON.SETUP"
1194 include "COMMON.IOUNITS"
1195 integer ii,jj,itask(4),ntask_cont_to,
1196 &itask_cont_to(0:max_fg_procs-1)
1198 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1199 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1200 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1201 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1202 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1203 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1204 & ielend_all(maxres,0:max_fg_procs-1)
1205 integer iproc,isent,k,l
1206 c Determines whether to send interaction ii,jj to other processors; a given
1207 c interaction can be sent to at most 2 processors.
1208 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1209 c one processor, otherwise flag is unchanged from the input value.
1215 c write (iout,*) "ii",ii," jj",jj
1216 c Loop over processors to check if anybody could need interaction ii,jj
1217 do iproc=0,fg_rank-1
1218 c Check if the interaction matches any turn3 at iproc
1219 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1221 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1222 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1224 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1227 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1228 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1231 call add_task(iproc,ntask_cont_to,itask_cont_to)
1235 C Check if the interaction matches any turn4 at iproc
1236 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1238 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1239 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1241 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1244 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1245 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1248 call add_task(iproc,ntask_cont_to,itask_cont_to)
1252 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1253 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1254 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1255 & ielend_all(ii-1,iproc).ge.jj-1) then
1257 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1258 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1261 call add_task(iproc,ntask_cont_to,itask_cont_to)
1264 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1265 & ielend_all(ii-1,iproc).ge.jj+1) then
1267 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1268 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1271 call add_task(iproc,ntask_cont_to,itask_cont_to)
1278 c---------------------------------------------------------------------------
1279 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1281 include "DIMENSIONS"
1282 include "COMMON.INTERACT"
1283 include "COMMON.SETUP"
1284 include "COMMON.IOUNITS"
1285 integer ii,jj,itask(2),ntask_cont_from,
1286 & itask_cont_from(0:max_fg_procs-1)
1288 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1289 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1290 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1291 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1292 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1293 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1294 & ielend_all(maxres,0:max_fg_procs-1)
1296 do iproc=fg_rank+1,nfgtasks-1
1297 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1299 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1300 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1302 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1303 call add_task(iproc,ntask_cont_from,itask_cont_from)
1306 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1308 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1309 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1311 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1312 call add_task(iproc,ntask_cont_from,itask_cont_from)
1315 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
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)
1327 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1329 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1330 & jj-1.le.ielend_all(ii-1,iproc)) then
1331 call add_task(iproc,ntask_cont_from,itask_cont_from)
1333 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1334 & jj+1.le.ielend_all(ii-1,iproc)) then
1335 call add_task(iproc,ntask_cont_from,itask_cont_from)
1342 c---------------------------------------------------------------------------
1343 subroutine add_task(iproc,ntask_cont,itask_cont)
1345 include "DIMENSIONS"
1346 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1349 if (itask_cont(ii).eq.iproc) return
1351 ntask_cont=ntask_cont+1
1352 itask_cont(ntask_cont)=iproc
1355 c---------------------------------------------------------------------------
1356 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1357 implicit real*8 (a-h,o-z)
1358 include 'DIMENSIONS'
1360 include 'COMMON.SETUP'
1361 integer total_ints,lower_bound,upper_bound
1362 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1363 nint=total_ints/nfgtasks
1367 nexcess=total_ints-nint*nfgtasks
1369 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1373 lower_bound=lower_bound+int4proc(i)
1375 upper_bound=lower_bound+int4proc(fg_rank)
1376 lower_bound=lower_bound+1
1379 c---------------------------------------------------------------------------
1380 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1381 implicit real*8 (a-h,o-z)
1382 include 'DIMENSIONS'
1384 include 'COMMON.SETUP'
1385 integer total_ints,lower_bound,upper_bound
1386 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1387 nint=total_ints/nfgtasks1
1391 nexcess=total_ints-nint*nfgtasks1
1393 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1397 lower_bound=lower_bound+int4proc(i)
1399 upper_bound=lower_bound+int4proc(fg_rank1)
1400 lower_bound=lower_bound+1
1403 c---------------------------------------------------------------------------
1404 subroutine int_partition(int_index,lower_index,upper_index,atom,
1405 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1408 include 'COMMON.IOUNITS'
1409 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1410 & first_atom,last_atom,int_gr,jat_start,jat_end
1413 if (lprn) write (iout,*) 'int_index=',int_index
1414 int_index_old=int_index
1415 int_index=int_index+last_atom-first_atom+1
1417 & write (iout,*) 'int_index=',int_index,
1418 & ' int_index_old',int_index_old,
1419 & ' lower_index=',lower_index,
1420 & ' upper_index=',upper_index,
1421 & ' atom=',atom,' first_atom=',first_atom,
1422 & ' last_atom=',last_atom
1423 if (int_index.ge.lower_index) then
1425 if (at_start.eq.0) then
1427 jat_start=first_atom-1+lower_index-int_index_old
1429 jat_start=first_atom
1431 if (lprn) write (iout,*) 'jat_start',jat_start
1432 if (int_index.ge.upper_index) then
1434 jat_end=first_atom-1+upper_index-int_index_old
1439 if (lprn) write (iout,*) 'jat_end',jat_end
1444 c------------------------------------------------------------------------------
1445 subroutine hpb_partition
1446 implicit real*8 (a-h,o-z)
1447 include 'DIMENSIONS'
1451 include 'COMMON.SBRIDGE'
1452 include 'COMMON.IOUNITS'
1453 include 'COMMON.SETUP'
1455 call int_bounds(nhpb,link_start,link_end)
1456 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1457 & ' absolute rank',MyRank,
1458 & ' nhpb',nhpb,' link_start=',link_start,
1459 & ' link_end',link_end