2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
123 C Lipidic input file for parameters range 60-79
125 C input file for transfer sidechain and peptide group inside the
126 C lipidic environment if lipid is implicite
128 C DNA input files for parameters range 80-99
129 C Suger input files for parameters range 100-119
130 C All-atom input files for parameters range 120-149
132 C Set default weights of the energy terms.
143 c print '(a,$)','Inside initialize'
144 c call memmon_print_usage()
179 athet(j,i,ichir1,ichir2)=0.0D0
180 bthet(j,i,ichir1,ichir2)=0.0D0
200 gaussc(l,k,j,i)=0.0D0
210 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
214 v1(k,j,i,iblock)=0.0D0
215 v2(k,j,i,iblock)=0.0D0
225 v1c(1,l,i,j,k,iblock)=0.0D0
226 v1s(1,l,i,j,k,iblock)=0.0D0
227 v1c(2,l,i,j,k,iblock)=0.0D0
228 v1s(2,l,i,j,k,iblock)=0.0D0
232 v2c(m,l,i,j,k,iblock)=0.0D0
233 v2s(m,l,i,j,k,iblock)=0.0D0
245 C Initialize the bridge arrays
259 C Initialize correlation arrays
290 C Initialize variables used in minimization.
299 C Initialize the variables responsible for the mode of gradient storage.
304 C Initialize constants used to split the energy into long- and short-range
310 nprint_ene=nprint_ene-1
314 c-------------------------------------------------------------------------
316 implicit real*8 (a-h,o-z)
318 include 'COMMON.NAMES'
319 include 'COMMON.FFIELD'
321 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
322 & 'DSG','DGN','DSN','DTH',
323 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
324 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
325 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
328 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
329 &'a','y','w','v','l','i','f','m','c','x',
330 &'C','M','F','I','L','V','W','Y','A','G','T',
331 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
332 data potname /'LJ','LJK','BP','GB','GBV'/
334 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
335 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
336 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
337 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR",
338 & "ELIPTRAN", "EAFM", "ETHETCNSTR", " "/
340 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
341 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
342 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
343 & "WLT", "WAFM", "WTHETCNSR", " "/
345 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
348 c---------------------------------------------------------------------------
349 subroutine init_int_table
350 implicit real*8 (a-h,o-z)
354 integer blocklengths(15),displs(15)
356 include 'COMMON.CONTROL'
357 include 'COMMON.SETUP'
358 include 'COMMON.CHAIN'
359 include 'COMMON.INTERACT'
360 include 'COMMON.LOCAL'
361 include 'COMMON.SBRIDGE'
362 include 'COMMON.TORCNSTR'
363 include 'COMMON.IOUNITS'
364 include 'COMMON.DERIV'
365 include 'COMMON.CONTACTS'
366 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
367 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
368 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
369 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
370 & ielend_all(maxres,0:max_fg_procs-1),
371 & ntask_cont_from_all(0:max_fg_procs-1),
372 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
373 & ntask_cont_to_all(0:max_fg_procs-1),
374 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
375 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
376 logical scheck,lprint,flag
378 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
379 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
380 C... Determine the numbers of start and end SC-SC interaction
381 C... to deal with by current processor.
383 itask_cont_from(i)=fg_rank
384 itask_cont_to(i)=fg_rank
388 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
389 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
390 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
392 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
393 & ' absolute rank',MyRank,
394 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
395 & ' my_sc_inde',my_sc_inde
415 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
416 cd & (ihpb(i),jhpb(i),i=1,nss)
421 if (ihpb(ii).eq.i+nres) then
428 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
432 c write (iout,*) 'jj=i+1'
433 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
434 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
440 else if (jj.eq.nct) then
442 c write (iout,*) 'jj=nct'
443 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
444 & iatsc_s,iatsc_e,i+1,nct-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,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
455 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
456 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
467 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
468 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
473 ind_scint=ind_scint+nct-i
477 ind_scint_old=ind_scint
485 if (iatsc_s.eq.0) iatsc_s=1
487 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
488 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
491 write (iout,'(a)') 'Interaction array:'
493 write (iout,'(i3,2(2x,2i3))')
494 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
499 C Now partition the electrostatic-interaction array
501 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
502 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
504 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
505 & ' absolute rank',MyRank,
506 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
507 & ' my_ele_inde',my_ele_inde
514 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
515 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
518 if (iatel_s.eq.0) iatel_s=1
519 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
520 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
521 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
522 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
523 c & " my_ele_inde_vdw",my_ele_inde_vdw
530 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
532 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
534 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
535 c & " ielend_vdw",ielend_vdw(i)
537 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
548 do i=iatel_s_vdw,iatel_e_vdw
554 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
555 & ' absolute rank',MyRank
556 write (iout,*) 'Electrostatic interaction array:'
558 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
563 C Partition the SC-p interaction array
565 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
566 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
567 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
568 & ' absolute rank',myrank,
569 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
570 & ' my_scp_inde',my_scp_inde
576 if (i.lt.nnt+iscp) then
577 cd write (iout,*) 'i.le.nnt+iscp'
578 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
579 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
581 else if (i.gt.nct-iscp) then
582 cd write (iout,*) 'i.gt.nct-iscp'
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,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
591 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
592 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
601 if (i.lt.nnt+iscp) then
603 iscpstart(i,1)=i+iscp
605 elseif (i.gt.nct-iscp) then
613 iscpstart(i,2)=i+iscp
618 if (iatscp_s.eq.0) iatscp_s=1
620 write (iout,'(a)') 'SC-p interaction array:'
621 do i=iatscp_s,iatscp_e
622 write (iout,'(i3,2(2x,2i3))')
623 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
626 C Partition local interactions
628 call int_bounds(nres-2,loc_start,loc_end)
629 loc_start=loc_start+1
631 call int_bounds(nres-2,ithet_start,ithet_end)
632 ithet_start=ithet_start+2
633 ithet_end=ithet_end+2
634 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
635 iturn3_start=iturn3_start+nnt
636 iphi_start=iturn3_start+2
637 iturn3_end=iturn3_end+nnt
638 iphi_end=iturn3_end+2
639 iturn3_start=iturn3_start-1
640 iturn3_end=iturn3_end-1
641 call int_bounds(nres-3,itau_start,itau_end)
642 itau_start=itau_start+3
644 call int_bounds(nres-3,iphi1_start,iphi1_end)
645 iphi1_start=iphi1_start+3
646 iphi1_end=iphi1_end+3
647 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
648 iturn4_start=iturn4_start+nnt
649 iphid_start=iturn4_start+2
650 iturn4_end=iturn4_end+nnt
651 iphid_end=iturn4_end+2
652 iturn4_start=iturn4_start-1
653 iturn4_end=iturn4_end-1
654 call int_bounds(nres-2,ibond_start,ibond_end)
655 ibond_start=ibond_start+1
656 ibond_end=ibond_end+1
657 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
658 ibondp_start=ibondp_start+nnt
659 ibondp_end=ibondp_end+nnt
660 call int_bounds(nres,ilip_start,ilip_end)
661 ilip_start=ilip_start
662 call int_bounds1(nres-1,ivec_start,ivec_end)
663 c print *,"Processor",myrank,fg_rank,fg_rank1,
664 c & " ivec_start",ivec_start," ivec_end",ivec_end
665 iset_start=loc_start+2
667 if (ndih_constr.eq.0) then
671 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
673 if (ntheta_constr.eq.0) then
678 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
680 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
682 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
684 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
685 igrad_start=((2*nlen+1)
686 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
687 jgrad_start(igrad_start)=
688 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
690 jgrad_end(igrad_start)=nres
691 igrad_end=((2*nlen+1)
692 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
693 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
694 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
696 do i=igrad_start+1,igrad_end-1
701 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
702 & ' absolute rank',myrank,
703 & ' loc_start',loc_start,' loc_end',loc_end,
704 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
705 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
706 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
707 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
708 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
709 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
710 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
711 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
712 & ' iset_start',iset_start,' iset_end',iset_end,
713 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
715 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
718 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
719 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
720 & ' ngrad_end',ngrad_end
721 do i=igrad_start,igrad_end
722 write(*,*) 'Processor:',fg_rank,myrank,i,
723 & jgrad_start(i),jgrad_end(i)
726 if (nfgtasks.gt.1) then
727 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
728 & MPI_INTEGER,FG_COMM1,IERROR)
729 iaux=ivec_end-ivec_start+1
730 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
731 & MPI_INTEGER,FG_COMM1,IERROR)
732 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
733 & MPI_INTEGER,FG_COMM,IERROR)
734 iaux=iset_end-iset_start+1
735 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
736 & MPI_INTEGER,FG_COMM,IERROR)
737 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
738 & MPI_INTEGER,FG_COMM,IERROR)
739 iaux=ibond_end-ibond_start+1
740 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
741 & MPI_INTEGER,FG_COMM,IERROR)
742 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
743 & MPI_INTEGER,FG_COMM,IERROR)
744 iaux=ithet_end-ithet_start+1
745 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
746 & MPI_INTEGER,FG_COMM,IERROR)
747 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
748 & MPI_INTEGER,FG_COMM,IERROR)
749 iaux=iphi_end-iphi_start+1
750 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
751 & MPI_INTEGER,FG_COMM,IERROR)
752 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
753 & MPI_INTEGER,FG_COMM,IERROR)
754 iaux=iphi1_end-iphi1_start+1
755 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
756 & MPI_INTEGER,FG_COMM,IERROR)
757 do i=0,max_fg_procs-1
763 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
764 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
765 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
766 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
767 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
768 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
769 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
770 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
771 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
772 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
773 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
774 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
775 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
776 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
777 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
778 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
780 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
781 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
782 write (iout,*) "iturn3_start_all",
783 & (iturn3_start_all(i),i=0,nfgtasks-1)
784 write (iout,*) "iturn3_end_all",
785 & (iturn3_end_all(i),i=0,nfgtasks-1)
786 write (iout,*) "iturn4_start_all",
787 & (iturn4_start_all(i),i=0,nfgtasks-1)
788 write (iout,*) "iturn4_end_all",
789 & (iturn4_end_all(i),i=0,nfgtasks-1)
790 write (iout,*) "The ielstart_all array"
792 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
794 write (iout,*) "The ielend_all array"
796 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
802 itask_cont_from(0)=fg_rank
803 itask_cont_to(0)=fg_rank
805 do ii=iturn3_start,iturn3_end
806 call add_int(ii,ii+2,iturn3_sent(1,ii),
807 & ntask_cont_to,itask_cont_to,flag)
809 do ii=iturn4_start,iturn4_end
810 call add_int(ii,ii+3,iturn4_sent(1,ii),
811 & ntask_cont_to,itask_cont_to,flag)
813 do ii=iturn3_start,iturn3_end
814 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
816 do ii=iturn4_start,iturn4_end
817 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
820 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
821 & " ntask_cont_to",ntask_cont_to
822 write (iout,*) "itask_cont_from",
823 & (itask_cont_from(i),i=1,ntask_cont_from)
824 write (iout,*) "itask_cont_to",
825 & (itask_cont_to(i),i=1,ntask_cont_to)
828 c write (iout,*) "Loop forward"
831 c write (iout,*) "from loop i=",i
833 do j=ielstart(i),ielend(i)
834 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
837 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
838 c & " iatel_e",iatel_e
842 c write (iout,*) "i",i," ielstart",ielstart(i),
843 c & " ielend",ielend(i)
846 do j=ielstart(i),ielend(i)
847 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
848 & itask_cont_to,flag)
856 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
857 & " ntask_cont_to",ntask_cont_to
858 write (iout,*) "itask_cont_from",
859 & (itask_cont_from(i),i=1,ntask_cont_from)
860 write (iout,*) "itask_cont_to",
861 & (itask_cont_to(i),i=1,ntask_cont_to)
863 write (iout,*) "iint_sent"
866 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
867 & j=ielstart(ii),ielend(ii))
869 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
870 & " iturn3_end",iturn3_end
871 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
872 & i=iturn3_start,iturn3_end)
873 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
874 & " iturn4_end",iturn4_end
875 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
876 & i=iturn4_start,iturn4_end)
879 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
880 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
881 c write (iout,*) "Gather ntask_cont_from ended"
883 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
884 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
886 c write (iout,*) "Gather itask_cont_from ended"
888 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
889 & 1,MPI_INTEGER,king,FG_COMM,IERR)
890 c write (iout,*) "Gather ntask_cont_to ended"
892 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
893 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
894 c write (iout,*) "Gather itask_cont_to ended"
896 if (fg_rank.eq.king) then
897 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
899 write (iout,'(20i4)') i,ntask_cont_from_all(i),
900 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
904 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
906 write (iout,'(20i4)') i,ntask_cont_to_all(i),
907 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
911 C Check if every send will have a matching receive
915 ncheck_to=ncheck_to+ntask_cont_to_all(i)
916 ncheck_from=ncheck_from+ntask_cont_from_all(i)
918 write (iout,*) "Control sums",ncheck_from,ncheck_to
919 if (ncheck_from.ne.ncheck_to) then
920 write (iout,*) "Error: #receive differs from #send."
921 write (iout,*) "Terminating program...!"
927 do j=1,ntask_cont_to_all(i)
928 ii=itask_cont_to_all(j,i)
929 do k=1,ntask_cont_from_all(ii)
930 if (itask_cont_from_all(k,ii).eq.i) then
931 if(lprint)write(iout,*)"Matching send/receive",i,ii
935 if (k.eq.ntask_cont_from_all(ii)+1) then
937 write (iout,*) "Error: send by",j," to",ii,
938 & " would have no matching receive"
944 write (iout,*) "Unmatched sends; terminating program"
948 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
949 c write (iout,*) "flag broadcast ended flag=",flag
952 call MPI_Finalize(IERROR)
953 stop "Error in INIT_INT_TABLE: unmatched send/receive."
955 call MPI_Comm_group(FG_COMM,fg_group,IERR)
956 c write (iout,*) "MPI_Comm_group ended"
958 call MPI_Group_incl(fg_group,ntask_cont_from+1,
959 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
960 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
961 & CONT_TO_GROUP,IERR)
964 iaux=4*(ielend(ii)-ielstart(ii)+1)
965 call MPI_Group_translate_ranks(fg_group,iaux,
966 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
967 & iint_sent_local(1,ielstart(ii),i),IERR )
968 c write (iout,*) "Ranks translated i=",i
971 iaux=4*(iturn3_end-iturn3_start+1)
972 call MPI_Group_translate_ranks(fg_group,iaux,
973 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
974 & iturn3_sent_local(1,iturn3_start),IERR)
975 iaux=4*(iturn4_end-iturn4_start+1)
976 call MPI_Group_translate_ranks(fg_group,iaux,
977 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
978 & iturn4_sent_local(1,iturn4_start),IERR)
980 write (iout,*) "iint_sent_local"
983 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
984 & j=ielstart(ii),ielend(ii))
987 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
988 & " iturn3_end",iturn3_end
989 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
990 & i=iturn3_start,iturn3_end)
991 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
992 & " iturn4_end",iturn4_end
993 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
994 & i=iturn4_start,iturn4_end)
997 call MPI_Group_free(fg_group,ierr)
998 call MPI_Group_free(cont_from_group,ierr)
999 call MPI_Group_free(cont_to_group,ierr)
1000 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1001 call MPI_Type_commit(MPI_UYZ,IERROR)
1002 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1004 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1005 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1006 call MPI_Type_commit(MPI_MU,IERROR)
1007 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1008 call MPI_Type_commit(MPI_MAT1,IERROR)
1009 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1010 call MPI_Type_commit(MPI_MAT2,IERROR)
1011 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1012 call MPI_Type_commit(MPI_THET,IERROR)
1013 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1014 call MPI_Type_commit(MPI_GAM,IERROR)
1016 c 9/22/08 Derived types to send matrices which appear in correlation terms
1018 if (ivec_count(i).eq.ivec_count(0)) then
1024 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1025 if (ind_typ.eq.0) then
1026 ichunk=ivec_count(0)
1028 ichunk=ivec_count(1)
1035 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1038 c blocklengths(i)=blocklengths(i)*ichunk
1040 c write (iout,*) "blocklengths and displs"
1042 c write (iout,*) i,blocklengths(i),displs(i)
1045 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1046 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1047 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1048 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1054 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1057 c blocklengths(i)=blocklengths(i)*ichunk
1059 c write (iout,*) "blocklengths and displs"
1061 c write (iout,*) i,blocklengths(i),displs(i)
1064 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1065 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1066 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1067 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1073 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1076 blocklengths(i)=blocklengths(i)*ichunk
1078 call MPI_Type_indexed(8,blocklengths,displs,
1079 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1080 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1086 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1089 blocklengths(i)=blocklengths(i)*ichunk
1091 call MPI_Type_indexed(8,blocklengths,displs,
1092 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1093 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1099 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1102 blocklengths(i)=blocklengths(i)*ichunk
1104 call MPI_Type_indexed(6,blocklengths,displs,
1105 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1106 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1112 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1115 blocklengths(i)=blocklengths(i)*ichunk
1117 call MPI_Type_indexed(2,blocklengths,displs,
1118 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1119 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1125 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1128 blocklengths(i)=blocklengths(i)*ichunk
1130 call MPI_Type_indexed(4,blocklengths,displs,
1131 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1132 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1136 iint_start=ivec_start+1
1139 iint_count(i)=ivec_count(i)
1140 iint_displ(i)=ivec_displ(i)
1141 ivec_displ(i)=ivec_displ(i)-1
1142 iset_displ(i)=iset_displ(i)-1
1143 ithet_displ(i)=ithet_displ(i)-1
1144 iphi_displ(i)=iphi_displ(i)-1
1145 iphi1_displ(i)=iphi1_displ(i)-1
1146 ibond_displ(i)=ibond_displ(i)-1
1148 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1149 & .and. (me.eq.0 .or. .not. out1file)) then
1150 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1152 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1155 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1156 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1157 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1159 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1162 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1163 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1164 & ' SC-p interactions','were distributed among',nfgtasks,
1165 & ' fine-grain processors.'
1181 idihconstr_end=ndih_constr
1182 ithetaconstr_start=1
1183 ithetaconstr_end=ntheta_constr
1184 iphid_start=iphi_start
1185 iphid_end=iphi_end-1
1205 c---------------------------------------------------------------------------
1206 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1208 include "DIMENSIONS"
1209 include "COMMON.INTERACT"
1210 include "COMMON.SETUP"
1211 include "COMMON.IOUNITS"
1212 integer ii,jj,itask(4),ntask_cont_to,
1213 &itask_cont_to(0:max_fg_procs-1)
1215 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1216 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1217 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1218 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1219 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1220 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1221 & ielend_all(maxres,0:max_fg_procs-1)
1222 integer iproc,isent,k,l
1223 c Determines whether to send interaction ii,jj to other processors; a given
1224 c interaction can be sent to at most 2 processors.
1225 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1226 c one processor, otherwise flag is unchanged from the input value.
1232 c write (iout,*) "ii",ii," jj",jj
1233 c Loop over processors to check if anybody could need interaction ii,jj
1234 do iproc=0,fg_rank-1
1235 c Check if the interaction matches any turn3 at iproc
1236 do k=iturn3_start_all(iproc),iturn3_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 C Check if the interaction matches any turn4 at iproc
1253 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1255 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1256 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1258 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1261 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1262 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1265 call add_task(iproc,ntask_cont_to,itask_cont_to)
1269 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1270 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1271 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1272 & ielend_all(ii-1,iproc).ge.jj-1) then
1274 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1275 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1278 call add_task(iproc,ntask_cont_to,itask_cont_to)
1281 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1282 & ielend_all(ii-1,iproc).ge.jj+1) then
1284 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1285 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1288 call add_task(iproc,ntask_cont_to,itask_cont_to)
1295 c---------------------------------------------------------------------------
1296 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1298 include "DIMENSIONS"
1299 include "COMMON.INTERACT"
1300 include "COMMON.SETUP"
1301 include "COMMON.IOUNITS"
1302 integer ii,jj,itask(2),ntask_cont_from,
1303 & itask_cont_from(0:max_fg_procs-1)
1305 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1306 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1307 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1308 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1309 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1310 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1311 & ielend_all(maxres,0:max_fg_procs-1)
1313 do iproc=fg_rank+1,nfgtasks-1
1314 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1316 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1317 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1319 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1320 call add_task(iproc,ntask_cont_from,itask_cont_from)
1323 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1325 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1326 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1328 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1329 call add_task(iproc,ntask_cont_from,itask_cont_from)
1332 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1333 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1335 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1336 & jj+1.le.ielend_all(ii+1,iproc)) then
1337 call add_task(iproc,ntask_cont_from,itask_cont_from)
1339 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1340 & jj-1.le.ielend_all(ii+1,iproc)) then
1341 call add_task(iproc,ntask_cont_from,itask_cont_from)
1344 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1346 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1347 & jj-1.le.ielend_all(ii-1,iproc)) then
1348 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1359 c---------------------------------------------------------------------------
1360 subroutine add_task(iproc,ntask_cont,itask_cont)
1362 include "DIMENSIONS"
1363 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1366 if (itask_cont(ii).eq.iproc) return
1368 ntask_cont=ntask_cont+1
1369 itask_cont(ntask_cont)=iproc
1372 c---------------------------------------------------------------------------
1373 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1374 implicit real*8 (a-h,o-z)
1375 include 'DIMENSIONS'
1377 include 'COMMON.SETUP'
1378 integer total_ints,lower_bound,upper_bound
1379 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1380 nint=total_ints/nfgtasks
1384 nexcess=total_ints-nint*nfgtasks
1386 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1390 lower_bound=lower_bound+int4proc(i)
1392 upper_bound=lower_bound+int4proc(fg_rank)
1393 lower_bound=lower_bound+1
1396 c---------------------------------------------------------------------------
1397 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1398 implicit real*8 (a-h,o-z)
1399 include 'DIMENSIONS'
1401 include 'COMMON.SETUP'
1402 integer total_ints,lower_bound,upper_bound
1403 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1404 nint=total_ints/nfgtasks1
1408 nexcess=total_ints-nint*nfgtasks1
1410 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1414 lower_bound=lower_bound+int4proc(i)
1416 upper_bound=lower_bound+int4proc(fg_rank1)
1417 lower_bound=lower_bound+1
1420 c---------------------------------------------------------------------------
1421 subroutine int_partition(int_index,lower_index,upper_index,atom,
1422 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1423 implicit real*8 (a-h,o-z)
1424 include 'DIMENSIONS'
1425 include 'COMMON.IOUNITS'
1426 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1427 & first_atom,last_atom,int_gr,jat_start,jat_end
1430 if (lprn) write (iout,*) 'int_index=',int_index
1431 int_index_old=int_index
1432 int_index=int_index+last_atom-first_atom+1
1434 & write (iout,*) 'int_index=',int_index,
1435 & ' int_index_old',int_index_old,
1436 & ' lower_index=',lower_index,
1437 & ' upper_index=',upper_index,
1438 & ' atom=',atom,' first_atom=',first_atom,
1439 & ' last_atom=',last_atom
1440 if (int_index.ge.lower_index) then
1442 if (at_start.eq.0) then
1444 jat_start=first_atom-1+lower_index-int_index_old
1446 jat_start=first_atom
1448 if (lprn) write (iout,*) 'jat_start',jat_start
1449 if (int_index.ge.upper_index) then
1451 jat_end=first_atom-1+upper_index-int_index_old
1456 if (lprn) write (iout,*) 'jat_end',jat_end
1461 c------------------------------------------------------------------------------
1462 subroutine hpb_partition
1463 implicit real*8 (a-h,o-z)
1464 include 'DIMENSIONS'
1468 include 'COMMON.SBRIDGE'
1469 include 'COMMON.IOUNITS'
1470 include 'COMMON.SETUP'
1472 call int_bounds(nhpb,link_start,link_end)
1473 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1474 & ' absolute rank',MyRank,
1475 & ' nhpb',nhpb,' link_start=',link_start,
1476 & ' link_end',link_end