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:MaxProcs),
328 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
329 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
330 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
331 & ielend_all(maxres,0:MaxProcs-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)
381 if (ihpb(ii).eq.i+nres) then
388 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
392 c write (iout,*) 'jj=i+1'
393 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
394 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
400 else if (jj.eq.nct) then
402 c write (iout,*) 'jj=nct'
403 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
404 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
412 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
413 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
415 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
416 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
427 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
428 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
433 ind_scint=ind_scint+nct-i
437 ind_scint_old=ind_scint
446 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
447 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
450 write (iout,'(a)') 'Interaction array:'
452 write (iout,'(i3,2(2x,2i3))')
453 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
458 C Now partition the electrostatic-interaction array
460 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
461 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
463 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
464 & ' absolute rank',MyRank,
465 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
466 & ' my_ele_inde',my_ele_inde
473 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
474 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
477 if (iatel_s.eq.0) iatel_s=1
478 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
479 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
480 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
481 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
482 c & " my_ele_inde_vdw",my_ele_inde_vdw
489 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
491 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
493 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
494 c & " ielend_vdw",ielend_vdw(i)
496 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
507 do i=iatel_s_vdw,iatel_e_vdw
513 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
514 & ' absolute rank',MyRank
515 write (iout,*) 'Electrostatic interaction array:'
517 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
522 C Partition the SC-p interaction array
524 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
525 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
526 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
527 & ' absolute rank',myrank,
528 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
529 & ' my_scp_inde',my_scp_inde
535 if (i.lt.nnt+iscp) then
536 cd write (iout,*) 'i.le.nnt+iscp'
537 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
538 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
540 else if (i.gt.nct-iscp) then
541 cd write (iout,*) 'i.gt.nct-iscp'
542 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
543 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
546 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
547 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
550 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
551 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
560 if (i.lt.nnt+iscp) then
562 iscpstart(i,1)=i+iscp
564 elseif (i.gt.nct-iscp) then
572 iscpstart(i,2)=i+iscp
578 write (iout,'(a)') 'SC-p interaction array:'
579 do i=iatscp_s,iatscp_e
580 write (iout,'(i3,2(2x,2i3))')
581 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
584 C Partition local interactions
586 call int_bounds(nres-2,loc_start,loc_end)
587 loc_start=loc_start+1
589 call int_bounds(nres-2,ithet_start,ithet_end)
590 ithet_start=ithet_start+2
591 ithet_end=ithet_end+2
592 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
593 iturn3_start=iturn3_start+nnt
594 iphi_start=iturn3_start+2
595 iturn3_end=iturn3_end+nnt
596 iphi_end=iturn3_end+2
597 iturn3_start=iturn3_start-1
598 iturn3_end=iturn3_end-1
599 call int_bounds(nres-3,itau_start,itau_end)
600 itau_start=itau_start+3
602 call int_bounds(nres-3,iphi1_start,iphi1_end)
603 iphi1_start=iphi1_start+3
604 iphi1_end=iphi1_end+3
605 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
606 iturn4_start=iturn4_start+nnt
607 iphid_start=iturn4_start+2
608 iturn4_end=iturn4_end+nnt
609 iphid_end=iturn4_end+2
610 iturn4_start=iturn4_start-1
611 iturn4_end=iturn4_end-1
612 call int_bounds(nres-2,ibond_start,ibond_end)
613 ibond_start=ibond_start+1
614 ibond_end=ibond_end+1
615 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
616 ibondp_start=ibondp_start+nnt
617 ibondp_end=ibondp_end+nnt
618 call int_bounds1(nres-1,ivec_start,ivec_end)
619 c print *,"Processor",myrank,fg_rank,fg_rank1,
620 c & " ivec_start",ivec_start," ivec_end",ivec_end
621 iset_start=loc_start+2
623 if (ndih_constr.eq.0) then
627 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
629 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
631 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
633 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
634 igrad_start=((2*nlen+1)
635 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
636 jgrad_start(igrad_start)=
637 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
639 jgrad_end(igrad_start)=nres
640 igrad_end=((2*nlen+1)
641 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
642 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
643 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
645 do i=igrad_start+1,igrad_end-1
650 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
651 & ' absolute rank',myrank,
652 & ' loc_start',loc_start,' loc_end',loc_end,
653 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
654 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
655 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
656 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
657 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
658 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
659 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
660 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
661 & ' iset_start',iset_start,' iset_end',iset_end,
662 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
664 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
665 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
666 & ' ngrad_end',ngrad_end
667 do i=igrad_start,igrad_end
668 write(*,*) 'Processor:',fg_rank,myrank,i,
669 & jgrad_start(i),jgrad_end(i)
672 if (nfgtasks.gt.1) then
673 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
674 & MPI_INTEGER,FG_COMM1,IERROR)
675 iaux=ivec_end-ivec_start+1
676 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
677 & MPI_INTEGER,FG_COMM1,IERROR)
678 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
679 & MPI_INTEGER,FG_COMM,IERROR)
680 iaux=iset_end-iset_start+1
681 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
684 & MPI_INTEGER,FG_COMM,IERROR)
685 iaux=ibond_end-ibond_start+1
686 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
689 & MPI_INTEGER,FG_COMM,IERROR)
690 iaux=ithet_end-ithet_start+1
691 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
694 & MPI_INTEGER,FG_COMM,IERROR)
695 iaux=iphi_end-iphi_start+1
696 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
697 & MPI_INTEGER,FG_COMM,IERROR)
698 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
699 & MPI_INTEGER,FG_COMM,IERROR)
700 iaux=iphi1_end-iphi1_start+1
701 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
702 & MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
710 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
712 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
714 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
716 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
718 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
719 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
720 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
721 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
722 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
723 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
724 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
726 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
727 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
728 write (iout,*) "iturn3_start_all",
729 & (iturn3_start_all(i),i=0,nfgtasks-1)
730 write (iout,*) "iturn3_end_all",
731 & (iturn3_end_all(i),i=0,nfgtasks-1)
732 write (iout,*) "iturn4_start_all",
733 & (iturn4_start_all(i),i=0,nfgtasks-1)
734 write (iout,*) "iturn4_end_all",
735 & (iturn4_end_all(i),i=0,nfgtasks-1)
736 write (iout,*) "The ielstart_all array"
738 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
740 write (iout,*) "The ielend_all array"
742 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
748 itask_cont_from(0)=fg_rank
749 itask_cont_to(0)=fg_rank
751 do ii=iturn3_start,iturn3_end
752 call add_int(ii,ii+2,iturn3_sent(1,ii),
753 & ntask_cont_to,itask_cont_to,flag)
755 do ii=iturn4_start,iturn4_end
756 call add_int(ii,ii+3,iturn4_sent(1,ii),
757 & ntask_cont_to,itask_cont_to,flag)
759 do ii=iturn3_start,iturn3_end
760 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
762 do ii=iturn4_start,iturn4_end
763 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
766 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
767 & " ntask_cont_to",ntask_cont_to
768 write (iout,*) "itask_cont_from",
769 & (itask_cont_from(i),i=1,ntask_cont_from)
770 write (iout,*) "itask_cont_to",
771 & (itask_cont_to(i),i=1,ntask_cont_to)
774 c write (iout,*) "Loop forward"
777 c write (iout,*) "from loop i=",i
779 do j=ielstart(i),ielend(i)
780 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
783 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
784 c & " iatel_e",iatel_e
788 c write (iout,*) "i",i," ielstart",ielstart(i),
789 c & " ielend",ielend(i)
792 do j=ielstart(i),ielend(i)
793 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
794 & itask_cont_to,flag)
802 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
803 & " ntask_cont_to",ntask_cont_to
804 write (iout,*) "itask_cont_from",
805 & (itask_cont_from(i),i=1,ntask_cont_from)
806 write (iout,*) "itask_cont_to",
807 & (itask_cont_to(i),i=1,ntask_cont_to)
809 write (iout,*) "iint_sent"
812 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
813 & j=ielstart(ii),ielend(ii))
815 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
816 & " iturn3_end",iturn3_end
817 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
818 & i=iturn3_start,iturn3_end)
819 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
820 & " iturn4_end",iturn4_end
821 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
822 & i=iturn4_start,iturn4_end)
825 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
826 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
827 c write (iout,*) "Gather ntask_cont_from ended"
829 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
830 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
832 c write (iout,*) "Gather itask_cont_from ended"
834 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
835 & 1,MPI_INTEGER,king,FG_COMM,IERR)
836 c write (iout,*) "Gather ntask_cont_to ended"
838 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
839 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
840 c write (iout,*) "Gather itask_cont_to ended"
842 if (fg_rank.eq.king) then
843 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
845 write (iout,'(20i4)') i,ntask_cont_from_all(i),
846 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
850 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
852 write (iout,'(20i4)') i,ntask_cont_to_all(i),
853 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
857 C Check if every send will have a matching receive
861 ncheck_to=ncheck_to+ntask_cont_to_all(i)
862 ncheck_from=ncheck_from+ntask_cont_from_all(i)
864 write (iout,*) "Control sums",ncheck_from,ncheck_to
865 if (ncheck_from.ne.ncheck_to) then
866 write (iout,*) "Error: #receive differs from #send."
867 write (iout,*) "Terminating program...!"
873 do j=1,ntask_cont_to_all(i)
874 ii=itask_cont_to_all(j,i)
875 do k=1,ntask_cont_from_all(ii)
876 if (itask_cont_from_all(k,ii).eq.i) then
877 if(lprint)write(iout,*)"Matching send/receive",i,ii
881 if (k.eq.ntask_cont_from_all(ii)+1) then
883 write (iout,*) "Error: send by",j," to",ii,
884 & " would have no matching receive"
890 write (iout,*) "Unmatched sends; terminating program"
894 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
895 c write (iout,*) "flag broadcast ended flag=",flag
898 call MPI_Finalize(IERROR)
899 stop "Error in INIT_INT_TABLE: unmatched send/receive."
901 call MPI_Comm_group(FG_COMM,fg_group,IERR)
902 c write (iout,*) "MPI_Comm_group ended"
904 call MPI_Group_incl(fg_group,ntask_cont_from+1,
905 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
906 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
907 & CONT_TO_GROUP,IERR)
910 iaux=4*(ielend(ii)-ielstart(ii)+1)
911 call MPI_Group_translate_ranks(fg_group,iaux,
912 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
913 & iint_sent_local(1,ielstart(ii),i),IERR )
914 c write (iout,*) "Ranks translated i=",i
917 iaux=4*(iturn3_end-iturn3_start+1)
918 call MPI_Group_translate_ranks(fg_group,iaux,
919 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
920 & iturn3_sent_local(1,iturn3_start),IERR)
921 iaux=4*(iturn4_end-iturn4_start+1)
922 call MPI_Group_translate_ranks(fg_group,iaux,
923 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
924 & iturn4_sent_local(1,iturn4_start),IERR)
926 write (iout,*) "iint_sent_local"
929 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
930 & j=ielstart(ii),ielend(ii))
933 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
934 & " iturn3_end",iturn3_end
935 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
936 & i=iturn3_start,iturn3_end)
937 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
938 & " iturn4_end",iturn4_end
939 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
940 & i=iturn4_start,iturn4_end)
943 call MPI_Group_free(fg_group,ierr)
944 call MPI_Group_free(cont_from_group,ierr)
945 call MPI_Group_free(cont_to_group,ierr)
946 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
947 call MPI_Type_commit(MPI_UYZ,IERROR)
948 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
950 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
951 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
952 call MPI_Type_commit(MPI_MU,IERROR)
953 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
954 call MPI_Type_commit(MPI_MAT1,IERROR)
955 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
956 call MPI_Type_commit(MPI_MAT2,IERROR)
957 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
958 call MPI_Type_commit(MPI_THET,IERROR)
959 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
960 call MPI_Type_commit(MPI_GAM,IERROR)
962 c 9/22/08 Derived types to send matrices which appear in correlation terms
964 if (ivec_count(i).eq.ivec_count(0)) then
970 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
971 if (ind_typ.eq.0) then
981 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
984 c blocklengths(i)=blocklengths(i)*ichunk
986 c write (iout,*) "blocklengths and displs"
988 c write (iout,*) i,blocklengths(i),displs(i)
991 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
992 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
993 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
994 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1000 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1003 c blocklengths(i)=blocklengths(i)*ichunk
1005 c write (iout,*) "blocklengths and displs"
1007 c write (iout,*) i,blocklengths(i),displs(i)
1010 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1011 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1012 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1013 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1019 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1022 blocklengths(i)=blocklengths(i)*ichunk
1024 call MPI_Type_indexed(8,blocklengths,displs,
1025 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1026 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1032 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1035 blocklengths(i)=blocklengths(i)*ichunk
1037 call MPI_Type_indexed(8,blocklengths,displs,
1038 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1039 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1045 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1048 blocklengths(i)=blocklengths(i)*ichunk
1050 call MPI_Type_indexed(6,blocklengths,displs,
1051 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1052 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1058 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1061 blocklengths(i)=blocklengths(i)*ichunk
1063 call MPI_Type_indexed(2,blocklengths,displs,
1064 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1065 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1071 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1074 blocklengths(i)=blocklengths(i)*ichunk
1076 call MPI_Type_indexed(4,blocklengths,displs,
1077 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1078 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1082 iint_start=ivec_start+1
1085 iint_count(i)=ivec_count(i)
1086 iint_displ(i)=ivec_displ(i)
1087 ivec_displ(i)=ivec_displ(i)-1
1088 iset_displ(i)=iset_displ(i)-1
1089 ithet_displ(i)=ithet_displ(i)-1
1090 iphi_displ(i)=iphi_displ(i)-1
1091 iphi1_displ(i)=iphi1_displ(i)-1
1092 ibond_displ(i)=ibond_displ(i)-1
1094 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1095 & .and. (me.eq.0 .or. .not. out1file)) then
1096 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1098 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1101 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1102 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1103 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1105 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1108 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1109 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1110 & ' SC-p interactions','were distributed among',nfgtasks,
1111 & ' fine-grain processors.'
1127 idihconstr_end=ndih_constr
1128 iphid_start=iphi_start
1129 iphid_end=iphi_end-1
1146 c---------------------------------------------------------------------------
1147 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1149 include "DIMENSIONS"
1150 include "COMMON.INTERACT"
1151 include "COMMON.SETUP"
1152 include "COMMON.IOUNITS"
1153 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1155 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1156 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1157 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1158 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1159 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1160 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1161 & ielend_all(maxres,0:MaxProcs-1)
1162 integer iproc,isent,k,l
1163 c Determines whether to send interaction ii,jj to other processors; a given
1164 c interaction can be sent to at most 2 processors.
1165 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1166 c one processor, otherwise flag is unchanged from the input value.
1172 c write (iout,*) "ii",ii," jj",jj
1173 c Loop over processors to check if anybody could need interaction ii,jj
1174 do iproc=0,fg_rank-1
1175 c Check if the interaction matches any turn3 at iproc
1176 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1178 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1179 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1181 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1184 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1185 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1188 call add_task(iproc,ntask_cont_to,itask_cont_to)
1192 C Check if the interaction matches any turn4 at iproc
1193 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1195 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1196 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1198 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1201 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1202 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1205 call add_task(iproc,ntask_cont_to,itask_cont_to)
1209 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1210 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1211 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1212 & ielend_all(ii-1,iproc).ge.jj-1) then
1214 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1215 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1218 call add_task(iproc,ntask_cont_to,itask_cont_to)
1221 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1222 & ielend_all(ii-1,iproc).ge.jj+1) then
1224 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1225 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1228 call add_task(iproc,ntask_cont_to,itask_cont_to)
1235 c---------------------------------------------------------------------------
1236 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1238 include "DIMENSIONS"
1239 include "COMMON.INTERACT"
1240 include "COMMON.SETUP"
1241 include "COMMON.IOUNITS"
1242 integer ii,jj,itask(2),ntask_cont_from,
1243 & itask_cont_from(0:MaxProcs-1)
1245 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1246 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1247 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1248 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1249 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1250 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1251 & ielend_all(maxres,0:MaxProcs-1)
1253 do iproc=fg_rank+1,nfgtasks-1
1254 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1256 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1257 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1259 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1260 call add_task(iproc,ntask_cont_from,itask_cont_from)
1263 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1265 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1266 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1268 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1269 call add_task(iproc,ntask_cont_from,itask_cont_from)
1272 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1273 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1275 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1276 & jj+1.le.ielend_all(ii+1,iproc)) then
1277 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1284 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1286 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1287 & jj-1.le.ielend_all(ii-1,iproc)) then
1288 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1299 c---------------------------------------------------------------------------
1300 subroutine add_task(iproc,ntask_cont,itask_cont)
1302 include "DIMENSIONS"
1303 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1306 if (itask_cont(ii).eq.iproc) return
1308 ntask_cont=ntask_cont+1
1309 itask_cont(ntask_cont)=iproc
1312 c---------------------------------------------------------------------------
1313 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1314 implicit real*8 (a-h,o-z)
1315 include 'DIMENSIONS'
1317 include 'COMMON.SETUP'
1318 integer total_ints,lower_bound,upper_bound
1319 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1320 nint=total_ints/nfgtasks
1324 nexcess=total_ints-nint*nfgtasks
1326 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1330 lower_bound=lower_bound+int4proc(i)
1332 upper_bound=lower_bound+int4proc(fg_rank)
1333 lower_bound=lower_bound+1
1336 c---------------------------------------------------------------------------
1337 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1338 implicit real*8 (a-h,o-z)
1339 include 'DIMENSIONS'
1341 include 'COMMON.SETUP'
1342 integer total_ints,lower_bound,upper_bound
1343 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1344 nint=total_ints/nfgtasks1
1348 nexcess=total_ints-nint*nfgtasks1
1350 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1354 lower_bound=lower_bound+int4proc(i)
1356 upper_bound=lower_bound+int4proc(fg_rank1)
1357 lower_bound=lower_bound+1
1360 c---------------------------------------------------------------------------
1361 subroutine int_partition(int_index,lower_index,upper_index,atom,
1362 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1363 implicit real*8 (a-h,o-z)
1364 include 'DIMENSIONS'
1365 include 'COMMON.IOUNITS'
1366 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1367 & first_atom,last_atom,int_gr,jat_start,jat_end
1370 if (lprn) write (iout,*) 'int_index=',int_index
1371 int_index_old=int_index
1372 int_index=int_index+last_atom-first_atom+1
1374 & write (iout,*) 'int_index=',int_index,
1375 & ' int_index_old',int_index_old,
1376 & ' lower_index=',lower_index,
1377 & ' upper_index=',upper_index,
1378 & ' atom=',atom,' first_atom=',first_atom,
1379 & ' last_atom=',last_atom
1380 if (int_index.ge.lower_index) then
1382 if (at_start.eq.0) then
1384 jat_start=first_atom-1+lower_index-int_index_old
1386 jat_start=first_atom
1388 if (lprn) write (iout,*) 'jat_start',jat_start
1389 if (int_index.ge.upper_index) then
1391 jat_end=first_atom-1+upper_index-int_index_old
1396 if (lprn) write (iout,*) 'jat_end',jat_end
1401 c------------------------------------------------------------------------------
1402 subroutine hpb_partition
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1408 include 'COMMON.SBRIDGE'
1409 include 'COMMON.IOUNITS'
1410 include 'COMMON.SETUP'
1412 call int_bounds(nhpb,link_start,link_end)
1413 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1414 & ' absolute rank',MyRank,
1415 & ' nhpb',nhpb,' link_start=',link_start,
1416 & ' link_end',link_end