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
124 C Lipidic input file for parameters range 60-79
126 C input file for transfer sidechain and peptide group inside the
127 C lipidic environment if lipid is implicite
129 C DNA input files for parameters range 80-99
130 C Suger input files for parameters range 100-119
131 C All-atom input files for parameters range 120-149
133 C Set default weights of the energy terms.
144 c print '(a,$)','Inside initialize'
145 c call memmon_print_usage()
180 athet(j,i,ichir1,ichir2)=0.0D0
181 bthet(j,i,ichir1,ichir2)=0.0D0
201 gaussc(l,k,j,i)=0.0D0
211 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
215 v1(k,j,i,iblock)=0.0D0
216 v2(k,j,i,iblock)=0.0D0
226 v1c(1,l,i,j,k,iblock)=0.0D0
227 v1s(1,l,i,j,k,iblock)=0.0D0
228 v1c(2,l,i,j,k,iblock)=0.0D0
229 v1s(2,l,i,j,k,iblock)=0.0D0
233 v2c(m,l,i,j,k,iblock)=0.0D0
234 v2s(m,l,i,j,k,iblock)=0.0D0
246 C Initialize the bridge arrays
260 C Initialize correlation arrays
291 C Initialize variables used in minimization.
300 C Initialize the variables responsible for the mode of gradient storage.
305 C Initialize constants used to split the energy into long- and short-range
311 nprint_ene=nprint_ene-1
315 c-------------------------------------------------------------------------
317 implicit real*8 (a-h,o-z)
319 include 'COMMON.NAMES'
320 include 'COMMON.FFIELD'
322 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
323 & 'DSG','DGN','DSN','DTH',
324 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
325 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
326 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
329 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
330 &'a','y','w','v','l','i','f','m','c','x',
331 &'C','M','F','I','L','V','W','Y','A','G','T',
332 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
333 data potname /'LJ','LJK','BP','GB','GBV'/
335 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
336 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
337 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
338 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
340 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
341 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
342 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
344 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
347 c---------------------------------------------------------------------------
348 subroutine init_int_table
349 implicit real*8 (a-h,o-z)
353 integer blocklengths(15),displs(15)
355 include 'COMMON.CONTROL'
356 include 'COMMON.SETUP'
357 include 'COMMON.CHAIN'
358 include 'COMMON.INTERACT'
359 include 'COMMON.LOCAL'
360 include 'COMMON.SBRIDGE'
361 include 'COMMON.TORCNSTR'
362 include 'COMMON.IOUNITS'
363 include 'COMMON.DERIV'
364 include 'COMMON.CONTACTS'
365 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
366 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
367 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
368 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
369 & ielend_all(maxres,0:max_fg_procs-1),
370 & ntask_cont_from_all(0:max_fg_procs-1),
371 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
372 & ntask_cont_to_all(0:max_fg_procs-1),
373 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
374 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
375 logical scheck,lprint,flag
377 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
378 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
379 C... Determine the numbers of start and end SC-SC interaction
380 C... to deal with by current processor.
382 itask_cont_from(i)=fg_rank
383 itask_cont_to(i)=fg_rank
387 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
388 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
389 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
391 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
392 & ' absolute rank',MyRank,
393 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
394 & ' my_sc_inde',my_sc_inde
414 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
415 cd & (ihpb(i),jhpb(i),i=1,nss)
420 if (ihpb(ii).eq.i+nres) then
427 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
431 c write (iout,*) 'jj=i+1'
432 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
433 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
439 else if (jj.eq.nct) then
441 c write (iout,*) 'jj=nct'
442 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
443 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
451 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
452 & iatsc_s,iatsc_e,i+1,jj-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,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
466 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
467 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
472 ind_scint=ind_scint+nct-i
476 ind_scint_old=ind_scint
484 if (iatsc_s.eq.0) iatsc_s=1
486 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
487 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
490 write (iout,'(a)') 'Interaction array:'
492 write (iout,'(i3,2(2x,2i3))')
493 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
498 C Now partition the electrostatic-interaction array
500 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
501 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
503 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
504 & ' absolute rank',MyRank,
505 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
506 & ' my_ele_inde',my_ele_inde
513 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
514 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
517 if (iatel_s.eq.0) iatel_s=1
518 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
519 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
520 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
521 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
522 c & " my_ele_inde_vdw",my_ele_inde_vdw
529 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
531 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
533 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
534 c & " ielend_vdw",ielend_vdw(i)
536 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
547 do i=iatel_s_vdw,iatel_e_vdw
553 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
554 & ' absolute rank',MyRank
555 write (iout,*) 'Electrostatic interaction array:'
557 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
562 C Partition the SC-p interaction array
564 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
565 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
566 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
567 & ' absolute rank',myrank,
568 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
569 & ' my_scp_inde',my_scp_inde
575 if (i.lt.nnt+iscp) then
576 cd write (iout,*) 'i.le.nnt+iscp'
577 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
578 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
580 else if (i.gt.nct-iscp) then
581 cd write (iout,*) 'i.gt.nct-iscp'
582 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
583 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
586 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
587 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
590 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
591 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
600 if (i.lt.nnt+iscp) then
602 iscpstart(i,1)=i+iscp
604 elseif (i.gt.nct-iscp) then
612 iscpstart(i,2)=i+iscp
617 if (iatscp_s.eq.0) iatscp_s=1
619 write (iout,'(a)') 'SC-p interaction array:'
620 do i=iatscp_s,iatscp_e
621 write (iout,'(i3,2(2x,2i3))')
622 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
625 C Partition local interactions
627 call int_bounds(nres-2,loc_start,loc_end)
628 loc_start=loc_start+1
630 call int_bounds(nres-2,ithet_start,ithet_end)
631 ithet_start=ithet_start+2
632 ithet_end=ithet_end+2
633 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
634 iturn3_start=iturn3_start+nnt
635 iphi_start=iturn3_start+2
636 iturn3_end=iturn3_end+nnt
637 iphi_end=iturn3_end+2
638 iturn3_start=iturn3_start-1
639 iturn3_end=iturn3_end-1
640 call int_bounds(nres-3,itau_start,itau_end)
641 itau_start=itau_start+3
643 call int_bounds(nres-3,iphi1_start,iphi1_end)
644 iphi1_start=iphi1_start+3
645 iphi1_end=iphi1_end+3
646 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
647 iturn4_start=iturn4_start+nnt
648 iphid_start=iturn4_start+2
649 iturn4_end=iturn4_end+nnt
650 iphid_end=iturn4_end+2
651 iturn4_start=iturn4_start-1
652 iturn4_end=iturn4_end-1
653 call int_bounds(nres-2,ibond_start,ibond_end)
654 ibond_start=ibond_start+1
655 ibond_end=ibond_end+1
656 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
657 ibondp_start=ibondp_start+nnt
658 ibondp_end=ibondp_end+nnt
659 call int_bounds(nres,ilip_start,ilip_end)
660 ilip_start=ilip_start
661 call int_bounds1(nres-1,ivec_start,ivec_end)
662 c print *,"Processor",myrank,fg_rank,fg_rank1,
663 c & " ivec_start",ivec_start," ivec_end",ivec_end
664 iset_start=loc_start+2
666 if (ndih_constr.eq.0) then
670 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
672 if (ntheta_constr.eq.0) then
677 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
679 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
681 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
683 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
684 igrad_start=((2*nlen+1)
685 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
686 jgrad_start(igrad_start)=
687 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
689 jgrad_end(igrad_start)=nres
690 igrad_end=((2*nlen+1)
691 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
692 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
693 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
695 do i=igrad_start+1,igrad_end-1
700 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
701 & ' absolute rank',myrank,
702 & ' loc_start',loc_start,' loc_end',loc_end,
703 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
704 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
705 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
706 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
707 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
708 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
709 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
710 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
711 & ' iset_start',iset_start,' iset_end',iset_end,
712 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
714 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
717 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
718 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
719 & ' ngrad_end',ngrad_end
720 do i=igrad_start,igrad_end
721 write(*,*) 'Processor:',fg_rank,myrank,i,
722 & jgrad_start(i),jgrad_end(i)
725 if (nfgtasks.gt.1) then
726 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
727 & MPI_INTEGER,FG_COMM1,IERROR)
728 iaux=ivec_end-ivec_start+1
729 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
730 & MPI_INTEGER,FG_COMM1,IERROR)
731 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
732 & MPI_INTEGER,FG_COMM,IERROR)
733 iaux=iset_end-iset_start+1
734 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
735 & MPI_INTEGER,FG_COMM,IERROR)
736 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
737 & MPI_INTEGER,FG_COMM,IERROR)
738 iaux=ibond_end-ibond_start+1
739 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
740 & MPI_INTEGER,FG_COMM,IERROR)
741 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
742 & MPI_INTEGER,FG_COMM,IERROR)
743 iaux=ithet_end-ithet_start+1
744 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
745 & MPI_INTEGER,FG_COMM,IERROR)
746 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
747 & MPI_INTEGER,FG_COMM,IERROR)
748 iaux=iphi_end-iphi_start+1
749 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
750 & MPI_INTEGER,FG_COMM,IERROR)
751 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
752 & MPI_INTEGER,FG_COMM,IERROR)
753 iaux=iphi1_end-iphi1_start+1
754 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
755 & MPI_INTEGER,FG_COMM,IERROR)
762 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
763 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
764 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
765 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
766 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
767 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
768 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
769 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
770 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
771 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
772 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
773 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
774 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
775 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
776 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
777 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
779 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
780 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
781 write (iout,*) "iturn3_start_all",
782 & (iturn3_start_all(i),i=0,nfgtasks-1)
783 write (iout,*) "iturn3_end_all",
784 & (iturn3_end_all(i),i=0,nfgtasks-1)
785 write (iout,*) "iturn4_start_all",
786 & (iturn4_start_all(i),i=0,nfgtasks-1)
787 write (iout,*) "iturn4_end_all",
788 & (iturn4_end_all(i),i=0,nfgtasks-1)
789 write (iout,*) "The ielstart_all array"
791 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
793 write (iout,*) "The ielend_all array"
795 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
801 itask_cont_from(0)=fg_rank
802 itask_cont_to(0)=fg_rank
804 do ii=iturn3_start,iturn3_end
805 call add_int(ii,ii+2,iturn3_sent(1,ii),
806 & ntask_cont_to,itask_cont_to,flag)
808 do ii=iturn4_start,iturn4_end
809 call add_int(ii,ii+3,iturn4_sent(1,ii),
810 & ntask_cont_to,itask_cont_to,flag)
812 do ii=iturn3_start,iturn3_end
813 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
815 do ii=iturn4_start,iturn4_end
816 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
819 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
820 & " ntask_cont_to",ntask_cont_to
821 write (iout,*) "itask_cont_from",
822 & (itask_cont_from(i),i=1,ntask_cont_from)
823 write (iout,*) "itask_cont_to",
824 & (itask_cont_to(i),i=1,ntask_cont_to)
827 c write (iout,*) "Loop forward"
830 c write (iout,*) "from loop i=",i
832 do j=ielstart(i),ielend(i)
833 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
836 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
837 c & " iatel_e",iatel_e
841 c write (iout,*) "i",i," ielstart",ielstart(i),
842 c & " ielend",ielend(i)
845 do j=ielstart(i),ielend(i)
846 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
847 & itask_cont_to,flag)
855 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
856 & " ntask_cont_to",ntask_cont_to
857 write (iout,*) "itask_cont_from",
858 & (itask_cont_from(i),i=1,ntask_cont_from)
859 write (iout,*) "itask_cont_to",
860 & (itask_cont_to(i),i=1,ntask_cont_to)
862 write (iout,*) "iint_sent"
865 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
866 & j=ielstart(ii),ielend(ii))
868 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
869 & " iturn3_end",iturn3_end
870 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
871 & i=iturn3_start,iturn3_end)
872 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
873 & " iturn4_end",iturn4_end
874 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
875 & i=iturn4_start,iturn4_end)
878 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
879 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
880 c write (iout,*) "Gather ntask_cont_from ended"
882 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
883 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
885 c write (iout,*) "Gather itask_cont_from ended"
887 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
888 & 1,MPI_INTEGER,king,FG_COMM,IERR)
889 c write (iout,*) "Gather ntask_cont_to ended"
891 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
892 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
893 c write (iout,*) "Gather itask_cont_to ended"
895 if (fg_rank.eq.king) then
896 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
898 write (iout,'(20i4)') i,ntask_cont_from_all(i),
899 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
903 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
905 write (iout,'(20i4)') i,ntask_cont_to_all(i),
906 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
910 C Check if every send will have a matching receive
914 ncheck_to=ncheck_to+ntask_cont_to_all(i)
915 ncheck_from=ncheck_from+ntask_cont_from_all(i)
917 write (iout,*) "Control sums",ncheck_from,ncheck_to
918 if (ncheck_from.ne.ncheck_to) then
919 write (iout,*) "Error: #receive differs from #send."
920 write (iout,*) "Terminating program...!"
926 do j=1,ntask_cont_to_all(i)
927 ii=itask_cont_to_all(j,i)
928 do k=1,ntask_cont_from_all(ii)
929 if (itask_cont_from_all(k,ii).eq.i) then
930 if(lprint)write(iout,*)"Matching send/receive",i,ii
934 if (k.eq.ntask_cont_from_all(ii)+1) then
936 write (iout,*) "Error: send by",j," to",ii,
937 & " would have no matching receive"
943 write (iout,*) "Unmatched sends; terminating program"
947 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
948 c write (iout,*) "flag broadcast ended flag=",flag
951 call MPI_Finalize(IERROR)
952 stop "Error in INIT_INT_TABLE: unmatched send/receive."
954 call MPI_Comm_group(FG_COMM,fg_group,IERR)
955 c write (iout,*) "MPI_Comm_group ended"
957 call MPI_Group_incl(fg_group,ntask_cont_from+1,
958 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
959 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
960 & CONT_TO_GROUP,IERR)
963 iaux=4*(ielend(ii)-ielstart(ii)+1)
964 call MPI_Group_translate_ranks(fg_group,iaux,
965 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
966 & iint_sent_local(1,ielstart(ii),i),IERR )
967 c write (iout,*) "Ranks translated i=",i
970 iaux=4*(iturn3_end-iturn3_start+1)
971 call MPI_Group_translate_ranks(fg_group,iaux,
972 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
973 & iturn3_sent_local(1,iturn3_start),IERR)
974 iaux=4*(iturn4_end-iturn4_start+1)
975 call MPI_Group_translate_ranks(fg_group,iaux,
976 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
977 & iturn4_sent_local(1,iturn4_start),IERR)
979 write (iout,*) "iint_sent_local"
982 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
983 & j=ielstart(ii),ielend(ii))
986 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
987 & " iturn3_end",iturn3_end
988 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
989 & i=iturn3_start,iturn3_end)
990 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
991 & " iturn4_end",iturn4_end
992 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
993 & i=iturn4_start,iturn4_end)
996 call MPI_Group_free(fg_group,ierr)
997 call MPI_Group_free(cont_from_group,ierr)
998 call MPI_Group_free(cont_to_group,ierr)
999 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1000 call MPI_Type_commit(MPI_UYZ,IERROR)
1001 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1003 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1004 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1005 call MPI_Type_commit(MPI_MU,IERROR)
1006 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1007 call MPI_Type_commit(MPI_MAT1,IERROR)
1008 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1009 call MPI_Type_commit(MPI_MAT2,IERROR)
1010 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1011 call MPI_Type_commit(MPI_THET,IERROR)
1012 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1013 call MPI_Type_commit(MPI_GAM,IERROR)
1015 c 9/22/08 Derived types to send matrices which appear in correlation terms
1017 if (ivec_count(i).eq.ivec_count(0)) then
1023 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1024 if (ind_typ.eq.0) then
1025 ichunk=ivec_count(0)
1027 ichunk=ivec_count(1)
1034 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1037 c blocklengths(i)=blocklengths(i)*ichunk
1039 c write (iout,*) "blocklengths and displs"
1041 c write (iout,*) i,blocklengths(i),displs(i)
1044 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1045 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1046 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1047 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1053 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1056 c blocklengths(i)=blocklengths(i)*ichunk
1058 c write (iout,*) "blocklengths and displs"
1060 c write (iout,*) i,blocklengths(i),displs(i)
1063 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1064 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1065 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1066 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1072 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1075 blocklengths(i)=blocklengths(i)*ichunk
1077 call MPI_Type_indexed(8,blocklengths,displs,
1078 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1079 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
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_PRECOMP12(ind_typ),IERROR)
1092 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1098 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1101 blocklengths(i)=blocklengths(i)*ichunk
1103 call MPI_Type_indexed(6,blocklengths,displs,
1104 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1105 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1111 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1114 blocklengths(i)=blocklengths(i)*ichunk
1116 call MPI_Type_indexed(2,blocklengths,displs,
1117 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1118 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1124 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1127 blocklengths(i)=blocklengths(i)*ichunk
1129 call MPI_Type_indexed(4,blocklengths,displs,
1130 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1131 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1135 iint_start=ivec_start+1
1138 iint_count(i)=ivec_count(i)
1139 iint_displ(i)=ivec_displ(i)
1140 ivec_displ(i)=ivec_displ(i)-1
1141 iset_displ(i)=iset_displ(i)-1
1142 ithet_displ(i)=ithet_displ(i)-1
1143 iphi_displ(i)=iphi_displ(i)-1
1144 iphi1_displ(i)=iphi1_displ(i)-1
1145 ibond_displ(i)=ibond_displ(i)-1
1147 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1148 & .and. (me.eq.0 .or. .not. out1file)) then
1149 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1151 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1154 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1155 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1156 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1158 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1161 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1162 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1163 & ' SC-p interactions','were distributed among',nfgtasks,
1164 & ' fine-grain processors.'
1180 idihconstr_end=ndih_constr
1181 ithetaconstr_start=1
1182 ithetaconstr_end=ntheta_constr
1183 iphid_start=iphi_start
1184 iphid_end=iphi_end-1
1204 c---------------------------------------------------------------------------
1205 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1207 include "DIMENSIONS"
1208 include "COMMON.INTERACT"
1209 include "COMMON.SETUP"
1210 include "COMMON.IOUNITS"
1211 integer ii,jj,itask(4),ntask_cont_to,
1212 &itask_cont_to(0:max_fg_procs-1)
1214 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1215 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1216 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1217 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1218 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1219 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1220 & ielend_all(maxres,0:max_fg_procs-1)
1221 integer iproc,isent,k,l
1222 c Determines whether to send interaction ii,jj to other processors; a given
1223 c interaction can be sent to at most 2 processors.
1224 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1225 c one processor, otherwise flag is unchanged from the input value.
1231 c write (iout,*) "ii",ii," jj",jj
1232 c Loop over processors to check if anybody could need interaction ii,jj
1233 do iproc=0,fg_rank-1
1234 c Check if the interaction matches any turn3 at iproc
1235 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1237 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1238 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1240 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1243 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1244 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1247 call add_task(iproc,ntask_cont_to,itask_cont_to)
1251 C Check if the interaction matches any turn4 at iproc
1252 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1254 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1255 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1257 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1260 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1261 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1264 call add_task(iproc,ntask_cont_to,itask_cont_to)
1268 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1269 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1270 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1271 & ielend_all(ii-1,iproc).ge.jj-1) then
1273 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1274 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1277 call add_task(iproc,ntask_cont_to,itask_cont_to)
1280 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1281 & ielend_all(ii-1,iproc).ge.jj+1) then
1283 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1284 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1287 call add_task(iproc,ntask_cont_to,itask_cont_to)
1294 c---------------------------------------------------------------------------
1295 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1297 include "DIMENSIONS"
1298 include "COMMON.INTERACT"
1299 include "COMMON.SETUP"
1300 include "COMMON.IOUNITS"
1301 integer ii,jj,itask(2),ntask_cont_from,
1302 & itask_cont_from(0:max_fg_procs-1)
1304 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1305 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1306 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1307 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1308 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1309 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1310 & ielend_all(maxres,0:max_fg_procs-1)
1312 do iproc=fg_rank+1,nfgtasks-1
1313 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1315 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1316 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1318 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1319 call add_task(iproc,ntask_cont_from,itask_cont_from)
1322 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1324 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1325 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1327 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1328 call add_task(iproc,ntask_cont_from,itask_cont_from)
1331 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1332 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1334 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1335 & jj+1.le.ielend_all(ii+1,iproc)) then
1336 call add_task(iproc,ntask_cont_from,itask_cont_from)
1338 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1339 & jj-1.le.ielend_all(ii+1,iproc)) then
1340 call add_task(iproc,ntask_cont_from,itask_cont_from)
1343 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1345 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1346 & jj-1.le.ielend_all(ii-1,iproc)) then
1347 call add_task(iproc,ntask_cont_from,itask_cont_from)
1349 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1350 & jj+1.le.ielend_all(ii-1,iproc)) then
1351 call add_task(iproc,ntask_cont_from,itask_cont_from)
1358 c---------------------------------------------------------------------------
1359 subroutine add_task(iproc,ntask_cont,itask_cont)
1361 include "DIMENSIONS"
1362 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1365 if (itask_cont(ii).eq.iproc) return
1367 ntask_cont=ntask_cont+1
1368 itask_cont(ntask_cont)=iproc
1371 c---------------------------------------------------------------------------
1372 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1373 implicit real*8 (a-h,o-z)
1374 include 'DIMENSIONS'
1376 include 'COMMON.SETUP'
1377 integer total_ints,lower_bound,upper_bound
1378 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1379 nint=total_ints/nfgtasks
1383 nexcess=total_ints-nint*nfgtasks
1385 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1389 lower_bound=lower_bound+int4proc(i)
1391 upper_bound=lower_bound+int4proc(fg_rank)
1392 lower_bound=lower_bound+1
1395 c---------------------------------------------------------------------------
1396 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1397 implicit real*8 (a-h,o-z)
1398 include 'DIMENSIONS'
1400 include 'COMMON.SETUP'
1401 integer total_ints,lower_bound,upper_bound
1402 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1403 nint=total_ints/nfgtasks1
1407 nexcess=total_ints-nint*nfgtasks1
1409 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1413 lower_bound=lower_bound+int4proc(i)
1415 upper_bound=lower_bound+int4proc(fg_rank1)
1416 lower_bound=lower_bound+1
1419 c---------------------------------------------------------------------------
1420 subroutine int_partition(int_index,lower_index,upper_index,atom,
1421 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1422 implicit real*8 (a-h,o-z)
1423 include 'DIMENSIONS'
1424 include 'COMMON.IOUNITS'
1425 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1426 & first_atom,last_atom,int_gr,jat_start,jat_end
1429 if (lprn) write (iout,*) 'int_index=',int_index
1430 int_index_old=int_index
1431 int_index=int_index+last_atom-first_atom+1
1433 & write (iout,*) 'int_index=',int_index,
1434 & ' int_index_old',int_index_old,
1435 & ' lower_index=',lower_index,
1436 & ' upper_index=',upper_index,
1437 & ' atom=',atom,' first_atom=',first_atom,
1438 & ' last_atom=',last_atom
1439 if (int_index.ge.lower_index) then
1441 if (at_start.eq.0) then
1443 jat_start=first_atom-1+lower_index-int_index_old
1445 jat_start=first_atom
1447 if (lprn) write (iout,*) 'jat_start',jat_start
1448 if (int_index.ge.upper_index) then
1450 jat_end=first_atom-1+upper_index-int_index_old
1455 if (lprn) write (iout,*) 'jat_end',jat_end
1460 c------------------------------------------------------------------------------
1461 subroutine hpb_partition
1462 implicit real*8 (a-h,o-z)
1463 include 'DIMENSIONS'
1467 include 'COMMON.SBRIDGE'
1468 include 'COMMON.IOUNITS'
1469 include 'COMMON.SETUP'
1471 call int_bounds(nhpb,link_start,link_end)
1472 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1473 & ' absolute rank',MyRank,
1474 & ' nhpb',nhpb,' link_start=',link_start,
1475 & ' link_end',link_end