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()
186 gaussc(l,k,j,i)=0.0D0
209 v1c(1,l,i,j,k,iblock)=0.0D0
210 v1s(1,l,i,j,k,iblock)=0.0D0
211 v1c(2,l,i,j,k,iblock)=0.0D0
212 v1s(2,l,i,j,k,iblock)=0.0D0
216 v2c(m,l,i,j,k,iblock)=0.0D0
217 v2s(m,l,i,j,k,iblock)=0.0D0
228 C Initialize the bridge arrays
247 C Initialize variables used in minimization.
256 C Initialize the variables responsible for the mode of gradient storage.
261 C Initialize constants used to split the energy into long- and short-range
267 nprint_ene=nprint_ene-1
271 c-------------------------------------------------------------------------
273 implicit real*8 (a-h,o-z)
275 include 'COMMON.NAMES'
276 include 'COMMON.FFIELD'
278 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
279 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
281 &'C','M','F','I','L','V','W','Y','A','G','T',
282 &'S','Q','N','E','D','H','R','K','P','X'/
283 data potname /'LJ','LJK','BP','GB','GBV'/
285 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
286 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
287 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
288 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
289 & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
291 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
292 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
293 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
294 & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
296 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
297 & 21,24,25,26,27,0,0,0/
299 c---------------------------------------------------------------------------
300 subroutine init_int_table
301 implicit real*8 (a-h,o-z)
305 integer blocklengths(15),displs(15)
307 include 'COMMON.CONTROL'
308 include 'COMMON.SETUP'
309 include 'COMMON.CHAIN'
310 include 'COMMON.INTERACT'
311 include 'COMMON.LOCAL'
312 include 'COMMON.SBRIDGE'
313 include 'COMMON.TORCNSTR'
314 include 'COMMON.IOUNITS'
315 include 'COMMON.DERIV'
316 include 'COMMON.CONTACTS'
317 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
318 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
319 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
320 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
321 & ielend_all(maxres,0:MaxProcs-1),
322 & ntask_cont_from_all(0:max_fg_procs-1),
323 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
324 & ntask_cont_to_all(0:max_fg_procs-1),
325 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
326 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
327 logical scheck,lprint,flag
329 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
330 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
331 C... Determine the numbers of start and end SC-SC interaction
332 C... to deal with by current processor.
334 itask_cont_from(i)=fg_rank
335 itask_cont_to(i)=fg_rank
339 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
340 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
341 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
343 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
344 & ' absolute rank',MyRank,
345 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
346 & ' my_sc_inde',my_sc_inde
366 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
367 cd & (ihpb(i),jhpb(i),i=1,nss)
371 if (ihpb(ii).eq.i+nres) then
378 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
382 c write (iout,*) 'jj=i+1'
383 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
384 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
390 else if (jj.eq.nct) then
392 c write (iout,*) 'jj=nct'
393 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
394 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
402 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
403 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
405 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
406 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
417 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
418 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
423 ind_scint=ind_scint+nct-i
427 ind_scint_old=ind_scint
436 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
437 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
440 write (iout,'(a)') 'Interaction array:'
442 write (iout,'(i3,2(2x,2i3))')
443 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
448 C Now partition the electrostatic-interaction array
450 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
451 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
453 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
454 & ' absolute rank',MyRank,
455 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
456 & ' my_ele_inde',my_ele_inde
463 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
464 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
467 if (iatel_s.eq.0) iatel_s=1
468 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
469 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
470 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
471 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
472 c & " my_ele_inde_vdw",my_ele_inde_vdw
479 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
481 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
483 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
484 c & " ielend_vdw",ielend_vdw(i)
486 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
497 do i=iatel_s_vdw,iatel_e_vdw
503 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
504 & ' absolute rank',MyRank
505 write (iout,*) 'Electrostatic interaction array:'
507 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
512 C Partition the SC-p interaction array
514 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
515 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
516 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
517 & ' absolute rank',myrank,
518 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
519 & ' my_scp_inde',my_scp_inde
525 if (i.lt.nnt+iscp) then
526 cd write (iout,*) 'i.le.nnt+iscp'
527 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
528 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
530 else if (i.gt.nct-iscp) then
531 cd write (iout,*) 'i.gt.nct-iscp'
532 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
533 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
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,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
550 if (i.lt.nnt+iscp) then
552 iscpstart(i,1)=i+iscp
554 elseif (i.gt.nct-iscp) then
562 iscpstart(i,2)=i+iscp
568 write (iout,'(a)') 'SC-p interaction array:'
569 do i=iatscp_s,iatscp_e
570 write (iout,'(i3,2(2x,2i3))')
571 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
574 C Partition local interactions
576 call int_bounds(nres-2,loc_start,loc_end)
577 loc_start=loc_start+1
579 call int_bounds(nres-2,ithet_start,ithet_end)
580 ithet_start=ithet_start+2
581 ithet_end=ithet_end+2
582 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
583 iturn3_start=iturn3_start+nnt
584 iphi_start=iturn3_start+2
585 iturn3_end=iturn3_end+nnt
586 iphi_end=iturn3_end+2
587 iturn3_start=iturn3_start-1
588 iturn3_end=iturn3_end-1
589 call int_bounds(nres-3,iphi1_start,iphi1_end)
590 iphi1_start=iphi1_start+3
591 iphi1_end=iphi1_end+3
592 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
593 iturn4_start=iturn4_start+nnt
594 iphid_start=iturn4_start+2
595 iturn4_end=iturn4_end+nnt
596 iphid_end=iturn4_end+2
597 iturn4_start=iturn4_start-1
598 iturn4_end=iturn4_end-1
599 call int_bounds(nres-2,ibond_start,ibond_end)
600 ibond_start=ibond_start+1
601 ibond_end=ibond_end+1
602 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
603 ibondp_start=ibondp_start+nnt
604 ibondp_end=ibondp_end+nnt
605 call int_bounds1(nres-1,ivec_start,ivec_end)
606 print *,"Processor",myrank,fg_rank,fg_rank1,
607 & " ivec_start",ivec_start," ivec_end",ivec_end
608 iset_start=loc_start+2
610 if (ndih_constr.eq.0) then
614 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
616 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
618 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
619 igrad_start=((2*nlen+1)
620 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
621 jgrad_start(igrad_start)=
622 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
624 jgrad_end(igrad_start)=nres
625 igrad_end=((2*nlen+1)
626 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
627 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
628 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
630 do i=igrad_start+1,igrad_end-1
635 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
636 & ' absolute rank',myrank,
637 & ' loc_start',loc_start,' loc_end',loc_end,
638 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
639 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
640 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
641 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
642 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
643 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
644 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
645 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
646 & ' iset_start',iset_start,' iset_end',iset_end,
647 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
649 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
650 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
651 & ' ngrad_end',ngrad_end
652 do i=igrad_start,igrad_end
653 write(*,*) 'Processor:',fg_rank,myrank,i,
654 & jgrad_start(i),jgrad_end(i)
657 if (nfgtasks.gt.1) then
658 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
659 & MPI_INTEGER,FG_COMM1,IERROR)
660 iaux=ivec_end-ivec_start+1
661 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
662 & MPI_INTEGER,FG_COMM1,IERROR)
663 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
664 & MPI_INTEGER,FG_COMM,IERROR)
665 iaux=iset_end-iset_start+1
666 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
667 & MPI_INTEGER,FG_COMM,IERROR)
668 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
669 & MPI_INTEGER,FG_COMM,IERROR)
670 iaux=ibond_end-ibond_start+1
671 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
672 & MPI_INTEGER,FG_COMM,IERROR)
673 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
674 & MPI_INTEGER,FG_COMM,IERROR)
675 iaux=ithet_end-ithet_start+1
676 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
677 & MPI_INTEGER,FG_COMM,IERROR)
678 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
679 & MPI_INTEGER,FG_COMM,IERROR)
680 iaux=iphi_end-iphi_start+1
681 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
684 & MPI_INTEGER,FG_COMM,IERROR)
685 iaux=iphi1_end-iphi1_start+1
686 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
694 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
695 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
696 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
697 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
698 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
699 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
700 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
701 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
702 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
703 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
704 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
705 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
706 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
707 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
708 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
709 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
711 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
712 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
713 write (iout,*) "iturn3_start_all",
714 & (iturn3_start_all(i),i=0,nfgtasks-1)
715 write (iout,*) "iturn3_end_all",
716 & (iturn3_end_all(i),i=0,nfgtasks-1)
717 write (iout,*) "iturn4_start_all",
718 & (iturn4_start_all(i),i=0,nfgtasks-1)
719 write (iout,*) "iturn4_end_all",
720 & (iturn4_end_all(i),i=0,nfgtasks-1)
721 write (iout,*) "The ielstart_all array"
723 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
725 write (iout,*) "The ielend_all array"
727 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
733 itask_cont_from(0)=fg_rank
734 itask_cont_to(0)=fg_rank
736 do ii=iturn3_start,iturn3_end
737 call add_int(ii,ii+2,iturn3_sent(1,ii),
738 & ntask_cont_to,itask_cont_to,flag)
740 do ii=iturn4_start,iturn4_end
741 call add_int(ii,ii+3,iturn4_sent(1,ii),
742 & ntask_cont_to,itask_cont_to,flag)
744 do ii=iturn3_start,iturn3_end
745 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
747 do ii=iturn4_start,iturn4_end
748 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
751 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
752 & " ntask_cont_to",ntask_cont_to
753 write (iout,*) "itask_cont_from",
754 & (itask_cont_from(i),i=1,ntask_cont_from)
755 write (iout,*) "itask_cont_to",
756 & (itask_cont_to(i),i=1,ntask_cont_to)
759 c write (iout,*) "Loop forward"
762 c write (iout,*) "from loop i=",i
764 do j=ielstart(i),ielend(i)
765 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
768 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
769 c & " iatel_e",iatel_e
773 c write (iout,*) "i",i," ielstart",ielstart(i),
774 c & " ielend",ielend(i)
777 do j=ielstart(i),ielend(i)
778 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
779 & itask_cont_to,flag)
787 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
788 & " ntask_cont_to",ntask_cont_to
789 write (iout,*) "itask_cont_from",
790 & (itask_cont_from(i),i=1,ntask_cont_from)
791 write (iout,*) "itask_cont_to",
792 & (itask_cont_to(i),i=1,ntask_cont_to)
794 write (iout,*) "iint_sent"
797 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
798 & j=ielstart(ii),ielend(ii))
800 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
801 & " iturn3_end",iturn3_end
802 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
803 & i=iturn3_start,iturn3_end)
804 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
805 & " iturn4_end",iturn4_end
806 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
807 & i=iturn4_start,iturn4_end)
810 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
811 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
812 c write (iout,*) "Gather ntask_cont_from ended"
814 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
815 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
817 c write (iout,*) "Gather itask_cont_from ended"
819 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
820 & 1,MPI_INTEGER,king,FG_COMM,IERR)
821 c write (iout,*) "Gather ntask_cont_to ended"
823 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
824 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
825 c write (iout,*) "Gather itask_cont_to ended"
827 if (fg_rank.eq.king) then
828 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
830 write (iout,'(20i4)') i,ntask_cont_from_all(i),
831 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
835 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
837 write (iout,'(20i4)') i,ntask_cont_to_all(i),
838 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
842 C Check if every send will have a matching receive
846 ncheck_to=ncheck_to+ntask_cont_to_all(i)
847 ncheck_from=ncheck_from+ntask_cont_from_all(i)
849 write (iout,*) "Control sums",ncheck_from,ncheck_to
850 if (ncheck_from.ne.ncheck_to) then
851 write (iout,*) "Error: #receive differs from #send."
852 write (iout,*) "Terminating program...!"
858 do j=1,ntask_cont_to_all(i)
859 ii=itask_cont_to_all(j,i)
860 do k=1,ntask_cont_from_all(ii)
861 if (itask_cont_from_all(k,ii).eq.i) then
862 if(lprint)write(iout,*)"Matching send/receive",i,ii
866 if (k.eq.ntask_cont_from_all(ii)+1) then
868 write (iout,*) "Error: send by",j," to",ii,
869 & " would have no matching receive"
875 write (iout,*) "Unmatched sends; terminating program"
879 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
880 c write (iout,*) "flag broadcast ended flag=",flag
883 call MPI_Finalize(IERROR)
884 stop "Error in INIT_INT_TABLE: unmatched send/receive."
886 call MPI_Comm_group(FG_COMM,fg_group,IERR)
887 c write (iout,*) "MPI_Comm_group ended"
889 call MPI_Group_incl(fg_group,ntask_cont_from+1,
890 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
891 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
892 & CONT_TO_GROUP,IERR)
895 iaux=4*(ielend(ii)-ielstart(ii)+1)
896 call MPI_Group_translate_ranks(fg_group,iaux,
897 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
898 & iint_sent_local(1,ielstart(ii),i),IERR )
899 c write (iout,*) "Ranks translated i=",i
902 iaux=4*(iturn3_end-iturn3_start+1)
903 call MPI_Group_translate_ranks(fg_group,iaux,
904 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
905 & iturn3_sent_local(1,iturn3_start),IERR)
906 iaux=4*(iturn4_end-iturn4_start+1)
907 call MPI_Group_translate_ranks(fg_group,iaux,
908 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
909 & iturn4_sent_local(1,iturn4_start),IERR)
911 write (iout,*) "iint_sent_local"
914 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
915 & j=ielstart(ii),ielend(ii))
918 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
919 & " iturn3_end",iturn3_end
920 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
921 & i=iturn3_start,iturn3_end)
922 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
923 & " iturn4_end",iturn4_end
924 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
925 & i=iturn4_start,iturn4_end)
928 call MPI_Group_free(fg_group,ierr)
929 call MPI_Group_free(cont_from_group,ierr)
930 call MPI_Group_free(cont_to_group,ierr)
931 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
932 call MPI_Type_commit(MPI_UYZ,IERROR)
933 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
935 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
936 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
937 call MPI_Type_commit(MPI_MU,IERROR)
938 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
939 call MPI_Type_commit(MPI_MAT1,IERROR)
940 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
941 call MPI_Type_commit(MPI_MAT2,IERROR)
942 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
943 call MPI_Type_commit(MPI_THET,IERROR)
944 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
945 call MPI_Type_commit(MPI_GAM,IERROR)
947 c 9/22/08 Derived types to send matrices which appear in correlation terms
949 if (ivec_count(i).eq.ivec_count(0)) then
955 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
956 if (ind_typ.eq.0) then
966 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
969 c blocklengths(i)=blocklengths(i)*ichunk
971 c write (iout,*) "blocklengths and displs"
973 c write (iout,*) i,blocklengths(i),displs(i)
976 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
977 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
978 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
979 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
985 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
988 c blocklengths(i)=blocklengths(i)*ichunk
990 c write (iout,*) "blocklengths and displs"
992 c write (iout,*) i,blocklengths(i),displs(i)
995 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
996 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
997 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
998 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1004 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1007 blocklengths(i)=blocklengths(i)*ichunk
1009 call MPI_Type_indexed(8,blocklengths,displs,
1010 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1011 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1017 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1020 blocklengths(i)=blocklengths(i)*ichunk
1022 call MPI_Type_indexed(8,blocklengths,displs,
1023 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1024 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1030 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1033 blocklengths(i)=blocklengths(i)*ichunk
1035 call MPI_Type_indexed(6,blocklengths,displs,
1036 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1037 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1043 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1046 blocklengths(i)=blocklengths(i)*ichunk
1048 call MPI_Type_indexed(2,blocklengths,displs,
1049 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1050 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1056 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1059 blocklengths(i)=blocklengths(i)*ichunk
1061 call MPI_Type_indexed(4,blocklengths,displs,
1062 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1063 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1067 iint_start=ivec_start+1
1070 iint_count(i)=ivec_count(i)
1071 iint_displ(i)=ivec_displ(i)
1072 ivec_displ(i)=ivec_displ(i)-1
1073 iset_displ(i)=iset_displ(i)-1
1074 ithet_displ(i)=ithet_displ(i)-1
1075 iphi_displ(i)=iphi_displ(i)-1
1076 iphi1_displ(i)=iphi1_displ(i)-1
1077 ibond_displ(i)=ibond_displ(i)-1
1079 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1080 & .and. (me.eq.0 .or. out1file)) then
1081 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1083 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1086 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1087 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1088 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1090 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1093 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1094 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1095 & ' SC-p interactions','were distributed among',nfgtasks,
1096 & ' fine-grain processors.'
1112 idihconstr_end=ndih_constr
1113 iphid_start=iphi_start
1114 iphid_end=iphi_end-1
1129 c---------------------------------------------------------------------------
1130 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1132 include "DIMENSIONS"
1133 include "COMMON.INTERACT"
1134 include "COMMON.SETUP"
1135 include "COMMON.IOUNITS"
1136 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1138 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1139 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1140 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1141 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1142 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1143 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1144 & ielend_all(maxres,0:MaxProcs-1)
1145 integer iproc,isent,k,l
1146 c Determines whether to send interaction ii,jj to other processors; a given
1147 c interaction can be sent to at most 2 processors.
1148 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1149 c one processor, otherwise flag is unchanged from the input value.
1155 c write (iout,*) "ii",ii," jj",jj
1156 c Loop over processors to check if anybody could need interaction ii,jj
1157 do iproc=0,fg_rank-1
1158 c Check if the interaction matches any turn3 at iproc
1159 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1161 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1162 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1164 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1167 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1168 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1171 call add_task(iproc,ntask_cont_to,itask_cont_to)
1175 C Check if the interaction matches any turn4 at iproc
1176 do k=iturn4_start_all(iproc),iturn4_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 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1193 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1194 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1195 & ielend_all(ii-1,iproc).ge.jj-1) then
1197 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1198 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1201 call add_task(iproc,ntask_cont_to,itask_cont_to)
1204 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1205 & ielend_all(ii-1,iproc).ge.jj+1) then
1207 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1208 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1211 call add_task(iproc,ntask_cont_to,itask_cont_to)
1218 c---------------------------------------------------------------------------
1219 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1221 include "DIMENSIONS"
1222 include "COMMON.INTERACT"
1223 include "COMMON.SETUP"
1224 include "COMMON.IOUNITS"
1225 integer ii,jj,itask(2),ntask_cont_from,
1226 & itask_cont_from(0:MaxProcs-1)
1228 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1229 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1230 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1231 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1232 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1233 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1234 & ielend_all(maxres,0:MaxProcs-1)
1236 do iproc=fg_rank+1,nfgtasks-1
1237 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1239 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1240 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1242 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1243 call add_task(iproc,ntask_cont_from,itask_cont_from)
1246 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1248 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1249 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1251 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1252 call add_task(iproc,ntask_cont_from,itask_cont_from)
1255 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1256 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1258 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1259 & jj+1.le.ielend_all(ii+1,iproc)) then
1260 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1267 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1269 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1270 & jj-1.le.ielend_all(ii-1,iproc)) then
1271 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1282 c---------------------------------------------------------------------------
1283 subroutine add_task(iproc,ntask_cont,itask_cont)
1285 include "DIMENSIONS"
1286 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1289 if (itask_cont(ii).eq.iproc) return
1291 ntask_cont=ntask_cont+1
1292 itask_cont(ntask_cont)=iproc
1295 c---------------------------------------------------------------------------
1296 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1297 implicit real*8 (a-h,o-z)
1298 include 'DIMENSIONS'
1300 include 'COMMON.SETUP'
1301 integer total_ints,lower_bound,upper_bound
1302 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1303 nint=total_ints/nfgtasks
1307 nexcess=total_ints-nint*nfgtasks
1309 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1313 lower_bound=lower_bound+int4proc(i)
1315 upper_bound=lower_bound+int4proc(fg_rank)
1316 lower_bound=lower_bound+1
1319 c---------------------------------------------------------------------------
1320 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1321 implicit real*8 (a-h,o-z)
1322 include 'DIMENSIONS'
1324 include 'COMMON.SETUP'
1325 integer total_ints,lower_bound,upper_bound
1326 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1327 nint=total_ints/nfgtasks1
1331 nexcess=total_ints-nint*nfgtasks1
1333 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1337 lower_bound=lower_bound+int4proc(i)
1339 upper_bound=lower_bound+int4proc(fg_rank1)
1340 lower_bound=lower_bound+1
1343 c---------------------------------------------------------------------------
1344 subroutine int_partition(int_index,lower_index,upper_index,atom,
1345 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1346 implicit real*8 (a-h,o-z)
1347 include 'DIMENSIONS'
1348 include 'COMMON.IOUNITS'
1349 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1350 & first_atom,last_atom,int_gr,jat_start,jat_end
1353 if (lprn) write (iout,*) 'int_index=',int_index
1354 int_index_old=int_index
1355 int_index=int_index+last_atom-first_atom+1
1357 & write (iout,*) 'int_index=',int_index,
1358 & ' int_index_old',int_index_old,
1359 & ' lower_index=',lower_index,
1360 & ' upper_index=',upper_index,
1361 & ' atom=',atom,' first_atom=',first_atom,
1362 & ' last_atom=',last_atom
1363 if (int_index.ge.lower_index) then
1365 if (at_start.eq.0) then
1367 jat_start=first_atom-1+lower_index-int_index_old
1369 jat_start=first_atom
1371 if (lprn) write (iout,*) 'jat_start',jat_start
1372 if (int_index.ge.upper_index) then
1374 jat_end=first_atom-1+upper_index-int_index_old
1379 if (lprn) write (iout,*) 'jat_end',jat_end
1384 c------------------------------------------------------------------------------
1385 subroutine hpb_partition
1386 implicit real*8 (a-h,o-z)
1387 include 'DIMENSIONS'
1391 include 'COMMON.SBRIDGE'
1392 include 'COMMON.IOUNITS'
1393 include 'COMMON.SETUP'
1394 include 'COMMON.CONTROL'
1396 call int_bounds(nhpb,link_start,link_end)
1398 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1399 & ' absolute rank',MyRank,
1400 & ' nhpb',nhpb,' link_start=',link_start,
1401 & ' link_end',link_end