2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
122 C Lipidic input file for parameters range 60-79
124 C input file for transfer sidechain and peptide group inside the
125 C lipidic environment if lipid is implicite
127 C DNA input files for parameters range 80-99
128 C Suger input files for parameters range 100-119
129 C All-atom input files for parameters range 120-149
131 C Set default weights of the energy terms.
142 c print '(a,$)','Inside initialize'
143 c call memmon_print_usage()
178 athet(j,i,ichir1,ichir2)=0.0D0
179 bthet(j,i,ichir1,ichir2)=0.0D0
199 gaussc(l,k,j,i)=0.0D0
209 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
213 v1(k,j,i,iblock)=0.0D0
214 v2(k,j,i,iblock)=0.0D0
224 v1c(1,l,i,j,k,iblock)=0.0D0
225 v1s(1,l,i,j,k,iblock)=0.0D0
226 v1c(2,l,i,j,k,iblock)=0.0D0
227 v1s(2,l,i,j,k,iblock)=0.0D0
231 v2c(m,l,i,j,k,iblock)=0.0D0
232 v2s(m,l,i,j,k,iblock)=0.0D0
244 C Initialize the bridge arrays
258 C Initialize correlation arrays
289 C Initialize variables used in minimization.
298 C Initialize the variables responsible for the mode of gradient storage.
303 C Initialize constants used to split the energy into long- and short-range
309 nprint_ene=nprint_ene-1
313 c-------------------------------------------------------------------------
315 implicit real*8 (a-h,o-z)
317 include 'COMMON.NAMES'
318 include 'COMMON.FFIELD'
320 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
321 & 'DSG','DGN','DSN','DTH',
322 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
323 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
324 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
327 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
328 &'a','y','w','v','l','i','f','m','c','x',
329 &'C','M','F','I','L','V','W','Y','A','G','T',
330 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
331 data potname /'LJ','LJK','BP','GB','GBV'/
333 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
334 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
335 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
336 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR",
337 & "Eliptran","Eafmforce","Ehomology"/
339 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
340 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
341 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
342 & "Wliptran"," ","EHOMO"/
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
485 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
486 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
489 write (iout,'(a)') 'Interaction array:'
491 write (iout,'(i3,2(2x,2i3))')
492 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
497 C Now partition the electrostatic-interaction array
499 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
500 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
502 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
503 & ' absolute rank',MyRank,
504 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
505 & ' my_ele_inde',my_ele_inde
512 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
513 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
516 if (iatel_s.eq.0) iatel_s=1
517 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
518 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
519 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
520 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
521 c & " my_ele_inde_vdw",my_ele_inde_vdw
528 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
530 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
532 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
533 c & " ielend_vdw",ielend_vdw(i)
535 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
546 do i=iatel_s_vdw,iatel_e_vdw
552 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
553 & ' absolute rank',MyRank
554 write (iout,*) 'Electrostatic interaction array:'
556 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
561 C Partition the SC-p interaction array
563 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
564 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
565 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
566 & ' absolute rank',myrank,
567 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
568 & ' my_scp_inde',my_scp_inde
574 if (i.lt.nnt+iscp) then
575 cd write (iout,*) 'i.le.nnt+iscp'
576 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
577 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
579 else if (i.gt.nct-iscp) then
580 cd write (iout,*) 'i.gt.nct-iscp'
581 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
582 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
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,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
599 if (i.lt.nnt+iscp) then
601 iscpstart(i,1)=i+iscp
603 elseif (i.gt.nct-iscp) then
611 iscpstart(i,2)=i+iscp
617 write (iout,'(a)') 'SC-p interaction array:'
618 do i=iatscp_s,iatscp_e
619 write (iout,'(i3,2(2x,2i3))')
620 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
623 C Partition local interactions
625 call int_bounds(nres-2,loc_start,loc_end)
626 loc_start=loc_start+1
628 call int_bounds(nres-2,ithet_start,ithet_end)
629 ithet_start=ithet_start+2
630 ithet_end=ithet_end+2
631 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
632 iturn3_start=iturn3_start+nnt
633 iphi_start=iturn3_start+2
634 iturn3_end=iturn3_end+nnt
635 iphi_end=iturn3_end+2
636 iturn3_start=iturn3_start-1
637 iturn3_end=iturn3_end-1
638 call int_bounds(nres-3,itau_start,itau_end)
639 itau_start=itau_start+3
641 call int_bounds(nres-3,iphi1_start,iphi1_end)
642 iphi1_start=iphi1_start+3
643 iphi1_end=iphi1_end+3
644 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
645 iturn4_start=iturn4_start+nnt
646 iphid_start=iturn4_start+2
647 iturn4_end=iturn4_end+nnt
648 iphid_end=iturn4_end+2
649 iturn4_start=iturn4_start-1
650 iturn4_end=iturn4_end-1
651 call int_bounds(nres-2,ibond_start,ibond_end)
652 ibond_start=ibond_start+1
653 ibond_end=ibond_end+1
654 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
655 ibondp_start=ibondp_start+nnt
656 ibondp_end=ibondp_end+nnt
657 call int_bounds(nres,ilip_start,ilip_end)
658 ilip_start=ilip_start
659 call int_bounds1(nres-1,ivec_start,ivec_end)
660 c print *,"Processor",myrank,fg_rank,fg_rank1,
661 c & " ivec_start",ivec_start," ivec_end",ivec_end
662 iset_start=loc_start+2
664 if (ndih_constr.eq.0) then
668 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
670 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
672 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
674 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
675 igrad_start=((2*nlen+1)
676 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
677 jgrad_start(igrad_start)=
678 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
680 jgrad_end(igrad_start)=nres
681 igrad_end=((2*nlen+1)
682 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
683 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
684 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
686 do i=igrad_start+1,igrad_end-1
691 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
692 & ' absolute rank',myrank,
693 & ' loc_start',loc_start,' loc_end',loc_end,
694 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
695 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
696 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
697 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
698 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
699 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
700 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
701 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
702 & ' iset_start',iset_start,' iset_end',iset_end,
703 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
705 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
706 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
707 & ' ngrad_end',ngrad_end
708 do i=igrad_start,igrad_end
709 write(*,*) 'Processor:',fg_rank,myrank,i,
710 & jgrad_start(i),jgrad_end(i)
713 if (nfgtasks.gt.1) then
714 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
715 & MPI_INTEGER,FG_COMM1,IERROR)
716 iaux=ivec_end-ivec_start+1
717 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
718 & MPI_INTEGER,FG_COMM1,IERROR)
719 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
720 & MPI_INTEGER,FG_COMM,IERROR)
721 iaux=iset_end-iset_start+1
722 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
723 & MPI_INTEGER,FG_COMM,IERROR)
724 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
725 & MPI_INTEGER,FG_COMM,IERROR)
726 iaux=ibond_end-ibond_start+1
727 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
728 & MPI_INTEGER,FG_COMM,IERROR)
729 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
730 & MPI_INTEGER,FG_COMM,IERROR)
731 iaux=ithet_end-ithet_start+1
732 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
733 & MPI_INTEGER,FG_COMM,IERROR)
734 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
735 & MPI_INTEGER,FG_COMM,IERROR)
736 iaux=iphi_end-iphi_start+1
737 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
738 & MPI_INTEGER,FG_COMM,IERROR)
739 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
740 & MPI_INTEGER,FG_COMM,IERROR)
741 iaux=iphi1_end-iphi1_start+1
742 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
743 & MPI_INTEGER,FG_COMM,IERROR)
750 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
751 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
752 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
753 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
754 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
755 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
756 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
757 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
758 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
759 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
760 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
761 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
762 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
763 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
764 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
765 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
767 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
768 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
769 write (iout,*) "iturn3_start_all",
770 & (iturn3_start_all(i),i=0,nfgtasks-1)
771 write (iout,*) "iturn3_end_all",
772 & (iturn3_end_all(i),i=0,nfgtasks-1)
773 write (iout,*) "iturn4_start_all",
774 & (iturn4_start_all(i),i=0,nfgtasks-1)
775 write (iout,*) "iturn4_end_all",
776 & (iturn4_end_all(i),i=0,nfgtasks-1)
777 write (iout,*) "The ielstart_all array"
779 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
781 write (iout,*) "The ielend_all array"
783 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
789 itask_cont_from(0)=fg_rank
790 itask_cont_to(0)=fg_rank
792 do ii=iturn3_start,iturn3_end
793 call add_int(ii,ii+2,iturn3_sent(1,ii),
794 & ntask_cont_to,itask_cont_to,flag)
796 do ii=iturn4_start,iturn4_end
797 call add_int(ii,ii+3,iturn4_sent(1,ii),
798 & ntask_cont_to,itask_cont_to,flag)
800 do ii=iturn3_start,iturn3_end
801 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
803 do ii=iturn4_start,iturn4_end
804 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
807 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
808 & " ntask_cont_to",ntask_cont_to
809 write (iout,*) "itask_cont_from",
810 & (itask_cont_from(i),i=1,ntask_cont_from)
811 write (iout,*) "itask_cont_to",
812 & (itask_cont_to(i),i=1,ntask_cont_to)
815 c write (iout,*) "Loop forward"
818 c write (iout,*) "from loop i=",i
820 do j=ielstart(i),ielend(i)
821 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
824 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
825 c & " iatel_e",iatel_e
829 c write (iout,*) "i",i," ielstart",ielstart(i),
830 c & " ielend",ielend(i)
833 do j=ielstart(i),ielend(i)
834 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
835 & itask_cont_to,flag)
843 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
844 & " ntask_cont_to",ntask_cont_to
845 write (iout,*) "itask_cont_from",
846 & (itask_cont_from(i),i=1,ntask_cont_from)
847 write (iout,*) "itask_cont_to",
848 & (itask_cont_to(i),i=1,ntask_cont_to)
850 write (iout,*) "iint_sent"
853 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
854 & j=ielstart(ii),ielend(ii))
856 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
857 & " iturn3_end",iturn3_end
858 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
859 & i=iturn3_start,iturn3_end)
860 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
861 & " iturn4_end",iturn4_end
862 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
863 & i=iturn4_start,iturn4_end)
866 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
867 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
868 c write (iout,*) "Gather ntask_cont_from ended"
870 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
871 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
873 c write (iout,*) "Gather itask_cont_from ended"
875 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
876 & 1,MPI_INTEGER,king,FG_COMM,IERR)
877 c write (iout,*) "Gather ntask_cont_to ended"
879 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
880 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
881 c write (iout,*) "Gather itask_cont_to ended"
883 if (fg_rank.eq.king) then
884 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
886 write (iout,'(20i4)') i,ntask_cont_from_all(i),
887 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
891 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
893 write (iout,'(20i4)') i,ntask_cont_to_all(i),
894 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
898 C Check if every send will have a matching receive
902 ncheck_to=ncheck_to+ntask_cont_to_all(i)
903 ncheck_from=ncheck_from+ntask_cont_from_all(i)
905 write (iout,*) "Control sums",ncheck_from,ncheck_to
906 if (ncheck_from.ne.ncheck_to) then
907 write (iout,*) "Error: #receive differs from #send."
908 write (iout,*) "Terminating program...!"
914 do j=1,ntask_cont_to_all(i)
915 ii=itask_cont_to_all(j,i)
916 do k=1,ntask_cont_from_all(ii)
917 if (itask_cont_from_all(k,ii).eq.i) then
918 if(lprint)write(iout,*)"Matching send/receive",i,ii
922 if (k.eq.ntask_cont_from_all(ii)+1) then
924 write (iout,*) "Error: send by",j," to",ii,
925 & " would have no matching receive"
931 write (iout,*) "Unmatched sends; terminating program"
935 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
936 c write (iout,*) "flag broadcast ended flag=",flag
939 call MPI_Finalize(IERROR)
940 stop "Error in INIT_INT_TABLE: unmatched send/receive."
942 call MPI_Comm_group(FG_COMM,fg_group,IERR)
943 c write (iout,*) "MPI_Comm_group ended"
945 call MPI_Group_incl(fg_group,ntask_cont_from+1,
946 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
947 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
948 & CONT_TO_GROUP,IERR)
951 iaux=4*(ielend(ii)-ielstart(ii)+1)
952 call MPI_Group_translate_ranks(fg_group,iaux,
953 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
954 & iint_sent_local(1,ielstart(ii),i),IERR )
955 c write (iout,*) "Ranks translated i=",i
958 iaux=4*(iturn3_end-iturn3_start+1)
959 call MPI_Group_translate_ranks(fg_group,iaux,
960 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
961 & iturn3_sent_local(1,iturn3_start),IERR)
962 iaux=4*(iturn4_end-iturn4_start+1)
963 call MPI_Group_translate_ranks(fg_group,iaux,
964 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
965 & iturn4_sent_local(1,iturn4_start),IERR)
967 write (iout,*) "iint_sent_local"
970 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
971 & j=ielstart(ii),ielend(ii))
974 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
975 & " iturn3_end",iturn3_end
976 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
977 & i=iturn3_start,iturn3_end)
978 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
979 & " iturn4_end",iturn4_end
980 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
981 & i=iturn4_start,iturn4_end)
984 call MPI_Group_free(fg_group,ierr)
985 call MPI_Group_free(cont_from_group,ierr)
986 call MPI_Group_free(cont_to_group,ierr)
987 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
988 call MPI_Type_commit(MPI_UYZ,IERROR)
989 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
991 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
992 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
993 call MPI_Type_commit(MPI_MU,IERROR)
994 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
995 call MPI_Type_commit(MPI_MAT1,IERROR)
996 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
997 call MPI_Type_commit(MPI_MAT2,IERROR)
998 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
999 call MPI_Type_commit(MPI_THET,IERROR)
1000 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1001 call MPI_Type_commit(MPI_GAM,IERROR)
1003 c 9/22/08 Derived types to send matrices which appear in correlation terms
1005 if (ivec_count(i).eq.ivec_count(0)) then
1011 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1012 if (ind_typ.eq.0) then
1013 ichunk=ivec_count(0)
1015 ichunk=ivec_count(1)
1022 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1025 c blocklengths(i)=blocklengths(i)*ichunk
1027 c write (iout,*) "blocklengths and displs"
1029 c write (iout,*) i,blocklengths(i),displs(i)
1032 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1033 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1034 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1035 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1041 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1044 c blocklengths(i)=blocklengths(i)*ichunk
1046 c write (iout,*) "blocklengths and displs"
1048 c write (iout,*) i,blocklengths(i),displs(i)
1051 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1052 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1053 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1054 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1060 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1063 blocklengths(i)=blocklengths(i)*ichunk
1065 call MPI_Type_indexed(8,blocklengths,displs,
1066 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1067 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
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_PRECOMP12(ind_typ),IERROR)
1080 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1086 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1089 blocklengths(i)=blocklengths(i)*ichunk
1091 call MPI_Type_indexed(6,blocklengths,displs,
1092 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1093 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1099 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1102 blocklengths(i)=blocklengths(i)*ichunk
1104 call MPI_Type_indexed(2,blocklengths,displs,
1105 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1106 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1112 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1115 blocklengths(i)=blocklengths(i)*ichunk
1117 call MPI_Type_indexed(4,blocklengths,displs,
1118 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1119 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1123 iint_start=ivec_start+1
1126 iint_count(i)=ivec_count(i)
1127 iint_displ(i)=ivec_displ(i)
1128 ivec_displ(i)=ivec_displ(i)-1
1129 iset_displ(i)=iset_displ(i)-1
1130 ithet_displ(i)=ithet_displ(i)-1
1131 iphi_displ(i)=iphi_displ(i)-1
1132 iphi1_displ(i)=iphi1_displ(i)-1
1133 ibond_displ(i)=ibond_displ(i)-1
1135 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1136 & .and. (me.eq.0 .or. .not. out1file)) then
1137 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1139 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1142 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1143 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1144 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1146 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1149 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1150 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1151 & ' SC-p interactions','were distributed among',nfgtasks,
1152 & ' fine-grain processors.'
1168 idihconstr_end=ndih_constr
1169 iphid_start=iphi_start
1170 iphid_end=iphi_end-1
1190 c---------------------------------------------------------------------------
1191 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1193 include "DIMENSIONS"
1194 include "COMMON.INTERACT"
1195 include "COMMON.SETUP"
1196 include "COMMON.IOUNITS"
1197 integer ii,jj,itask(4),ntask_cont_to,
1198 &itask_cont_to(0:max_fg_procs-1)
1200 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1201 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1202 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1203 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1204 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1205 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1206 & ielend_all(maxres,0:max_fg_procs-1)
1207 integer iproc,isent,k,l
1208 c Determines whether to send interaction ii,jj to other processors; a given
1209 c interaction can be sent to at most 2 processors.
1210 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1211 c one processor, otherwise flag is unchanged from the input value.
1217 c write (iout,*) "ii",ii," jj",jj
1218 c Loop over processors to check if anybody could need interaction ii,jj
1219 do iproc=0,fg_rank-1
1220 c Check if the interaction matches any turn3 at iproc
1221 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1223 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1224 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1226 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1229 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1230 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1233 call add_task(iproc,ntask_cont_to,itask_cont_to)
1237 C Check if the interaction matches any turn4 at iproc
1238 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1240 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1241 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1243 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1246 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1247 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1250 call add_task(iproc,ntask_cont_to,itask_cont_to)
1254 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1255 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1256 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1257 & ielend_all(ii-1,iproc).ge.jj-1) then
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)
1266 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1267 & ielend_all(ii-1,iproc).ge.jj+1) then
1269 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1270 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1273 call add_task(iproc,ntask_cont_to,itask_cont_to)
1280 c---------------------------------------------------------------------------
1281 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1283 include "DIMENSIONS"
1284 include "COMMON.INTERACT"
1285 include "COMMON.SETUP"
1286 include "COMMON.IOUNITS"
1287 integer ii,jj,itask(2),ntask_cont_from,
1288 & itask_cont_from(0:max_fg_procs-1)
1290 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1291 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1292 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1293 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1294 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1295 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1296 & ielend_all(maxres,0:max_fg_procs-1)
1298 do iproc=fg_rank+1,nfgtasks-1
1299 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1301 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1302 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1304 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1305 call add_task(iproc,ntask_cont_from,itask_cont_from)
1308 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1310 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1311 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1313 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1314 call add_task(iproc,ntask_cont_from,itask_cont_from)
1317 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1318 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1320 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1321 & jj+1.le.ielend_all(ii+1,iproc)) then
1322 call add_task(iproc,ntask_cont_from,itask_cont_from)
1324 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1325 & jj-1.le.ielend_all(ii+1,iproc)) then
1326 call add_task(iproc,ntask_cont_from,itask_cont_from)
1329 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1331 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1332 & jj-1.le.ielend_all(ii-1,iproc)) then
1333 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1344 c---------------------------------------------------------------------------
1345 subroutine add_task(iproc,ntask_cont,itask_cont)
1347 include "DIMENSIONS"
1348 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1351 if (itask_cont(ii).eq.iproc) return
1353 ntask_cont=ntask_cont+1
1354 itask_cont(ntask_cont)=iproc
1357 c---------------------------------------------------------------------------
1358 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1359 implicit real*8 (a-h,o-z)
1360 include 'DIMENSIONS'
1362 include 'COMMON.SETUP'
1363 integer total_ints,lower_bound,upper_bound
1364 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1365 nint=total_ints/nfgtasks
1369 nexcess=total_ints-nint*nfgtasks
1371 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1375 lower_bound=lower_bound+int4proc(i)
1377 upper_bound=lower_bound+int4proc(fg_rank)
1378 lower_bound=lower_bound+1
1381 c---------------------------------------------------------------------------
1382 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1383 implicit real*8 (a-h,o-z)
1384 include 'DIMENSIONS'
1386 include 'COMMON.SETUP'
1387 integer total_ints,lower_bound,upper_bound
1388 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1389 nint=total_ints/nfgtasks1
1393 nexcess=total_ints-nint*nfgtasks1
1395 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1399 lower_bound=lower_bound+int4proc(i)
1401 upper_bound=lower_bound+int4proc(fg_rank1)
1402 lower_bound=lower_bound+1
1405 c---------------------------------------------------------------------------
1406 subroutine int_partition(int_index,lower_index,upper_index,atom,
1407 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1408 implicit real*8 (a-h,o-z)
1409 include 'DIMENSIONS'
1410 include 'COMMON.IOUNITS'
1411 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1412 & first_atom,last_atom,int_gr,jat_start,jat_end
1415 if (lprn) write (iout,*) 'int_index=',int_index
1416 int_index_old=int_index
1417 int_index=int_index+last_atom-first_atom+1
1419 & write (iout,*) 'int_index=',int_index,
1420 & ' int_index_old',int_index_old,
1421 & ' lower_index=',lower_index,
1422 & ' upper_index=',upper_index,
1423 & ' atom=',atom,' first_atom=',first_atom,
1424 & ' last_atom=',last_atom
1425 if (int_index.ge.lower_index) then
1427 if (at_start.eq.0) then
1429 jat_start=first_atom-1+lower_index-int_index_old
1431 jat_start=first_atom
1433 if (lprn) write (iout,*) 'jat_start',jat_start
1434 if (int_index.ge.upper_index) then
1436 jat_end=first_atom-1+upper_index-int_index_old
1441 if (lprn) write (iout,*) 'jat_end',jat_end
1446 c------------------------------------------------------------------------------
1447 subroutine hpb_partition
1448 implicit real*8 (a-h,o-z)
1449 include 'DIMENSIONS'
1453 include 'COMMON.SBRIDGE'
1454 include 'COMMON.IOUNITS'
1455 include 'COMMON.SETUP'
1456 include 'COMMON.CONTROL'
1457 c write(2,*)"hpb_partition: nhpb=",nhpb
1459 call int_bounds(nhpb,link_start,link_end)
1461 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1462 & ' absolute rank',MyRank,
1463 & ' nhpb',nhpb,' link_start=',link_start,
1464 & ' link_end',link_end
1469 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end
1472 c------------------------------------------------------------------------------
1473 subroutine homology_partition
1474 implicit real*8 (a-h,o-z)
1475 include 'DIMENSIONS'
1479 include 'COMMON.SBRIDGE'
1480 include 'COMMON.IOUNITS'
1481 include 'COMMON.SETUP'
1482 include 'COMMON.CONTROL'
1484 include 'COMMON.INTERACT'
1485 cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
1486 cd & " lim_dih",lim_dih
1488 if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1489 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1490 call int_bounds(lim_dih-nnt+1,idihconstr_start_homo,
1491 & idihconstr_end_homo)
1492 idihconstr_start_homo=idihconstr_start_homo+nnt-1
1493 idihconstr_end_homo=idihconstr_end_homo+nnt-1
1494 if (me.eq.king .or. .not. out1file)
1495 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1496 & ' absolute rank',MyRank,
1497 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1498 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1499 & ' idihconstr_start_homo',idihconstr_start_homo,
1500 & ' idihconstr_end_homo',idihconstr_end_homo
1502 write (iout,*) "Not MPI"
1504 link_end_homo=lim_odl
1505 idihconstr_start_homo=nnt
1506 idihconstr_end_homo=lim_dih
1508 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1509 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1510 & ' idihconstr_start_homo',idihconstr_start_homo,
1511 & ' idihconstr_end_homo',idihconstr_end_homo