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
125 C Lipidic input file for parameters range 60-79
127 C input file for transfer sidechain and peptide group inside the
128 C lipidic environment if lipid is implicite
130 C DNA input files for parameters range 80-99
131 C Suger input files for parameters range 100-119
132 C All-atom input files for parameters range 120-149
134 C Set default weights of the energy terms.
145 c print '(a,$)','Inside initialize'
146 c call memmon_print_usage()
181 athet(j,i,ichir1,ichir2)=0.0D0
182 bthet(j,i,ichir1,ichir2)=0.0D0
202 gaussc(l,k,j,i)=0.0D0
212 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
216 v1(k,j,i,iblock)=0.0D0
217 v2(k,j,i,iblock)=0.0D0
227 v1c(1,l,i,j,k,iblock)=0.0D0
228 v1s(1,l,i,j,k,iblock)=0.0D0
229 v1c(2,l,i,j,k,iblock)=0.0D0
230 v1s(2,l,i,j,k,iblock)=0.0D0
234 v2c(m,l,i,j,k,iblock)=0.0D0
235 v2s(m,l,i,j,k,iblock)=0.0D0
247 C Initialize the bridge arrays
261 C Initialize correlation arrays
292 C Initialize variables used in minimization.
301 C Initialize the variables responsible for the mode of gradient storage.
306 C Initialize constants used to split the energy into long- and short-range
312 nprint_ene=nprint_ene-1
316 c-------------------------------------------------------------------------
318 implicit real*8 (a-h,o-z)
320 include 'COMMON.NAMES'
321 include 'COMMON.FFIELD'
323 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
324 & 'DSG','DGN','DSN','DTH',
325 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
326 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
327 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
330 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
331 &'a','y','w','v','l','i','f','m','c','x',
332 &'C','M','F','I','L','V','W','Y','A','G','T',
333 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
334 data potname /'LJ','LJK','BP','GB','GBV'/
336 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
337 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
338 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
339 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR",
340 & "ELIPTRAN", "EAFM", "ETHETCNSTR", " "/
342 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
343 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
344 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
345 & "WLT", "WAFM", "WTHETCNSR", " "/
347 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
350 c---------------------------------------------------------------------------
351 subroutine init_int_table
352 implicit real*8 (a-h,o-z)
356 integer blocklengths(15),displs(15)
358 include 'COMMON.CONTROL'
359 include 'COMMON.SETUP'
360 include 'COMMON.CHAIN'
361 include 'COMMON.INTERACT'
362 include 'COMMON.LOCAL'
363 include 'COMMON.SBRIDGE'
364 include 'COMMON.TORCNSTR'
365 include 'COMMON.IOUNITS'
366 include 'COMMON.DERIV'
367 include 'COMMON.CONTACTS'
368 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
369 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
370 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
371 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
372 & ielend_all(maxres,0:max_fg_procs-1),
373 & ntask_cont_from_all(0:max_fg_procs-1),
374 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
375 & ntask_cont_to_all(0:max_fg_procs-1),
376 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
377 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
378 logical scheck,lprint,flag
380 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
381 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
382 C... Determine the numbers of start and end SC-SC interaction
383 C... to deal with by current processor.
385 itask_cont_from(i)=fg_rank
386 itask_cont_to(i)=fg_rank
390 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
391 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
392 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
394 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
395 & ' absolute rank',MyRank,
396 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
397 & ' my_sc_inde',my_sc_inde
417 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
418 cd & (ihpb(i),jhpb(i),i=1,nss)
423 if (ihpb(ii).eq.i+nres) then
430 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
434 c write (iout,*) 'jj=i+1'
435 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
436 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
442 else if (jj.eq.nct) then
444 c write (iout,*) 'jj=nct'
445 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
446 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
454 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
455 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
457 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
458 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
469 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
470 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
475 ind_scint=ind_scint+nct-i
479 ind_scint_old=ind_scint
487 if (iatsc_s.eq.0) iatsc_s=1
489 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
490 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
493 write (iout,'(a)') 'Interaction array:'
495 write (iout,'(i3,2(2x,2i3))')
496 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
501 C Now partition the electrostatic-interaction array
503 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
504 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
506 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
507 & ' absolute rank',MyRank,
508 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
509 & ' my_ele_inde',my_ele_inde
516 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
517 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
520 if (iatel_s.eq.0) iatel_s=1
521 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
522 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
523 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
524 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
525 c & " my_ele_inde_vdw",my_ele_inde_vdw
532 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
534 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
536 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
537 c & " ielend_vdw",ielend_vdw(i)
539 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
550 do i=iatel_s_vdw,iatel_e_vdw
556 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
557 & ' absolute rank',MyRank
558 write (iout,*) 'Electrostatic interaction array:'
560 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
565 C Partition the SC-p interaction array
567 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
568 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
569 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
570 & ' absolute rank',myrank,
571 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
572 & ' my_scp_inde',my_scp_inde
578 if (i.lt.nnt+iscp) then
579 cd write (iout,*) 'i.le.nnt+iscp'
580 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
581 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
583 else if (i.gt.nct-iscp) then
584 cd write (iout,*) 'i.gt.nct-iscp'
585 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
586 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
589 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
590 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
593 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
594 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
603 if (i.lt.nnt+iscp) then
605 iscpstart(i,1)=i+iscp
607 elseif (i.gt.nct-iscp) then
615 iscpstart(i,2)=i+iscp
620 if (iatscp_s.eq.0) iatscp_s=1
622 write (iout,'(a)') 'SC-p interaction array:'
623 do i=iatscp_s,iatscp_e
624 write (iout,'(i3,2(2x,2i3))')
625 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
628 C Partition local interactions
630 call int_bounds(nres-2,loc_start,loc_end)
631 loc_start=loc_start+1
633 call int_bounds(nres-2,ithet_start,ithet_end)
634 ithet_start=ithet_start+2
635 ithet_end=ithet_end+2
636 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
637 iturn3_start=iturn3_start+nnt
638 iphi_start=iturn3_start+2
639 iturn3_end=iturn3_end+nnt
640 iphi_end=iturn3_end+2
641 iturn3_start=iturn3_start-1
642 iturn3_end=iturn3_end-1
643 call int_bounds(nres-3,itau_start,itau_end)
644 itau_start=itau_start+3
646 call int_bounds(nres-3,iphi1_start,iphi1_end)
647 iphi1_start=iphi1_start+3
648 iphi1_end=iphi1_end+3
649 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
650 iturn4_start=iturn4_start+nnt
651 iphid_start=iturn4_start+2
652 iturn4_end=iturn4_end+nnt
653 iphid_end=iturn4_end+2
654 iturn4_start=iturn4_start-1
655 iturn4_end=iturn4_end-1
656 call int_bounds(nres-2,ibond_start,ibond_end)
657 ibond_start=ibond_start+1
658 ibond_end=ibond_end+1
659 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
660 ibondp_start=ibondp_start+nnt
661 ibondp_end=ibondp_end+nnt
662 call int_bounds(nres,ilip_start,ilip_end)
663 ilip_start=ilip_start
665 call int_bounds(nres-1,itube_start,itube_end)
666 itube_start=itube_start
668 call int_bounds1(nres-1,ivec_start,ivec_end)
669 c print *,"Processor",myrank,fg_rank,fg_rank1,
670 c & " ivec_start",ivec_start," ivec_end",ivec_end
671 iset_start=loc_start+2
673 if (ndih_constr.eq.0) then
677 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
679 if (ntheta_constr.eq.0) then
684 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
686 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
688 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
690 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
691 igrad_start=((2*nlen+1)
692 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
693 jgrad_start(igrad_start)=
694 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
696 jgrad_end(igrad_start)=nres
697 igrad_end=((2*nlen+1)
698 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
699 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
700 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
702 do i=igrad_start+1,igrad_end-1
707 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
708 & ' absolute rank',myrank,
709 & ' loc_start',loc_start,' loc_end',loc_end,
710 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
711 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
712 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
713 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
714 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
715 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
716 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
717 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
718 & ' iset_start',iset_start,' iset_end',iset_end,
719 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
721 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
724 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
725 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
726 & ' ngrad_end',ngrad_end
727 do i=igrad_start,igrad_end
728 write(*,*) 'Processor:',fg_rank,myrank,i,
729 & jgrad_start(i),jgrad_end(i)
732 if (nfgtasks.gt.1) then
733 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
734 & MPI_INTEGER,FG_COMM1,IERROR)
735 iaux=ivec_end-ivec_start+1
736 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
737 & MPI_INTEGER,FG_COMM1,IERROR)
738 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
739 & MPI_INTEGER,FG_COMM,IERROR)
740 iaux=iset_end-iset_start+1
741 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
742 & MPI_INTEGER,FG_COMM,IERROR)
743 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
744 & MPI_INTEGER,FG_COMM,IERROR)
745 iaux=ibond_end-ibond_start+1
746 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
747 & MPI_INTEGER,FG_COMM,IERROR)
748 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
749 & MPI_INTEGER,FG_COMM,IERROR)
750 iaux=ithet_end-ithet_start+1
751 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
752 & MPI_INTEGER,FG_COMM,IERROR)
753 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
754 & MPI_INTEGER,FG_COMM,IERROR)
755 iaux=iphi_end-iphi_start+1
756 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
757 & MPI_INTEGER,FG_COMM,IERROR)
758 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
759 & MPI_INTEGER,FG_COMM,IERROR)
760 iaux=iphi1_end-iphi1_start+1
761 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
762 & MPI_INTEGER,FG_COMM,IERROR)
763 do i=0,max_fg_procs-1
769 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
770 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
771 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
772 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
773 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
774 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
775 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
776 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
777 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
778 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
779 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
780 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
781 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
782 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
783 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
784 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
786 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
787 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
788 write (iout,*) "iturn3_start_all",
789 & (iturn3_start_all(i),i=0,nfgtasks-1)
790 write (iout,*) "iturn3_end_all",
791 & (iturn3_end_all(i),i=0,nfgtasks-1)
792 write (iout,*) "iturn4_start_all",
793 & (iturn4_start_all(i),i=0,nfgtasks-1)
794 write (iout,*) "iturn4_end_all",
795 & (iturn4_end_all(i),i=0,nfgtasks-1)
796 write (iout,*) "The ielstart_all array"
798 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
800 write (iout,*) "The ielend_all array"
802 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
808 itask_cont_from(0)=fg_rank
809 itask_cont_to(0)=fg_rank
811 do ii=iturn3_start,iturn3_end
812 call add_int(ii,ii+2,iturn3_sent(1,ii),
813 & ntask_cont_to,itask_cont_to,flag)
815 do ii=iturn4_start,iturn4_end
816 call add_int(ii,ii+3,iturn4_sent(1,ii),
817 & ntask_cont_to,itask_cont_to,flag)
819 do ii=iturn3_start,iturn3_end
820 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
822 do ii=iturn4_start,iturn4_end
823 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
826 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
827 & " ntask_cont_to",ntask_cont_to
828 write (iout,*) "itask_cont_from",
829 & (itask_cont_from(i),i=1,ntask_cont_from)
830 write (iout,*) "itask_cont_to",
831 & (itask_cont_to(i),i=1,ntask_cont_to)
834 c write (iout,*) "Loop forward"
837 c write (iout,*) "from loop i=",i
839 do j=ielstart(i),ielend(i)
840 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
843 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
844 c & " iatel_e",iatel_e
848 c write (iout,*) "i",i," ielstart",ielstart(i),
849 c & " ielend",ielend(i)
852 do j=ielstart(i),ielend(i)
853 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
854 & itask_cont_to,flag)
862 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
863 & " ntask_cont_to",ntask_cont_to
864 write (iout,*) "itask_cont_from",
865 & (itask_cont_from(i),i=1,ntask_cont_from)
866 write (iout,*) "itask_cont_to",
867 & (itask_cont_to(i),i=1,ntask_cont_to)
869 write (iout,*) "iint_sent"
872 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
873 & j=ielstart(ii),ielend(ii))
875 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
876 & " iturn3_end",iturn3_end
877 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
878 & i=iturn3_start,iturn3_end)
879 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
880 & " iturn4_end",iturn4_end
881 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
882 & i=iturn4_start,iturn4_end)
885 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
886 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
887 c write (iout,*) "Gather ntask_cont_from ended"
889 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
890 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
892 c write (iout,*) "Gather itask_cont_from ended"
894 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
895 & 1,MPI_INTEGER,king,FG_COMM,IERR)
896 c write (iout,*) "Gather ntask_cont_to ended"
898 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
899 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
900 c write (iout,*) "Gather itask_cont_to ended"
902 if (fg_rank.eq.king) then
903 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
905 write (iout,'(20i4)') i,ntask_cont_from_all(i),
906 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
910 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
912 write (iout,'(20i4)') i,ntask_cont_to_all(i),
913 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
917 C Check if every send will have a matching receive
921 ncheck_to=ncheck_to+ntask_cont_to_all(i)
922 ncheck_from=ncheck_from+ntask_cont_from_all(i)
924 write (iout,*) "Control sums",ncheck_from,ncheck_to
925 if (ncheck_from.ne.ncheck_to) then
926 write (iout,*) "Error: #receive differs from #send."
927 write (iout,*) "Terminating program...!"
933 do j=1,ntask_cont_to_all(i)
934 ii=itask_cont_to_all(j,i)
935 do k=1,ntask_cont_from_all(ii)
936 if (itask_cont_from_all(k,ii).eq.i) then
937 if(lprint)write(iout,*)"Matching send/receive",i,ii
941 if (k.eq.ntask_cont_from_all(ii)+1) then
943 write (iout,*) "Error: send by",j," to",ii,
944 & " would have no matching receive"
950 write (iout,*) "Unmatched sends; terminating program"
954 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
955 c write (iout,*) "flag broadcast ended flag=",flag
958 call MPI_Finalize(IERROR)
959 stop "Error in INIT_INT_TABLE: unmatched send/receive."
961 call MPI_Comm_group(FG_COMM,fg_group,IERR)
962 c write (iout,*) "MPI_Comm_group ended"
964 call MPI_Group_incl(fg_group,ntask_cont_from+1,
965 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
966 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
967 & CONT_TO_GROUP,IERR)
970 iaux=4*(ielend(ii)-ielstart(ii)+1)
971 call MPI_Group_translate_ranks(fg_group,iaux,
972 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
973 & iint_sent_local(1,ielstart(ii),i),IERR )
974 c write (iout,*) "Ranks translated i=",i
977 iaux=4*(iturn3_end-iturn3_start+1)
978 call MPI_Group_translate_ranks(fg_group,iaux,
979 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
980 & iturn3_sent_local(1,iturn3_start),IERR)
981 iaux=4*(iturn4_end-iturn4_start+1)
982 call MPI_Group_translate_ranks(fg_group,iaux,
983 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
984 & iturn4_sent_local(1,iturn4_start),IERR)
986 write (iout,*) "iint_sent_local"
989 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
990 & j=ielstart(ii),ielend(ii))
993 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
994 & " iturn3_end",iturn3_end
995 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
996 & i=iturn3_start,iturn3_end)
997 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
998 & " iturn4_end",iturn4_end
999 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1000 & i=iturn4_start,iturn4_end)
1003 call MPI_Group_free(fg_group,ierr)
1004 call MPI_Group_free(cont_from_group,ierr)
1005 call MPI_Group_free(cont_to_group,ierr)
1006 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1007 call MPI_Type_commit(MPI_UYZ,IERROR)
1008 call MPI_Type_contiguous(maxcontsshi,MPI_INTEGER,MPI_I50,IERROR)
1009 call MPI_Type_commit(MPI_I50,IERROR)
1010 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1012 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1013 impishi=maxcontsshi*3
1014 call MPI_Type_contiguous(impishi,MPI_DOUBLE_PRECISION,
1016 call MPI_Type_commit(MPI_SHI,IERROR)
1017 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1018 call MPI_Type_commit(MPI_MU,IERROR)
1019 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1020 call MPI_Type_commit(MPI_MAT1,IERROR)
1021 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1022 call MPI_Type_commit(MPI_MAT2,IERROR)
1023 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1024 call MPI_Type_commit(MPI_THET,IERROR)
1025 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1026 call MPI_Type_commit(MPI_GAM,IERROR)
1028 c 9/22/08 Derived types to send matrices which appear in correlation terms
1030 if (ivec_count(i).eq.ivec_count(0)) then
1036 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1037 if (ind_typ.eq.0) then
1038 ichunk=ivec_count(0)
1040 ichunk=ivec_count(1)
1047 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1050 c blocklengths(i)=blocklengths(i)*ichunk
1052 c write (iout,*) "blocklengths and displs"
1054 c write (iout,*) i,blocklengths(i),displs(i)
1057 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1058 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1059 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1060 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1066 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1069 c blocklengths(i)=blocklengths(i)*ichunk
1071 c write (iout,*) "blocklengths and displs"
1073 c write (iout,*) i,blocklengths(i),displs(i)
1076 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1077 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1078 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1079 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1085 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1088 blocklengths(i)=blocklengths(i)*ichunk
1090 call MPI_Type_indexed(8,blocklengths,displs,
1091 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1092 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1098 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1101 blocklengths(i)=blocklengths(i)*ichunk
1103 call MPI_Type_indexed(8,blocklengths,displs,
1104 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1105 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1111 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1114 blocklengths(i)=blocklengths(i)*ichunk
1116 call MPI_Type_indexed(6,blocklengths,displs,
1117 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1118 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1124 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1127 blocklengths(i)=blocklengths(i)*ichunk
1129 call MPI_Type_indexed(2,blocklengths,displs,
1130 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1131 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1137 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1140 blocklengths(i)=blocklengths(i)*ichunk
1142 call MPI_Type_indexed(4,blocklengths,displs,
1143 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1144 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1148 iint_start=ivec_start+1
1151 iint_count(i)=ivec_count(i)
1152 iint_displ(i)=ivec_displ(i)
1153 ivec_displ(i)=ivec_displ(i)-1
1154 iset_displ(i)=iset_displ(i)-1
1155 ithet_displ(i)=ithet_displ(i)-1
1156 iphi_displ(i)=iphi_displ(i)-1
1157 iphi1_displ(i)=iphi1_displ(i)-1
1158 ibond_displ(i)=ibond_displ(i)-1
1160 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1161 & .and. (me.eq.0 .or. .not. out1file)) then
1162 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1164 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1167 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1168 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1169 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1171 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1174 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1175 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1176 & ' SC-p interactions','were distributed among',nfgtasks,
1177 & ' fine-grain processors.'
1193 idihconstr_end=ndih_constr
1194 ithetaconstr_start=1
1195 ithetaconstr_end=ntheta_constr
1196 iphid_start=iphi_start
1197 iphid_end=iphi_end-1
1220 c---------------------------------------------------------------------------
1221 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1223 include "DIMENSIONS"
1224 include "COMMON.INTERACT"
1225 include "COMMON.SETUP"
1226 include "COMMON.IOUNITS"
1227 integer ii,jj,itask(4),ntask_cont_to,
1228 &itask_cont_to(0:max_fg_procs-1)
1230 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1231 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1232 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1233 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1234 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1235 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1236 & ielend_all(maxres,0:max_fg_procs-1)
1237 integer iproc,isent,k,l
1238 c Determines whether to send interaction ii,jj to other processors; a given
1239 c interaction can be sent to at most 2 processors.
1240 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1241 c one processor, otherwise flag is unchanged from the input value.
1247 c write (iout,*) "ii",ii," jj",jj
1248 c Loop over processors to check if anybody could need interaction ii,jj
1249 do iproc=0,fg_rank-1
1250 c Check if the interaction matches any turn3 at iproc
1251 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1253 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1254 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1256 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1259 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1260 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1263 call add_task(iproc,ntask_cont_to,itask_cont_to)
1267 C Check if the interaction matches any turn4 at iproc
1268 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1270 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1271 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1273 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1276 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1277 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1280 call add_task(iproc,ntask_cont_to,itask_cont_to)
1284 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1285 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1286 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1287 & ielend_all(ii-1,iproc).ge.jj-1) then
1289 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1290 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1293 call add_task(iproc,ntask_cont_to,itask_cont_to)
1296 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1297 & ielend_all(ii-1,iproc).ge.jj+1) then
1299 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1300 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1303 call add_task(iproc,ntask_cont_to,itask_cont_to)
1310 c---------------------------------------------------------------------------
1311 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1313 include "DIMENSIONS"
1314 include "COMMON.INTERACT"
1315 include "COMMON.SETUP"
1316 include "COMMON.IOUNITS"
1317 integer ii,jj,itask(2),ntask_cont_from,
1318 & itask_cont_from(0:max_fg_procs-1)
1320 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1321 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1322 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1323 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1324 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1325 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1326 & ielend_all(maxres,0:max_fg_procs-1)
1328 do iproc=fg_rank+1,nfgtasks-1
1329 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1331 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1332 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1334 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1335 call add_task(iproc,ntask_cont_from,itask_cont_from)
1338 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1340 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1341 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1343 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1344 call add_task(iproc,ntask_cont_from,itask_cont_from)
1347 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1348 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1350 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1351 & jj+1.le.ielend_all(ii+1,iproc)) then
1352 call add_task(iproc,ntask_cont_from,itask_cont_from)
1354 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1355 & jj-1.le.ielend_all(ii+1,iproc)) then
1356 call add_task(iproc,ntask_cont_from,itask_cont_from)
1359 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1361 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1362 & jj-1.le.ielend_all(ii-1,iproc)) then
1363 call add_task(iproc,ntask_cont_from,itask_cont_from)
1365 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1366 & jj+1.le.ielend_all(ii-1,iproc)) then
1367 call add_task(iproc,ntask_cont_from,itask_cont_from)
1374 c---------------------------------------------------------------------------
1375 subroutine add_task(iproc,ntask_cont,itask_cont)
1377 include "DIMENSIONS"
1378 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1381 if (itask_cont(ii).eq.iproc) return
1383 ntask_cont=ntask_cont+1
1384 itask_cont(ntask_cont)=iproc
1387 c---------------------------------------------------------------------------
1388 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1389 implicit real*8 (a-h,o-z)
1390 include 'DIMENSIONS'
1392 include 'COMMON.SETUP'
1393 integer total_ints,lower_bound,upper_bound
1394 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1395 nint=total_ints/nfgtasks
1399 nexcess=total_ints-nint*nfgtasks
1401 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1405 lower_bound=lower_bound+int4proc(i)
1407 upper_bound=lower_bound+int4proc(fg_rank)
1408 lower_bound=lower_bound+1
1411 c---------------------------------------------------------------------------
1412 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1413 implicit real*8 (a-h,o-z)
1414 include 'DIMENSIONS'
1416 include 'COMMON.SETUP'
1417 integer total_ints,lower_bound,upper_bound
1418 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1419 nint=total_ints/nfgtasks1
1423 nexcess=total_ints-nint*nfgtasks1
1425 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1429 lower_bound=lower_bound+int4proc(i)
1431 upper_bound=lower_bound+int4proc(fg_rank1)
1432 lower_bound=lower_bound+1
1435 c---------------------------------------------------------------------------
1436 subroutine int_partition(int_index,lower_index,upper_index,atom,
1437 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1438 implicit real*8 (a-h,o-z)
1439 include 'DIMENSIONS'
1440 include 'COMMON.IOUNITS'
1441 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1442 & first_atom,last_atom,int_gr,jat_start,jat_end
1445 if (lprn) write (iout,*) 'int_index=',int_index
1446 int_index_old=int_index
1447 int_index=int_index+last_atom-first_atom+1
1449 & write (iout,*) 'int_index=',int_index,
1450 & ' int_index_old',int_index_old,
1451 & ' lower_index=',lower_index,
1452 & ' upper_index=',upper_index,
1453 & ' atom=',atom,' first_atom=',first_atom,
1454 & ' last_atom=',last_atom
1455 if (int_index.ge.lower_index) then
1457 if (at_start.eq.0) then
1459 jat_start=first_atom-1+lower_index-int_index_old
1461 jat_start=first_atom
1463 if (lprn) write (iout,*) 'jat_start',jat_start
1464 if (int_index.ge.upper_index) then
1466 jat_end=first_atom-1+upper_index-int_index_old
1471 if (lprn) write (iout,*) 'jat_end',jat_end
1476 c------------------------------------------------------------------------------
1477 subroutine hpb_partition
1478 implicit real*8 (a-h,o-z)
1479 include 'DIMENSIONS'
1483 include 'COMMON.SBRIDGE'
1484 include 'COMMON.IOUNITS'
1485 include 'COMMON.SETUP'
1487 call int_bounds(nhpb,link_start,link_end)
1488 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1489 & ' absolute rank',MyRank,
1490 & ' nhpb',nhpb,' link_start=',link_start,
1491 & ' link_end',link_end