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 c 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()
169 athet(j,i,ichir1,ichir2)=0.0D0
170 bthet(j,i,ichir1,ichir2)=0.0D0
190 gaussc(l,k,j,i)=0.0D0
213 v1c(1,l,i,j,k,iblock)=0.0D0
214 v1s(1,l,i,j,k,iblock)=0.0D0
215 v1c(2,l,i,j,k,iblock)=0.0D0
216 v1s(2,l,i,j,k,iblock)=0.0D0
220 v2c(m,l,i,j,k,iblock)=0.0D0
221 v2s(m,l,i,j,k,iblock)=0.0D0
232 C Initialize the bridge arrays
251 C Initialize variables used in minimization.
260 C Initialize the variables responsible for the mode of gradient storage.
265 C Initialize constants used to split the energy into long- and short-range
271 nprint_ene=nprint_ene-1
275 c-------------------------------------------------------------------------
277 implicit real*8 (a-h,o-z)
279 include 'COMMON.NAMES'
280 include 'COMMON.FFIELD'
282 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
283 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
285 &'C','M','F','I','L','V','W','Y','A','G','T',
286 &'S','Q','N','E','D','H','R','K','P','X'/
287 data potname /'LJ','LJK','BP','GB','GBV'/
289 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
290 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
291 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
292 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
293 & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
295 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
296 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
297 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
298 & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
300 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
301 & 21,24,25,26,27,0,0,0/
303 c---------------------------------------------------------------------------
304 subroutine init_int_table
305 implicit real*8 (a-h,o-z)
309 integer blocklengths(15),displs(15)
311 include 'COMMON.CONTROL'
312 include 'COMMON.SETUP'
313 include 'COMMON.CHAIN'
314 include 'COMMON.INTERACT'
315 include 'COMMON.LOCAL'
316 include 'COMMON.SBRIDGE'
317 include 'COMMON.TORCNSTR'
318 include 'COMMON.IOUNITS'
319 include 'COMMON.DERIV'
320 include 'COMMON.CONTACTS'
321 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
322 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
323 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
324 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
325 & ielend_all(maxres,0:MaxProcs-1),
326 & ntask_cont_from_all(0:max_fg_procs-1),
327 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
328 & ntask_cont_to_all(0:max_fg_procs-1),
329 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
330 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
331 logical scheck,lprint,flag
333 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
334 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
335 C... Determine the numbers of start and end SC-SC interaction
336 C... to deal with by current processor.
338 itask_cont_from(i)=fg_rank
339 itask_cont_to(i)=fg_rank
343 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
344 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
345 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
347 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
348 & ' absolute rank',MyRank,
349 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
350 & ' my_sc_inde',my_sc_inde
370 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
371 cd & (ihpb(i),jhpb(i),i=1,nss)
375 if (ihpb(ii).eq.i+nres) then
382 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
386 c write (iout,*) 'jj=i+1'
387 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
388 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
394 else if (jj.eq.nct) then
396 c write (iout,*) 'jj=nct'
397 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
398 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
406 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
407 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
409 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
410 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
421 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
422 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
427 ind_scint=ind_scint+nct-i
431 ind_scint_old=ind_scint
440 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
441 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
444 write (iout,'(a)') 'Interaction array:'
446 write (iout,'(i3,2(2x,2i3))')
447 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
452 C Now partition the electrostatic-interaction array
454 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
455 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
457 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
458 & ' absolute rank',MyRank,
459 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
460 & ' my_ele_inde',my_ele_inde
467 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
468 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
471 if (iatel_s.eq.0) iatel_s=1
472 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
473 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
474 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
475 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
476 c & " my_ele_inde_vdw",my_ele_inde_vdw
483 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
485 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
487 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
488 c & " ielend_vdw",ielend_vdw(i)
490 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
501 do i=iatel_s_vdw,iatel_e_vdw
507 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
508 & ' absolute rank',MyRank
509 write (iout,*) 'Electrostatic interaction array:'
511 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
516 C Partition the SC-p interaction array
518 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
519 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
520 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
521 & ' absolute rank',myrank,
522 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
523 & ' my_scp_inde',my_scp_inde
529 if (i.lt.nnt+iscp) then
530 cd write (iout,*) 'i.le.nnt+iscp'
531 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
532 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
534 else if (i.gt.nct-iscp) then
535 cd write (iout,*) 'i.gt.nct-iscp'
536 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
537 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
540 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
541 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
544 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
545 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
554 if (i.lt.nnt+iscp) then
556 iscpstart(i,1)=i+iscp
558 elseif (i.gt.nct-iscp) then
566 iscpstart(i,2)=i+iscp
572 write (iout,'(a)') 'SC-p interaction array:'
573 do i=iatscp_s,iatscp_e
574 write (iout,'(i3,2(2x,2i3))')
575 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
578 C Partition local interactions
580 call int_bounds(nres-2,loc_start,loc_end)
581 loc_start=loc_start+1
583 call int_bounds(nres-2,ithet_start,ithet_end)
584 ithet_start=ithet_start+2
585 ithet_end=ithet_end+2
586 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
587 iturn3_start=iturn3_start+nnt
588 iphi_start=iturn3_start+2
589 iturn3_end=iturn3_end+nnt
590 iphi_end=iturn3_end+2
591 iturn3_start=iturn3_start-1
592 iturn3_end=iturn3_end-1
593 call int_bounds(nres-3,iphi1_start,iphi1_end)
594 iphi1_start=iphi1_start+3
595 iphi1_end=iphi1_end+3
596 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
597 iturn4_start=iturn4_start+nnt
598 iphid_start=iturn4_start+2
599 iturn4_end=iturn4_end+nnt
600 iphid_end=iturn4_end+2
601 iturn4_start=iturn4_start-1
602 iturn4_end=iturn4_end-1
603 call int_bounds(nres-2,ibond_start,ibond_end)
604 ibond_start=ibond_start+1
605 ibond_end=ibond_end+1
606 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
607 ibondp_start=ibondp_start+nnt
608 ibondp_end=ibondp_end+nnt
609 call int_bounds1(nres-1,ivec_start,ivec_end)
610 print *,"Processor",myrank,fg_rank,fg_rank1,
611 & " ivec_start",ivec_start," ivec_end",ivec_end
612 iset_start=loc_start+2
614 if (ndih_constr.eq.0) then
618 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
620 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
622 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
623 igrad_start=((2*nlen+1)
624 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
625 jgrad_start(igrad_start)=
626 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
628 jgrad_end(igrad_start)=nres
629 igrad_end=((2*nlen+1)
630 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
631 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
632 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
634 do i=igrad_start+1,igrad_end-1
639 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
640 & ' absolute rank',myrank,
641 & ' loc_start',loc_start,' loc_end',loc_end,
642 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
643 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
644 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
645 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
646 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
647 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
648 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
649 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
650 & ' iset_start',iset_start,' iset_end',iset_end,
651 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
653 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
654 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
655 & ' ngrad_end',ngrad_end
656 do i=igrad_start,igrad_end
657 write(*,*) 'Processor:',fg_rank,myrank,i,
658 & jgrad_start(i),jgrad_end(i)
661 if (nfgtasks.gt.1) then
662 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
663 & MPI_INTEGER,FG_COMM1,IERROR)
664 iaux=ivec_end-ivec_start+1
665 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
666 & MPI_INTEGER,FG_COMM1,IERROR)
667 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
668 & MPI_INTEGER,FG_COMM,IERROR)
669 iaux=iset_end-iset_start+1
670 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
671 & MPI_INTEGER,FG_COMM,IERROR)
672 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
673 & MPI_INTEGER,FG_COMM,IERROR)
674 iaux=ibond_end-ibond_start+1
675 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
676 & MPI_INTEGER,FG_COMM,IERROR)
677 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
678 & MPI_INTEGER,FG_COMM,IERROR)
679 iaux=ithet_end-ithet_start+1
680 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
681 & MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
683 & MPI_INTEGER,FG_COMM,IERROR)
684 iaux=iphi_end-iphi_start+1
685 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
686 & MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
688 & MPI_INTEGER,FG_COMM,IERROR)
689 iaux=iphi1_end-iphi1_start+1
690 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
691 & MPI_INTEGER,FG_COMM,IERROR)
698 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
699 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
700 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
701 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
702 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
703 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
704 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
705 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
706 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
707 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
708 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
709 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
710 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
711 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
713 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
715 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
716 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
717 write (iout,*) "iturn3_start_all",
718 & (iturn3_start_all(i),i=0,nfgtasks-1)
719 write (iout,*) "iturn3_end_all",
720 & (iturn3_end_all(i),i=0,nfgtasks-1)
721 write (iout,*) "iturn4_start_all",
722 & (iturn4_start_all(i),i=0,nfgtasks-1)
723 write (iout,*) "iturn4_end_all",
724 & (iturn4_end_all(i),i=0,nfgtasks-1)
725 write (iout,*) "The ielstart_all array"
727 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
729 write (iout,*) "The ielend_all array"
731 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
737 itask_cont_from(0)=fg_rank
738 itask_cont_to(0)=fg_rank
740 do ii=iturn3_start,iturn3_end
741 call add_int(ii,ii+2,iturn3_sent(1,ii),
742 & ntask_cont_to,itask_cont_to,flag)
744 do ii=iturn4_start,iturn4_end
745 call add_int(ii,ii+3,iturn4_sent(1,ii),
746 & ntask_cont_to,itask_cont_to,flag)
748 do ii=iturn3_start,iturn3_end
749 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
751 do ii=iturn4_start,iturn4_end
752 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
755 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
756 & " ntask_cont_to",ntask_cont_to
757 write (iout,*) "itask_cont_from",
758 & (itask_cont_from(i),i=1,ntask_cont_from)
759 write (iout,*) "itask_cont_to",
760 & (itask_cont_to(i),i=1,ntask_cont_to)
763 c write (iout,*) "Loop forward"
766 c write (iout,*) "from loop i=",i
768 do j=ielstart(i),ielend(i)
769 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
772 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
773 c & " iatel_e",iatel_e
777 c write (iout,*) "i",i," ielstart",ielstart(i),
778 c & " ielend",ielend(i)
781 do j=ielstart(i),ielend(i)
782 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
783 & itask_cont_to,flag)
791 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
792 & " ntask_cont_to",ntask_cont_to
793 write (iout,*) "itask_cont_from",
794 & (itask_cont_from(i),i=1,ntask_cont_from)
795 write (iout,*) "itask_cont_to",
796 & (itask_cont_to(i),i=1,ntask_cont_to)
798 write (iout,*) "iint_sent"
801 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
802 & j=ielstart(ii),ielend(ii))
804 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
805 & " iturn3_end",iturn3_end
806 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
807 & i=iturn3_start,iturn3_end)
808 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
809 & " iturn4_end",iturn4_end
810 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
811 & i=iturn4_start,iturn4_end)
814 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
815 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
816 c write (iout,*) "Gather ntask_cont_from ended"
818 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
819 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
821 c write (iout,*) "Gather itask_cont_from ended"
823 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
824 & 1,MPI_INTEGER,king,FG_COMM,IERR)
825 c write (iout,*) "Gather ntask_cont_to ended"
827 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
828 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
829 c write (iout,*) "Gather itask_cont_to ended"
831 if (fg_rank.eq.king) then
832 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
834 write (iout,'(20i4)') i,ntask_cont_from_all(i),
835 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
839 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
841 write (iout,'(20i4)') i,ntask_cont_to_all(i),
842 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
846 C Check if every send will have a matching receive
850 ncheck_to=ncheck_to+ntask_cont_to_all(i)
851 ncheck_from=ncheck_from+ntask_cont_from_all(i)
853 write (iout,*) "Control sums",ncheck_from,ncheck_to
854 if (ncheck_from.ne.ncheck_to) then
855 write (iout,*) "Error: #receive differs from #send."
856 write (iout,*) "Terminating program...!"
862 do j=1,ntask_cont_to_all(i)
863 ii=itask_cont_to_all(j,i)
864 do k=1,ntask_cont_from_all(ii)
865 if (itask_cont_from_all(k,ii).eq.i) then
866 if(lprint)write(iout,*)"Matching send/receive",i,ii
870 if (k.eq.ntask_cont_from_all(ii)+1) then
872 write (iout,*) "Error: send by",j," to",ii,
873 & " would have no matching receive"
879 write (iout,*) "Unmatched sends; terminating program"
883 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
884 c write (iout,*) "flag broadcast ended flag=",flag
887 call MPI_Finalize(IERROR)
888 stop "Error in INIT_INT_TABLE: unmatched send/receive."
890 call MPI_Comm_group(FG_COMM,fg_group,IERR)
891 c write (iout,*) "MPI_Comm_group ended"
893 call MPI_Group_incl(fg_group,ntask_cont_from+1,
894 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
895 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
896 & CONT_TO_GROUP,IERR)
899 iaux=4*(ielend(ii)-ielstart(ii)+1)
900 call MPI_Group_translate_ranks(fg_group,iaux,
901 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
902 & iint_sent_local(1,ielstart(ii),i),IERR )
903 c write (iout,*) "Ranks translated i=",i
906 iaux=4*(iturn3_end-iturn3_start+1)
907 call MPI_Group_translate_ranks(fg_group,iaux,
908 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
909 & iturn3_sent_local(1,iturn3_start),IERR)
910 iaux=4*(iturn4_end-iturn4_start+1)
911 call MPI_Group_translate_ranks(fg_group,iaux,
912 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
913 & iturn4_sent_local(1,iturn4_start),IERR)
915 write (iout,*) "iint_sent_local"
918 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
919 & j=ielstart(ii),ielend(ii))
922 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
923 & " iturn3_end",iturn3_end
924 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
925 & i=iturn3_start,iturn3_end)
926 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
927 & " iturn4_end",iturn4_end
928 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
929 & i=iturn4_start,iturn4_end)
932 call MPI_Group_free(fg_group,ierr)
933 call MPI_Group_free(cont_from_group,ierr)
934 call MPI_Group_free(cont_to_group,ierr)
935 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
936 call MPI_Type_commit(MPI_UYZ,IERROR)
937 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
939 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
940 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
941 call MPI_Type_commit(MPI_MU,IERROR)
942 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
943 call MPI_Type_commit(MPI_MAT1,IERROR)
944 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
945 call MPI_Type_commit(MPI_MAT2,IERROR)
946 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
947 call MPI_Type_commit(MPI_THET,IERROR)
948 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
949 call MPI_Type_commit(MPI_GAM,IERROR)
951 c 9/22/08 Derived types to send matrices which appear in correlation terms
953 if (ivec_count(i).eq.ivec_count(0)) then
959 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
960 if (ind_typ.eq.0) then
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_ROTAT1(ind_typ),IERROR)
982 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
983 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
989 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
992 c blocklengths(i)=blocklengths(i)*ichunk
994 c write (iout,*) "blocklengths and displs"
996 c write (iout,*) i,blocklengths(i),displs(i)
999 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1000 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1001 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1002 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1008 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1011 blocklengths(i)=blocklengths(i)*ichunk
1013 call MPI_Type_indexed(8,blocklengths,displs,
1014 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1015 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1021 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1024 blocklengths(i)=blocklengths(i)*ichunk
1026 call MPI_Type_indexed(8,blocklengths,displs,
1027 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1028 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1034 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1037 blocklengths(i)=blocklengths(i)*ichunk
1039 call MPI_Type_indexed(6,blocklengths,displs,
1040 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1041 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1047 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1050 blocklengths(i)=blocklengths(i)*ichunk
1052 call MPI_Type_indexed(2,blocklengths,displs,
1053 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1054 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1060 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1063 blocklengths(i)=blocklengths(i)*ichunk
1065 call MPI_Type_indexed(4,blocklengths,displs,
1066 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1067 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1071 iint_start=ivec_start+1
1074 iint_count(i)=ivec_count(i)
1075 iint_displ(i)=ivec_displ(i)
1076 ivec_displ(i)=ivec_displ(i)-1
1077 iset_displ(i)=iset_displ(i)-1
1078 ithet_displ(i)=ithet_displ(i)-1
1079 iphi_displ(i)=iphi_displ(i)-1
1080 iphi1_displ(i)=iphi1_displ(i)-1
1081 ibond_displ(i)=ibond_displ(i)-1
1083 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1084 & .and. (me.eq.0 .or. out1file)) then
1085 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1087 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1090 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1091 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1092 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1094 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1097 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1098 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1099 & ' SC-p interactions','were distributed among',nfgtasks,
1100 & ' fine-grain processors.'
1116 idihconstr_end=ndih_constr
1117 iphid_start=iphi_start
1118 iphid_end=iphi_end-1
1133 c---------------------------------------------------------------------------
1134 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1136 include "DIMENSIONS"
1137 include "COMMON.INTERACT"
1138 include "COMMON.SETUP"
1139 include "COMMON.IOUNITS"
1140 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1142 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1143 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1144 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1145 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1146 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1147 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1148 & ielend_all(maxres,0:MaxProcs-1)
1149 integer iproc,isent,k,l
1150 c Determines whether to send interaction ii,jj to other processors; a given
1151 c interaction can be sent to at most 2 processors.
1152 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1153 c one processor, otherwise flag is unchanged from the input value.
1159 c write (iout,*) "ii",ii," jj",jj
1160 c Loop over processors to check if anybody could need interaction ii,jj
1161 do iproc=0,fg_rank-1
1162 c Check if the interaction matches any turn3 at iproc
1163 do k=iturn3_start_all(iproc),iturn3_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 C Check if the interaction matches any turn4 at iproc
1180 do k=iturn4_start_all(iproc),iturn4_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 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1197 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1198 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1199 & ielend_all(ii-1,iproc).ge.jj-1) then
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)
1208 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1209 & ielend_all(ii-1,iproc).ge.jj+1) then
1211 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1212 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1215 call add_task(iproc,ntask_cont_to,itask_cont_to)
1222 c---------------------------------------------------------------------------
1223 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1225 include "DIMENSIONS"
1226 include "COMMON.INTERACT"
1227 include "COMMON.SETUP"
1228 include "COMMON.IOUNITS"
1229 integer ii,jj,itask(2),ntask_cont_from,
1230 & itask_cont_from(0:MaxProcs-1)
1232 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1233 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1234 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1235 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1236 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1237 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1238 & ielend_all(maxres,0:MaxProcs-1)
1240 do iproc=fg_rank+1,nfgtasks-1
1241 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1243 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1244 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1246 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1247 call add_task(iproc,ntask_cont_from,itask_cont_from)
1250 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1252 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1253 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1255 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1256 call add_task(iproc,ntask_cont_from,itask_cont_from)
1259 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1260 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1262 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1263 & jj+1.le.ielend_all(ii+1,iproc)) then
1264 call add_task(iproc,ntask_cont_from,itask_cont_from)
1266 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1267 & jj-1.le.ielend_all(ii+1,iproc)) then
1268 call add_task(iproc,ntask_cont_from,itask_cont_from)
1271 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1273 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1274 & jj-1.le.ielend_all(ii-1,iproc)) then
1275 call add_task(iproc,ntask_cont_from,itask_cont_from)
1277 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1278 & jj+1.le.ielend_all(ii-1,iproc)) then
1279 call add_task(iproc,ntask_cont_from,itask_cont_from)
1286 c---------------------------------------------------------------------------
1287 subroutine add_task(iproc,ntask_cont,itask_cont)
1289 include "DIMENSIONS"
1290 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1293 if (itask_cont(ii).eq.iproc) return
1295 ntask_cont=ntask_cont+1
1296 itask_cont(ntask_cont)=iproc
1299 c---------------------------------------------------------------------------
1300 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1301 implicit real*8 (a-h,o-z)
1302 include 'DIMENSIONS'
1304 include 'COMMON.SETUP'
1305 integer total_ints,lower_bound,upper_bound
1306 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1307 nint=total_ints/nfgtasks
1311 nexcess=total_ints-nint*nfgtasks
1313 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1317 lower_bound=lower_bound+int4proc(i)
1319 upper_bound=lower_bound+int4proc(fg_rank)
1320 lower_bound=lower_bound+1
1323 c---------------------------------------------------------------------------
1324 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1325 implicit real*8 (a-h,o-z)
1326 include 'DIMENSIONS'
1328 include 'COMMON.SETUP'
1329 integer total_ints,lower_bound,upper_bound
1330 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1331 nint=total_ints/nfgtasks1
1335 nexcess=total_ints-nint*nfgtasks1
1337 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1341 lower_bound=lower_bound+int4proc(i)
1343 upper_bound=lower_bound+int4proc(fg_rank1)
1344 lower_bound=lower_bound+1
1347 c---------------------------------------------------------------------------
1348 subroutine int_partition(int_index,lower_index,upper_index,atom,
1349 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1350 implicit real*8 (a-h,o-z)
1351 include 'DIMENSIONS'
1352 include 'COMMON.IOUNITS'
1353 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1354 & first_atom,last_atom,int_gr,jat_start,jat_end
1357 if (lprn) write (iout,*) 'int_index=',int_index
1358 int_index_old=int_index
1359 int_index=int_index+last_atom-first_atom+1
1361 & write (iout,*) 'int_index=',int_index,
1362 & ' int_index_old',int_index_old,
1363 & ' lower_index=',lower_index,
1364 & ' upper_index=',upper_index,
1365 & ' atom=',atom,' first_atom=',first_atom,
1366 & ' last_atom=',last_atom
1367 if (int_index.ge.lower_index) then
1369 if (at_start.eq.0) then
1371 jat_start=first_atom-1+lower_index-int_index_old
1373 jat_start=first_atom
1375 if (lprn) write (iout,*) 'jat_start',jat_start
1376 if (int_index.ge.upper_index) then
1378 jat_end=first_atom-1+upper_index-int_index_old
1383 if (lprn) write (iout,*) 'jat_end',jat_end
1388 c------------------------------------------------------------------------------
1389 subroutine hpb_partition
1390 implicit real*8 (a-h,o-z)
1391 include 'DIMENSIONS'
1395 include 'COMMON.SBRIDGE'
1396 include 'COMMON.IOUNITS'
1397 include 'COMMON.SETUP'
1398 include 'COMMON.CONTROL'
1400 call int_bounds(nhpb,link_start,link_end)
1402 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1403 & ' absolute rank',MyRank,
1404 & ' nhpb',nhpb,' link_start=',link_start,
1405 & ' link_end',link_end