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'/
63 C The following is just to define auxiliary variables used in angle conversion
102 crc for write_rmsbank1
104 cdr include secondary structure prediction bias
107 C CSA I/O units (separated from others especially for Jooyoung)
118 icsa_bank_reminimized=38
121 crc for ifc error 118
124 C Set default weights of the energy terms.
135 print '(a,$)','Inside initialize'
136 c call memmon_print_usage()
186 gaussc(l,k,j,i)=0.0D0
207 C Initialize the bridge arrays
226 C Initialize variables used in minimization.
235 C Initialize the variables responsible for the mode of gradient storage.
240 C Initialize constants used to split the energy into long- and short-range
246 nprint_ene=nprint_ene-1
250 c-------------------------------------------------------------------------
252 implicit real*8 (a-h,o-z)
254 include 'COMMON.NAMES'
255 include 'COMMON.FFIELD'
257 &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
258 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
259 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
260 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
262 &'z','p','k','r','h','d','e','n','q','s','t','g',
263 &'a','y','w','v','l','i','f','m','c','x',
264 &'C','M','F','I','L','V','W','Y','A','G','T',
265 &'S','Q','N','E','D','H','R','K','P','X'/
266 data potname /'LJ','LJK','BP','GB','GBV'/
268 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
269 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
270 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
271 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
273 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
274 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
275 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
278 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
281 c---------------------------------------------------------------------------
282 subroutine init_int_table
283 implicit real*8 (a-h,o-z)
287 integer blocklengths(15),displs(15)
289 include 'COMMON.CONTROL'
290 include 'COMMON.SETUP'
291 include 'COMMON.CHAIN'
292 include 'COMMON.INTERACT'
293 include 'COMMON.LOCAL'
294 include 'COMMON.SBRIDGE'
295 include 'COMMON.TORCNSTR'
296 include 'COMMON.IOUNITS'
297 include 'COMMON.DERIV'
298 include 'COMMON.CONTACTS'
299 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
300 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
301 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
302 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
303 & ielend_all(maxres,0:MaxProcs-1),
304 & ntask_cont_from_all(0:max_fg_procs-1),
305 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
306 & ntask_cont_to_all(0:max_fg_procs-1),
307 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
308 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
309 logical scheck,lprint,flag
311 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
312 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
313 C... Determine the numbers of start and end SC-SC interaction
314 C... to deal with by current processor.
316 itask_cont_from(i)=fg_rank
317 itask_cont_to(i)=fg_rank
321 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
322 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
323 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
325 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
326 & ' absolute rank',MyRank,
327 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
328 & ' my_sc_inde',my_sc_inde
348 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
349 cd & (ihpb(i),jhpb(i),i=1,nss)
353 if (ihpb(ii).eq.i+nres) then
360 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
364 c write (iout,*) 'jj=i+1'
365 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
366 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
372 else if (jj.eq.nct) then
374 c write (iout,*) 'jj=nct'
375 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
376 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
384 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
385 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
387 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
388 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
399 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
400 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
405 ind_scint=ind_scint+nct-i
409 ind_scint_old=ind_scint
418 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
419 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
422 write (iout,'(a)') 'Interaction array:'
424 write (iout,'(i3,2(2x,2i3))')
425 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
430 C Now partition the electrostatic-interaction array
432 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
433 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
435 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
436 & ' absolute rank',MyRank,
437 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
438 & ' my_ele_inde',my_ele_inde
445 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
446 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
449 if (iatel_s.eq.0) iatel_s=1
450 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
451 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
452 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
453 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
454 c & " my_ele_inde_vdw",my_ele_inde_vdw
461 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
463 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
465 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
466 c & " ielend_vdw",ielend_vdw(i)
468 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
479 do i=iatel_s_vdw,iatel_e_vdw
485 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
486 & ' absolute rank',MyRank
487 write (iout,*) 'Electrostatic interaction array:'
489 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
494 C Partition the SC-p interaction array
496 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
497 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
498 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
499 & ' absolute rank',myrank,
500 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
501 & ' my_scp_inde',my_scp_inde
507 if (i.lt.nnt+iscp) then
508 cd write (iout,*) 'i.le.nnt+iscp'
509 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
510 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
512 else if (i.gt.nct-iscp) then
513 cd write (iout,*) 'i.gt.nct-iscp'
514 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
515 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
518 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
519 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
522 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
523 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
532 if (i.lt.nnt+iscp) then
534 iscpstart(i,1)=i+iscp
536 elseif (i.gt.nct-iscp) then
544 iscpstart(i,2)=i+iscp
550 write (iout,'(a)') 'SC-p interaction array:'
551 do i=iatscp_s,iatscp_e
552 write (iout,'(i3,2(2x,2i3))')
553 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
556 C Partition local interactions
558 call int_bounds(nres-2,loc_start,loc_end)
559 loc_start=loc_start+1
561 call int_bounds(nres-2,ithet_start,ithet_end)
562 ithet_start=ithet_start+2
563 ithet_end=ithet_end+2
564 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
565 iturn3_start=iturn3_start+nnt
566 iphi_start=iturn3_start+2
567 iturn3_end=iturn3_end+nnt
568 iphi_end=iturn3_end+2
569 iturn3_start=iturn3_start-1
570 iturn3_end=iturn3_end-1
571 call int_bounds(nres-3,itau_start,itau_end)
572 itau_start=itau_start+3
574 call int_bounds(nres-3,iphi1_start,iphi1_end)
575 iphi1_start=iphi1_start+3
576 iphi1_end=iphi1_end+3
577 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
578 iturn4_start=iturn4_start+nnt
579 iphid_start=iturn4_start+2
580 iturn4_end=iturn4_end+nnt
581 iphid_end=iturn4_end+2
582 iturn4_start=iturn4_start-1
583 iturn4_end=iturn4_end-1
584 call int_bounds(nres-2,ibond_start,ibond_end)
585 ibond_start=ibond_start+1
586 ibond_end=ibond_end+1
587 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
588 ibondp_start=ibondp_start+nnt
589 ibondp_end=ibondp_end+nnt
590 call int_bounds1(nres-1,ivec_start,ivec_end)
591 print *,"Processor",myrank,fg_rank,fg_rank1,
592 & " ivec_start",ivec_start," ivec_end",ivec_end
593 iset_start=loc_start+2
595 if (ndih_constr.eq.0) then
599 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
601 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
603 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
604 igrad_start=((2*nlen+1)
605 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
606 jgrad_start(igrad_start)=
607 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
609 jgrad_end(igrad_start)=nres
610 igrad_end=((2*nlen+1)
611 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
612 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
613 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
615 do i=igrad_start+1,igrad_end-1
620 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
621 & ' absolute rank',myrank,
622 & ' loc_start',loc_start,' loc_end',loc_end,
623 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
624 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
625 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
626 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
627 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
628 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
629 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
630 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
631 & ' iset_start',iset_start,' iset_end',iset_end,
632 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
634 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
635 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
636 & ' ngrad_end',ngrad_end
637 do i=igrad_start,igrad_end
638 write(*,*) 'Processor:',fg_rank,myrank,i,
639 & jgrad_start(i),jgrad_end(i)
642 if (nfgtasks.gt.1) then
643 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
644 & MPI_INTEGER,FG_COMM1,IERROR)
645 iaux=ivec_end-ivec_start+1
646 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
647 & MPI_INTEGER,FG_COMM1,IERROR)
648 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
649 & MPI_INTEGER,FG_COMM,IERROR)
650 iaux=iset_end-iset_start+1
651 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
652 & MPI_INTEGER,FG_COMM,IERROR)
653 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
654 & MPI_INTEGER,FG_COMM,IERROR)
655 iaux=ibond_end-ibond_start+1
656 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
657 & MPI_INTEGER,FG_COMM,IERROR)
658 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
659 & MPI_INTEGER,FG_COMM,IERROR)
660 iaux=ithet_end-ithet_start+1
661 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
662 & MPI_INTEGER,FG_COMM,IERROR)
663 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 iaux=iphi_end-iphi_start+1
666 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
667 & MPI_INTEGER,FG_COMM,IERROR)
668 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
669 & MPI_INTEGER,FG_COMM,IERROR)
670 iaux=iphi1_end-iphi1_start+1
671 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
672 & MPI_INTEGER,FG_COMM,IERROR)
679 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
680 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
682 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
684 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
686 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
688 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
689 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
690 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
692 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
693 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
694 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
696 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
697 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
698 write (iout,*) "iturn3_start_all",
699 & (iturn3_start_all(i),i=0,nfgtasks-1)
700 write (iout,*) "iturn3_end_all",
701 & (iturn3_end_all(i),i=0,nfgtasks-1)
702 write (iout,*) "iturn4_start_all",
703 & (iturn4_start_all(i),i=0,nfgtasks-1)
704 write (iout,*) "iturn4_end_all",
705 & (iturn4_end_all(i),i=0,nfgtasks-1)
706 write (iout,*) "The ielstart_all array"
708 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
710 write (iout,*) "The ielend_all array"
712 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
718 itask_cont_from(0)=fg_rank
719 itask_cont_to(0)=fg_rank
721 do ii=iturn3_start,iturn3_end
722 call add_int(ii,ii+2,iturn3_sent(1,ii),
723 & ntask_cont_to,itask_cont_to,flag)
725 do ii=iturn4_start,iturn4_end
726 call add_int(ii,ii+3,iturn4_sent(1,ii),
727 & ntask_cont_to,itask_cont_to,flag)
729 do ii=iturn3_start,iturn3_end
730 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
732 do ii=iturn4_start,iturn4_end
733 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
736 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
737 & " ntask_cont_to",ntask_cont_to
738 write (iout,*) "itask_cont_from",
739 & (itask_cont_from(i),i=1,ntask_cont_from)
740 write (iout,*) "itask_cont_to",
741 & (itask_cont_to(i),i=1,ntask_cont_to)
744 c write (iout,*) "Loop forward"
747 c write (iout,*) "from loop i=",i
749 do j=ielstart(i),ielend(i)
750 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
753 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
754 c & " iatel_e",iatel_e
758 c write (iout,*) "i",i," ielstart",ielstart(i),
759 c & " ielend",ielend(i)
762 do j=ielstart(i),ielend(i)
763 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
764 & itask_cont_to,flag)
772 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
773 & " ntask_cont_to",ntask_cont_to
774 write (iout,*) "itask_cont_from",
775 & (itask_cont_from(i),i=1,ntask_cont_from)
776 write (iout,*) "itask_cont_to",
777 & (itask_cont_to(i),i=1,ntask_cont_to)
779 write (iout,*) "iint_sent"
782 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
783 & j=ielstart(ii),ielend(ii))
785 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
786 & " iturn3_end",iturn3_end
787 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
788 & i=iturn3_start,iturn3_end)
789 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
790 & " iturn4_end",iturn4_end
791 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
792 & i=iturn4_start,iturn4_end)
795 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
796 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
797 c write (iout,*) "Gather ntask_cont_from ended"
799 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
800 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
802 c write (iout,*) "Gather itask_cont_from ended"
804 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
805 & 1,MPI_INTEGER,king,FG_COMM,IERR)
806 c write (iout,*) "Gather ntask_cont_to ended"
808 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
809 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
810 c write (iout,*) "Gather itask_cont_to ended"
812 if (fg_rank.eq.king) then
813 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
815 write (iout,'(20i4)') i,ntask_cont_from_all(i),
816 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
820 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
822 write (iout,'(20i4)') i,ntask_cont_to_all(i),
823 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
827 C Check if every send will have a matching receive
831 ncheck_to=ncheck_to+ntask_cont_to_all(i)
832 ncheck_from=ncheck_from+ntask_cont_from_all(i)
834 write (iout,*) "Control sums",ncheck_from,ncheck_to
835 if (ncheck_from.ne.ncheck_to) then
836 write (iout,*) "Error: #receive differs from #send."
837 write (iout,*) "Terminating program...!"
843 do j=1,ntask_cont_to_all(i)
844 ii=itask_cont_to_all(j,i)
845 do k=1,ntask_cont_from_all(ii)
846 if (itask_cont_from_all(k,ii).eq.i) then
847 if(lprint)write(iout,*)"Matching send/receive",i,ii
851 if (k.eq.ntask_cont_from_all(ii)+1) then
853 write (iout,*) "Error: send by",j," to",ii,
854 & " would have no matching receive"
860 write (iout,*) "Unmatched sends; terminating program"
864 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
865 c write (iout,*) "flag broadcast ended flag=",flag
868 call MPI_Finalize(IERROR)
869 stop "Error in INIT_INT_TABLE: unmatched send/receive."
871 call MPI_Comm_group(FG_COMM,fg_group,IERR)
872 c write (iout,*) "MPI_Comm_group ended"
874 call MPI_Group_incl(fg_group,ntask_cont_from+1,
875 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
876 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
877 & CONT_TO_GROUP,IERR)
880 iaux=4*(ielend(ii)-ielstart(ii)+1)
881 call MPI_Group_translate_ranks(fg_group,iaux,
882 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
883 & iint_sent_local(1,ielstart(ii),i),IERR )
884 c write (iout,*) "Ranks translated i=",i
887 iaux=4*(iturn3_end-iturn3_start+1)
888 call MPI_Group_translate_ranks(fg_group,iaux,
889 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
890 & iturn3_sent_local(1,iturn3_start),IERR)
891 iaux=4*(iturn4_end-iturn4_start+1)
892 call MPI_Group_translate_ranks(fg_group,iaux,
893 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
894 & iturn4_sent_local(1,iturn4_start),IERR)
896 write (iout,*) "iint_sent_local"
899 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
900 & j=ielstart(ii),ielend(ii))
903 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
904 & " iturn3_end",iturn3_end
905 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
906 & i=iturn3_start,iturn3_end)
907 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
908 & " iturn4_end",iturn4_end
909 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
910 & i=iturn4_start,iturn4_end)
913 call MPI_Group_free(fg_group,ierr)
914 call MPI_Group_free(cont_from_group,ierr)
915 call MPI_Group_free(cont_to_group,ierr)
916 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
917 call MPI_Type_commit(MPI_UYZ,IERROR)
918 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
920 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
921 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
922 call MPI_Type_commit(MPI_MU,IERROR)
923 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
924 call MPI_Type_commit(MPI_MAT1,IERROR)
925 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
926 call MPI_Type_commit(MPI_MAT2,IERROR)
927 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
928 call MPI_Type_commit(MPI_THET,IERROR)
929 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
930 call MPI_Type_commit(MPI_GAM,IERROR)
932 c 9/22/08 Derived types to send matrices which appear in correlation terms
934 if (ivec_count(i).eq.ivec_count(0)) then
940 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
941 if (ind_typ.eq.0) then
951 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
954 c blocklengths(i)=blocklengths(i)*ichunk
956 c write (iout,*) "blocklengths and displs"
958 c write (iout,*) i,blocklengths(i),displs(i)
961 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
962 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
963 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
964 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
970 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
973 c blocklengths(i)=blocklengths(i)*ichunk
975 c write (iout,*) "blocklengths and displs"
977 c write (iout,*) i,blocklengths(i),displs(i)
980 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
981 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
982 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
983 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
989 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
992 blocklengths(i)=blocklengths(i)*ichunk
994 call MPI_Type_indexed(8,blocklengths,displs,
995 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
996 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1002 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1005 blocklengths(i)=blocklengths(i)*ichunk
1007 call MPI_Type_indexed(8,blocklengths,displs,
1008 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1009 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1015 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1018 blocklengths(i)=blocklengths(i)*ichunk
1020 call MPI_Type_indexed(6,blocklengths,displs,
1021 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1022 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1028 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1031 blocklengths(i)=blocklengths(i)*ichunk
1033 call MPI_Type_indexed(2,blocklengths,displs,
1034 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1035 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1041 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1044 blocklengths(i)=blocklengths(i)*ichunk
1046 call MPI_Type_indexed(4,blocklengths,displs,
1047 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1048 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1052 iint_start=ivec_start+1
1055 iint_count(i)=ivec_count(i)
1056 iint_displ(i)=ivec_displ(i)
1057 ivec_displ(i)=ivec_displ(i)-1
1058 iset_displ(i)=iset_displ(i)-1
1059 ithet_displ(i)=ithet_displ(i)-1
1060 iphi_displ(i)=iphi_displ(i)-1
1061 iphi1_displ(i)=iphi1_displ(i)-1
1062 ibond_displ(i)=ibond_displ(i)-1
1064 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1065 & .and. (me.eq.0 .or. out1file)) then
1066 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1068 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1071 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1072 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1073 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1075 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1078 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1079 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1080 & ' SC-p interactions','were distributed among',nfgtasks,
1081 & ' fine-grain processors.'
1097 idihconstr_end=ndih_constr
1098 iphid_start=iphi_start
1099 iphid_end=iphi_end-1
1116 c---------------------------------------------------------------------------
1117 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1119 include "DIMENSIONS"
1120 include "COMMON.INTERACT"
1121 include "COMMON.SETUP"
1122 include "COMMON.IOUNITS"
1123 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1125 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1126 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1127 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1128 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1129 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1130 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1131 & ielend_all(maxres,0:MaxProcs-1)
1132 integer iproc,isent,k,l
1133 c Determines whether to send interaction ii,jj to other processors; a given
1134 c interaction can be sent to at most 2 processors.
1135 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1136 c one processor, otherwise flag is unchanged from the input value.
1142 c write (iout,*) "ii",ii," jj",jj
1143 c Loop over processors to check if anybody could need interaction ii,jj
1144 do iproc=0,fg_rank-1
1145 c Check if the interaction matches any turn3 at iproc
1146 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1148 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1149 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1151 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1154 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1155 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1158 call add_task(iproc,ntask_cont_to,itask_cont_to)
1162 C Check if the interaction matches any turn4 at iproc
1163 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1165 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1166 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1168 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1171 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1172 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1175 call add_task(iproc,ntask_cont_to,itask_cont_to)
1179 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1180 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1181 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1182 & ielend_all(ii-1,iproc).ge.jj-1) then
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)
1191 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1192 & ielend_all(ii-1,iproc).ge.jj+1) then
1194 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1195 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1198 call add_task(iproc,ntask_cont_to,itask_cont_to)
1205 c---------------------------------------------------------------------------
1206 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1208 include "DIMENSIONS"
1209 include "COMMON.INTERACT"
1210 include "COMMON.SETUP"
1211 include "COMMON.IOUNITS"
1212 integer ii,jj,itask(2),ntask_cont_from,
1213 & itask_cont_from(0:MaxProcs-1)
1215 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1216 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1217 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1218 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1219 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1220 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1221 & ielend_all(maxres,0:MaxProcs-1)
1223 do iproc=fg_rank+1,nfgtasks-1
1224 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1226 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1227 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1229 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1230 call add_task(iproc,ntask_cont_from,itask_cont_from)
1233 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1235 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1236 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1238 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1239 call add_task(iproc,ntask_cont_from,itask_cont_from)
1242 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1243 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1245 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1246 & jj+1.le.ielend_all(ii+1,iproc)) then
1247 call add_task(iproc,ntask_cont_from,itask_cont_from)
1249 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1250 & jj-1.le.ielend_all(ii+1,iproc)) then
1251 call add_task(iproc,ntask_cont_from,itask_cont_from)
1254 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1256 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1257 & jj-1.le.ielend_all(ii-1,iproc)) then
1258 call add_task(iproc,ntask_cont_from,itask_cont_from)
1260 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1261 & jj+1.le.ielend_all(ii-1,iproc)) then
1262 call add_task(iproc,ntask_cont_from,itask_cont_from)
1269 c---------------------------------------------------------------------------
1270 subroutine add_task(iproc,ntask_cont,itask_cont)
1272 include "DIMENSIONS"
1273 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1276 if (itask_cont(ii).eq.iproc) return
1278 ntask_cont=ntask_cont+1
1279 itask_cont(ntask_cont)=iproc
1282 c---------------------------------------------------------------------------
1283 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1284 implicit real*8 (a-h,o-z)
1285 include 'DIMENSIONS'
1287 include 'COMMON.SETUP'
1288 integer total_ints,lower_bound,upper_bound
1289 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1290 nint=total_ints/nfgtasks
1294 nexcess=total_ints-nint*nfgtasks
1296 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1300 lower_bound=lower_bound+int4proc(i)
1302 upper_bound=lower_bound+int4proc(fg_rank)
1303 lower_bound=lower_bound+1
1306 c---------------------------------------------------------------------------
1307 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1308 implicit real*8 (a-h,o-z)
1309 include 'DIMENSIONS'
1311 include 'COMMON.SETUP'
1312 integer total_ints,lower_bound,upper_bound
1313 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1314 nint=total_ints/nfgtasks1
1318 nexcess=total_ints-nint*nfgtasks1
1320 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1324 lower_bound=lower_bound+int4proc(i)
1326 upper_bound=lower_bound+int4proc(fg_rank1)
1327 lower_bound=lower_bound+1
1330 c---------------------------------------------------------------------------
1331 subroutine int_partition(int_index,lower_index,upper_index,atom,
1332 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1333 implicit real*8 (a-h,o-z)
1334 include 'DIMENSIONS'
1335 include 'COMMON.IOUNITS'
1336 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1337 & first_atom,last_atom,int_gr,jat_start,jat_end
1340 if (lprn) write (iout,*) 'int_index=',int_index
1341 int_index_old=int_index
1342 int_index=int_index+last_atom-first_atom+1
1344 & write (iout,*) 'int_index=',int_index,
1345 & ' int_index_old',int_index_old,
1346 & ' lower_index=',lower_index,
1347 & ' upper_index=',upper_index,
1348 & ' atom=',atom,' first_atom=',first_atom,
1349 & ' last_atom=',last_atom
1350 if (int_index.ge.lower_index) then
1352 if (at_start.eq.0) then
1354 jat_start=first_atom-1+lower_index-int_index_old
1356 jat_start=first_atom
1358 if (lprn) write (iout,*) 'jat_start',jat_start
1359 if (int_index.ge.upper_index) then
1361 jat_end=first_atom-1+upper_index-int_index_old
1366 if (lprn) write (iout,*) 'jat_end',jat_end
1371 c------------------------------------------------------------------------------
1372 subroutine hpb_partition
1373 implicit real*8 (a-h,o-z)
1374 include 'DIMENSIONS'
1378 include 'COMMON.SBRIDGE'
1379 include 'COMMON.IOUNITS'
1380 include 'COMMON.SETUP'
1381 include 'COMMON.CONTROL'
1383 call int_bounds(nhpb,link_start,link_end)
1385 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1386 & ' absolute rank',MyRank,
1387 & ' nhpb',nhpb,' link_start=',link_start,
1388 & ' link_end',link_end