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 Set default weights of the energy terms.
134 c print '(a,$)','Inside initialize'
135 c call memmon_print_usage()
168 athet(j,i,ichir1,ichir2)=0.0D0
169 bthet(j,i,ichir1,ichir2)=0.0D0
189 gaussc(l,k,j,i)=0.0D0
199 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
203 v1(k,j,i,iblock)=0.0D0
204 v2(k,j,i,iblock)=0.0D0
214 v1c(1,l,i,j,k,iblock)=0.0D0
215 v1s(1,l,i,j,k,iblock)=0.0D0
216 v1c(2,l,i,j,k,iblock)=0.0D0
217 v1s(2,l,i,j,k,iblock)=0.0D0
221 v2c(m,l,i,j,k,iblock)=0.0D0
222 v2s(m,l,i,j,k,iblock)=0.0D0
234 C Initialize the bridge arrays
253 C Initialize variables used in minimization.
262 C Initialize the variables responsible for the mode of gradient storage.
267 C Initialize constants used to split the energy into long- and short-range
273 nprint_ene=nprint_ene-1
277 c-------------------------------------------------------------------------
279 implicit real*8 (a-h,o-z)
281 include 'COMMON.NAMES'
282 include 'COMMON.FFIELD'
284 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
285 & 'DSG','DGN','DSN','DTH',
286 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
287 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
288 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
291 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
292 &'a','y','w','v','l','i','f','m','c','x',
293 &'C','M','F','I','L','V','W','Y','A','G','T',
294 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
295 data potname /'LJ','LJK','BP','GB','GBV'/
297 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
298 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
299 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
300 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
302 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
303 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
304 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
306 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
309 c---------------------------------------------------------------------------
310 subroutine init_int_table
311 implicit real*8 (a-h,o-z)
315 integer blocklengths(15),displs(15)
317 include 'COMMON.CONTROL'
318 include 'COMMON.SETUP'
319 include 'COMMON.CHAIN'
320 include 'COMMON.INTERACT'
321 include 'COMMON.LOCAL'
322 include 'COMMON.SBRIDGE'
323 include 'COMMON.TORCNSTR'
324 include 'COMMON.IOUNITS'
325 include 'COMMON.DERIV'
326 include 'COMMON.CONTACTS'
327 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
328 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
329 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
330 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
331 & ielend_all(maxres,0:max_fg_procs-1),
332 & ntask_cont_from_all(0:max_fg_procs-1),
333 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
334 & ntask_cont_to_all(0:max_fg_procs-1),
335 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
336 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
337 logical scheck,lprint,flag
339 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
340 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
341 C... Determine the numbers of start and end SC-SC interaction
342 C... to deal with by current processor.
344 itask_cont_from(i)=fg_rank
345 itask_cont_to(i)=fg_rank
349 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
350 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
351 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
353 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
354 & ' absolute rank',MyRank,
355 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
356 & ' my_sc_inde',my_sc_inde
376 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
377 cd & (ihpb(i),jhpb(i),i=1,nss)
382 if (ihpb(ii).eq.i+nres) then
389 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
393 c write (iout,*) 'jj=i+1'
394 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
395 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
401 else if (jj.eq.nct) then
403 c write (iout,*) 'jj=nct'
404 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
405 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
413 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
414 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
416 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
417 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
428 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
429 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
434 ind_scint=ind_scint+nct-i
438 ind_scint_old=ind_scint
446 if (iatsc_s.eq.0) iatsc_s=1
448 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
449 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
452 write (iout,'(a)') 'Interaction array:'
454 write (iout,'(i3,2(2x,2i3))')
455 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
460 C Now partition the electrostatic-interaction array
462 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
463 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
465 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
466 & ' absolute rank',MyRank,
467 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
468 & ' my_ele_inde',my_ele_inde
475 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
476 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
479 if (iatel_s.eq.0) iatel_s=1
480 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
481 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
482 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
483 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
484 c & " my_ele_inde_vdw",my_ele_inde_vdw
491 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
493 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
495 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
496 c & " ielend_vdw",ielend_vdw(i)
498 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
509 do i=iatel_s_vdw,iatel_e_vdw
515 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
516 & ' absolute rank',MyRank
517 write (iout,*) 'Electrostatic interaction array:'
519 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
524 C Partition the SC-p interaction array
526 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
527 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
528 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
529 & ' absolute rank',myrank,
530 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
531 & ' my_scp_inde',my_scp_inde
537 if (i.lt.nnt+iscp) then
538 cd write (iout,*) 'i.le.nnt+iscp'
539 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
540 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
542 else if (i.gt.nct-iscp) then
543 cd write (iout,*) 'i.gt.nct-iscp'
544 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
545 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
548 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
549 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
552 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
553 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
562 if (i.lt.nnt+iscp) then
564 iscpstart(i,1)=i+iscp
566 elseif (i.gt.nct-iscp) then
574 iscpstart(i,2)=i+iscp
579 if (iatscp_s.eq.0) iatscp_s=1
581 write (iout,'(a)') 'SC-p interaction array:'
582 do i=iatscp_s,iatscp_e
583 write (iout,'(i3,2(2x,2i3))')
584 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
587 C Partition local interactions
589 call int_bounds(nres-2,loc_start,loc_end)
590 loc_start=loc_start+1
592 call int_bounds(nres-2,ithet_start,ithet_end)
593 ithet_start=ithet_start+2
594 ithet_end=ithet_end+2
595 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
596 iturn3_start=iturn3_start+nnt
597 iphi_start=iturn3_start+2
598 iturn3_end=iturn3_end+nnt
599 iphi_end=iturn3_end+2
600 iturn3_start=iturn3_start-1
601 iturn3_end=iturn3_end-1
602 call int_bounds(nres-3,itau_start,itau_end)
603 itau_start=itau_start+3
605 call int_bounds(nres-3,iphi1_start,iphi1_end)
606 iphi1_start=iphi1_start+3
607 iphi1_end=iphi1_end+3
608 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
609 iturn4_start=iturn4_start+nnt
610 iphid_start=iturn4_start+2
611 iturn4_end=iturn4_end+nnt
612 iphid_end=iturn4_end+2
613 iturn4_start=iturn4_start-1
614 iturn4_end=iturn4_end-1
615 call int_bounds(nres-2,ibond_start,ibond_end)
616 ibond_start=ibond_start+1
617 ibond_end=ibond_end+1
618 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
619 ibondp_start=ibondp_start+nnt
620 ibondp_end=ibondp_end+nnt
621 call int_bounds1(nres-1,ivec_start,ivec_end)
622 c print *,"Processor",myrank,fg_rank,fg_rank1,
623 c & " ivec_start",ivec_start," ivec_end",ivec_end
624 iset_start=loc_start+2
626 if (ndih_constr.eq.0) then
630 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
632 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
634 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
636 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
637 igrad_start=((2*nlen+1)
638 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
639 jgrad_start(igrad_start)=
640 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
642 jgrad_end(igrad_start)=nres
643 igrad_end=((2*nlen+1)
644 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
645 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
646 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
648 do i=igrad_start+1,igrad_end-1
653 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
654 & ' absolute rank',myrank,
655 & ' loc_start',loc_start,' loc_end',loc_end,
656 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
657 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
658 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
659 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
660 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
661 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
662 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
663 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
664 & ' iset_start',iset_start,' iset_end',iset_end,
665 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
667 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
668 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
669 & ' ngrad_end',ngrad_end
670 do i=igrad_start,igrad_end
671 write(*,*) 'Processor:',fg_rank,myrank,i,
672 & jgrad_start(i),jgrad_end(i)
675 if (nfgtasks.gt.1) then
676 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
677 & MPI_INTEGER,FG_COMM1,IERROR)
678 iaux=ivec_end-ivec_start+1
679 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
680 & MPI_INTEGER,FG_COMM1,IERROR)
681 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 iaux=iset_end-iset_start+1
684 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
685 & MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
688 iaux=ibond_end-ibond_start+1
689 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
690 & MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 iaux=ithet_end-ithet_start+1
694 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
696 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
697 & MPI_INTEGER,FG_COMM,IERROR)
698 iaux=iphi_end-iphi_start+1
699 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
700 & MPI_INTEGER,FG_COMM,IERROR)
701 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
702 & MPI_INTEGER,FG_COMM,IERROR)
703 iaux=iphi1_end-iphi1_start+1
704 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
705 & MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
713 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
714 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
715 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
716 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
717 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
718 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
719 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
720 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
721 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
722 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
723 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
724 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
725 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
726 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
727 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
729 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
730 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
731 write (iout,*) "iturn3_start_all",
732 & (iturn3_start_all(i),i=0,nfgtasks-1)
733 write (iout,*) "iturn3_end_all",
734 & (iturn3_end_all(i),i=0,nfgtasks-1)
735 write (iout,*) "iturn4_start_all",
736 & (iturn4_start_all(i),i=0,nfgtasks-1)
737 write (iout,*) "iturn4_end_all",
738 & (iturn4_end_all(i),i=0,nfgtasks-1)
739 write (iout,*) "The ielstart_all array"
741 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
743 write (iout,*) "The ielend_all array"
745 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
751 itask_cont_from(0)=fg_rank
752 itask_cont_to(0)=fg_rank
754 do ii=iturn3_start,iturn3_end
755 call add_int(ii,ii+2,iturn3_sent(1,ii),
756 & ntask_cont_to,itask_cont_to,flag)
758 do ii=iturn4_start,iturn4_end
759 call add_int(ii,ii+3,iturn4_sent(1,ii),
760 & ntask_cont_to,itask_cont_to,flag)
762 do ii=iturn3_start,iturn3_end
763 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
765 do ii=iturn4_start,iturn4_end
766 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
769 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
770 & " ntask_cont_to",ntask_cont_to
771 write (iout,*) "itask_cont_from",
772 & (itask_cont_from(i),i=1,ntask_cont_from)
773 write (iout,*) "itask_cont_to",
774 & (itask_cont_to(i),i=1,ntask_cont_to)
777 c write (iout,*) "Loop forward"
780 c write (iout,*) "from loop i=",i
782 do j=ielstart(i),ielend(i)
783 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
786 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
787 c & " iatel_e",iatel_e
791 c write (iout,*) "i",i," ielstart",ielstart(i),
792 c & " ielend",ielend(i)
795 do j=ielstart(i),ielend(i)
796 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
797 & itask_cont_to,flag)
805 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
806 & " ntask_cont_to",ntask_cont_to
807 write (iout,*) "itask_cont_from",
808 & (itask_cont_from(i),i=1,ntask_cont_from)
809 write (iout,*) "itask_cont_to",
810 & (itask_cont_to(i),i=1,ntask_cont_to)
812 write (iout,*) "iint_sent"
815 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
816 & j=ielstart(ii),ielend(ii))
818 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
819 & " iturn3_end",iturn3_end
820 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
821 & i=iturn3_start,iturn3_end)
822 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
823 & " iturn4_end",iturn4_end
824 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
825 & i=iturn4_start,iturn4_end)
828 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
829 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
830 c write (iout,*) "Gather ntask_cont_from ended"
832 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
833 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
835 c write (iout,*) "Gather itask_cont_from ended"
837 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
838 & 1,MPI_INTEGER,king,FG_COMM,IERR)
839 c write (iout,*) "Gather ntask_cont_to ended"
841 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
842 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
843 c write (iout,*) "Gather itask_cont_to ended"
845 if (fg_rank.eq.king) then
846 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
848 write (iout,'(20i4)') i,ntask_cont_from_all(i),
849 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
853 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
855 write (iout,'(20i4)') i,ntask_cont_to_all(i),
856 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
860 C Check if every send will have a matching receive
864 ncheck_to=ncheck_to+ntask_cont_to_all(i)
865 ncheck_from=ncheck_from+ntask_cont_from_all(i)
867 write (iout,*) "Control sums",ncheck_from,ncheck_to
868 if (ncheck_from.ne.ncheck_to) then
869 write (iout,*) "Error: #receive differs from #send."
870 write (iout,*) "Terminating program...!"
876 do j=1,ntask_cont_to_all(i)
877 ii=itask_cont_to_all(j,i)
878 do k=1,ntask_cont_from_all(ii)
879 if (itask_cont_from_all(k,ii).eq.i) then
880 if(lprint)write(iout,*)"Matching send/receive",i,ii
884 if (k.eq.ntask_cont_from_all(ii)+1) then
886 write (iout,*) "Error: send by",j," to",ii,
887 & " would have no matching receive"
893 write (iout,*) "Unmatched sends; terminating program"
897 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
898 c write (iout,*) "flag broadcast ended flag=",flag
901 call MPI_Finalize(IERROR)
902 stop "Error in INIT_INT_TABLE: unmatched send/receive."
904 call MPI_Comm_group(FG_COMM,fg_group,IERR)
905 c write (iout,*) "MPI_Comm_group ended"
907 call MPI_Group_incl(fg_group,ntask_cont_from+1,
908 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
909 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
910 & CONT_TO_GROUP,IERR)
913 iaux=4*(ielend(ii)-ielstart(ii)+1)
914 call MPI_Group_translate_ranks(fg_group,iaux,
915 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
916 & iint_sent_local(1,ielstart(ii),i),IERR )
917 c write (iout,*) "Ranks translated i=",i
920 iaux=4*(iturn3_end-iturn3_start+1)
921 call MPI_Group_translate_ranks(fg_group,iaux,
922 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
923 & iturn3_sent_local(1,iturn3_start),IERR)
924 iaux=4*(iturn4_end-iturn4_start+1)
925 call MPI_Group_translate_ranks(fg_group,iaux,
926 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
927 & iturn4_sent_local(1,iturn4_start),IERR)
929 write (iout,*) "iint_sent_local"
932 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
933 & j=ielstart(ii),ielend(ii))
936 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
937 & " iturn3_end",iturn3_end
938 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
939 & i=iturn3_start,iturn3_end)
940 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
941 & " iturn4_end",iturn4_end
942 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
943 & i=iturn4_start,iturn4_end)
946 call MPI_Group_free(fg_group,ierr)
947 call MPI_Group_free(cont_from_group,ierr)
948 call MPI_Group_free(cont_to_group,ierr)
949 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
950 call MPI_Type_commit(MPI_UYZ,IERROR)
951 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
953 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
954 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
955 call MPI_Type_commit(MPI_MU,IERROR)
956 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
957 call MPI_Type_commit(MPI_MAT1,IERROR)
958 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
959 call MPI_Type_commit(MPI_MAT2,IERROR)
960 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
961 call MPI_Type_commit(MPI_THET,IERROR)
962 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
963 call MPI_Type_commit(MPI_GAM,IERROR)
965 c 9/22/08 Derived types to send matrices which appear in correlation terms
967 if (ivec_count(i).eq.ivec_count(0)) then
973 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
974 if (ind_typ.eq.0) then
984 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
987 c blocklengths(i)=blocklengths(i)*ichunk
989 c write (iout,*) "blocklengths and displs"
991 c write (iout,*) i,blocklengths(i),displs(i)
994 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
995 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
996 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
997 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1003 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1006 c blocklengths(i)=blocklengths(i)*ichunk
1008 c write (iout,*) "blocklengths and displs"
1010 c write (iout,*) i,blocklengths(i),displs(i)
1013 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1014 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1015 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1016 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1022 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1025 blocklengths(i)=blocklengths(i)*ichunk
1027 call MPI_Type_indexed(8,blocklengths,displs,
1028 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1029 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1035 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1038 blocklengths(i)=blocklengths(i)*ichunk
1040 call MPI_Type_indexed(8,blocklengths,displs,
1041 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1042 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1048 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1051 blocklengths(i)=blocklengths(i)*ichunk
1053 call MPI_Type_indexed(6,blocklengths,displs,
1054 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1055 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1061 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1064 blocklengths(i)=blocklengths(i)*ichunk
1066 call MPI_Type_indexed(2,blocklengths,displs,
1067 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1068 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1074 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1077 blocklengths(i)=blocklengths(i)*ichunk
1079 call MPI_Type_indexed(4,blocklengths,displs,
1080 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1081 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1085 iint_start=ivec_start+1
1088 iint_count(i)=ivec_count(i)
1089 iint_displ(i)=ivec_displ(i)
1090 ivec_displ(i)=ivec_displ(i)-1
1091 iset_displ(i)=iset_displ(i)-1
1092 ithet_displ(i)=ithet_displ(i)-1
1093 iphi_displ(i)=iphi_displ(i)-1
1094 iphi1_displ(i)=iphi1_displ(i)-1
1095 ibond_displ(i)=ibond_displ(i)-1
1097 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1098 & .and. (me.eq.0 .or. .not. out1file)) then
1099 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1101 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1104 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1105 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1106 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1108 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1111 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1112 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1113 & ' SC-p interactions','were distributed among',nfgtasks,
1114 & ' fine-grain processors.'
1130 idihconstr_end=ndih_constr
1131 iphid_start=iphi_start
1132 iphid_end=iphi_end-1
1149 c---------------------------------------------------------------------------
1150 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1152 include "DIMENSIONS"
1153 include "COMMON.INTERACT"
1154 include "COMMON.SETUP"
1155 include "COMMON.IOUNITS"
1156 integer ii,jj,itask(4),ntask_cont_to,
1157 &itask_cont_to(0:max_fg_procs-1)
1159 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1160 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1161 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1162 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1163 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1164 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1165 & ielend_all(maxres,0:max_fg_procs-1)
1166 integer iproc,isent,k,l
1167 c Determines whether to send interaction ii,jj to other processors; a given
1168 c interaction can be sent to at most 2 processors.
1169 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1170 c one processor, otherwise flag is unchanged from the input value.
1176 c write (iout,*) "ii",ii," jj",jj
1177 c Loop over processors to check if anybody could need interaction ii,jj
1178 do iproc=0,fg_rank-1
1179 c Check if the interaction matches any turn3 at iproc
1180 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1182 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1183 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1185 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1188 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1189 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1192 call add_task(iproc,ntask_cont_to,itask_cont_to)
1196 C Check if the interaction matches any turn4 at iproc
1197 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1199 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1200 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1202 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1205 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1206 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1209 call add_task(iproc,ntask_cont_to,itask_cont_to)
1213 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1214 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1215 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1216 & ielend_all(ii-1,iproc).ge.jj-1) then
1218 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1219 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1222 call add_task(iproc,ntask_cont_to,itask_cont_to)
1225 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1226 & ielend_all(ii-1,iproc).ge.jj+1) then
1228 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1229 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1232 call add_task(iproc,ntask_cont_to,itask_cont_to)
1239 c---------------------------------------------------------------------------
1240 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1242 include "DIMENSIONS"
1243 include "COMMON.INTERACT"
1244 include "COMMON.SETUP"
1245 include "COMMON.IOUNITS"
1246 integer ii,jj,itask(2),ntask_cont_from,
1247 & itask_cont_from(0:max_fg_procs-1)
1249 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1250 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1251 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1252 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1253 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1254 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1255 & ielend_all(maxres,0:max_fg_procs-1)
1257 do iproc=fg_rank+1,nfgtasks-1
1258 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1260 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1261 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1263 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1264 call add_task(iproc,ntask_cont_from,itask_cont_from)
1267 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1269 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1270 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1272 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1273 call add_task(iproc,ntask_cont_from,itask_cont_from)
1276 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1277 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1279 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1280 & jj+1.le.ielend_all(ii+1,iproc)) then
1281 call add_task(iproc,ntask_cont_from,itask_cont_from)
1283 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1284 & jj-1.le.ielend_all(ii+1,iproc)) then
1285 call add_task(iproc,ntask_cont_from,itask_cont_from)
1288 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1290 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1291 & jj-1.le.ielend_all(ii-1,iproc)) then
1292 call add_task(iproc,ntask_cont_from,itask_cont_from)
1294 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1295 & jj+1.le.ielend_all(ii-1,iproc)) then
1296 call add_task(iproc,ntask_cont_from,itask_cont_from)
1303 c---------------------------------------------------------------------------
1304 subroutine add_task(iproc,ntask_cont,itask_cont)
1306 include "DIMENSIONS"
1307 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1310 if (itask_cont(ii).eq.iproc) return
1312 ntask_cont=ntask_cont+1
1313 itask_cont(ntask_cont)=iproc
1316 c---------------------------------------------------------------------------
1317 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1318 implicit real*8 (a-h,o-z)
1319 include 'DIMENSIONS'
1321 include 'COMMON.SETUP'
1322 integer total_ints,lower_bound,upper_bound
1323 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1324 nint=total_ints/nfgtasks
1328 nexcess=total_ints-nint*nfgtasks
1330 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1334 lower_bound=lower_bound+int4proc(i)
1336 upper_bound=lower_bound+int4proc(fg_rank)
1337 lower_bound=lower_bound+1
1340 c---------------------------------------------------------------------------
1341 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1342 implicit real*8 (a-h,o-z)
1343 include 'DIMENSIONS'
1345 include 'COMMON.SETUP'
1346 integer total_ints,lower_bound,upper_bound
1347 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1348 nint=total_ints/nfgtasks1
1352 nexcess=total_ints-nint*nfgtasks1
1354 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1358 lower_bound=lower_bound+int4proc(i)
1360 upper_bound=lower_bound+int4proc(fg_rank1)
1361 lower_bound=lower_bound+1
1364 c---------------------------------------------------------------------------
1365 subroutine int_partition(int_index,lower_index,upper_index,atom,
1366 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1367 implicit real*8 (a-h,o-z)
1368 include 'DIMENSIONS'
1369 include 'COMMON.IOUNITS'
1370 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1371 & first_atom,last_atom,int_gr,jat_start,jat_end
1374 if (lprn) write (iout,*) 'int_index=',int_index
1375 int_index_old=int_index
1376 int_index=int_index+last_atom-first_atom+1
1378 & write (iout,*) 'int_index=',int_index,
1379 & ' int_index_old',int_index_old,
1380 & ' lower_index=',lower_index,
1381 & ' upper_index=',upper_index,
1382 & ' atom=',atom,' first_atom=',first_atom,
1383 & ' last_atom=',last_atom
1384 if (int_index.ge.lower_index) then
1386 if (at_start.eq.0) then
1388 jat_start=first_atom-1+lower_index-int_index_old
1390 jat_start=first_atom
1392 if (lprn) write (iout,*) 'jat_start',jat_start
1393 if (int_index.ge.upper_index) then
1395 jat_end=first_atom-1+upper_index-int_index_old
1400 if (lprn) write (iout,*) 'jat_end',jat_end
1405 c------------------------------------------------------------------------------
1406 subroutine hpb_partition
1407 implicit real*8 (a-h,o-z)
1408 include 'DIMENSIONS'
1412 include 'COMMON.SBRIDGE'
1413 include 'COMMON.IOUNITS'
1414 include 'COMMON.SETUP'
1416 call int_bounds(nhpb,link_start,link_end)
1417 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1418 & ' absolute rank',MyRank,
1419 & ' nhpb',nhpb,' link_start=',link_start,
1420 & ' link_end',link_end