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
203 v1(k,j,i,iblock)=0.0D0
204 v2(k,j,i,iblock)=0.0D0
214 v1c(1,l,i,j,k,iblock)=0.0D0
215 v1s(1,l,i,j,k,iblock)=0.0D0
216 v1c(2,l,i,j,k,iblock)=0.0D0
217 v1s(2,l,i,j,k,iblock)=0.0D0
221 v2c(m,l,i,j,k,iblock)=0.0D0
222 v2s(m,l,i,j,k,iblock)=0.0D0
233 C Initialize the bridge arrays
252 C Initialize variables used in minimization.
261 C Initialize the variables responsible for the mode of gradient storage.
266 C Initialize constants used to split the energy into long- and short-range
272 nprint_ene=nprint_ene-1
276 c-------------------------------------------------------------------------
278 implicit real*8 (a-h,o-z)
280 include 'COMMON.NAMES'
281 include 'COMMON.FFIELD'
283 &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
284 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
285 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
286 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
288 &'z','p','k','r','h','d','e','n','q','s','t','g',
289 &'a','y','w','v','l','i','f','m','c','x',
290 &'C','M','F','I','L','V','W','Y','A','G','T',
291 &'S','Q','N','E','D','H','R','K','P','X'/
292 data potname /'LJ','LJK','BP','GB','GBV'/
294 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
295 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
296 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
297 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
298 & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
300 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
301 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
302 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
303 & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
305 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
306 & 21,24,25,26,27,0,0,0/
308 c---------------------------------------------------------------------------
309 subroutine init_int_table
310 implicit real*8 (a-h,o-z)
314 integer blocklengths(15),displs(15)
316 include 'COMMON.CONTROL'
317 include 'COMMON.SETUP'
318 include 'COMMON.CHAIN'
319 include 'COMMON.INTERACT'
320 include 'COMMON.LOCAL'
321 include 'COMMON.SBRIDGE'
322 include 'COMMON.TORCNSTR'
323 include 'COMMON.IOUNITS'
324 include 'COMMON.DERIV'
325 include 'COMMON.CONTACTS'
326 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
327 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
328 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
329 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
330 & ielend_all(maxres,0:max_fg_procs-1),
331 & ntask_cont_from_all(0:max_fg_procs-1),
332 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
333 & ntask_cont_to_all(0:max_fg_procs-1),
334 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
335 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
336 logical scheck,lprint,flag
338 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
339 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
340 C... Determine the numbers of start and end SC-SC interaction
341 C... to deal with by current processor.
343 itask_cont_from(i)=fg_rank
344 itask_cont_to(i)=fg_rank
348 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
349 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
350 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
352 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
353 & ' absolute rank',MyRank,
354 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
355 & ' my_sc_inde',my_sc_inde
375 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
376 cd & (ihpb(i),jhpb(i),i=1,nss)
380 if (ihpb(ii).eq.i+nres) then
387 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
391 c write (iout,*) 'jj=i+1'
392 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
393 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
399 else if (jj.eq.nct) then
401 c write (iout,*) 'jj=nct'
402 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
403 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
411 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
412 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
414 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
415 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
426 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
427 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
432 ind_scint=ind_scint+nct-i
436 ind_scint_old=ind_scint
445 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
446 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
449 write (iout,'(a)') 'Interaction array:'
451 write (iout,'(i3,2(2x,2i3))')
452 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
457 C Now partition the electrostatic-interaction array
459 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
460 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
462 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
463 & ' absolute rank',MyRank,
464 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
465 & ' my_ele_inde',my_ele_inde
472 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
473 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
476 if (iatel_s.eq.0) iatel_s=1
477 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
478 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
479 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
480 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
481 c & " my_ele_inde_vdw",my_ele_inde_vdw
488 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
490 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
492 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
493 c & " ielend_vdw",ielend_vdw(i)
495 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
506 do i=iatel_s_vdw,iatel_e_vdw
512 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
513 & ' absolute rank',MyRank
514 write (iout,*) 'Electrostatic interaction array:'
516 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
521 C Partition the SC-p interaction array
523 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
524 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
525 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
526 & ' absolute rank',myrank,
527 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
528 & ' my_scp_inde',my_scp_inde
534 if (i.lt.nnt+iscp) then
535 cd write (iout,*) 'i.le.nnt+iscp'
536 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
537 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
539 else if (i.gt.nct-iscp) then
540 cd write (iout,*) 'i.gt.nct-iscp'
541 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
542 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
545 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
546 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
549 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
550 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
559 if (i.lt.nnt+iscp) then
561 iscpstart(i,1)=i+iscp
563 elseif (i.gt.nct-iscp) then
571 iscpstart(i,2)=i+iscp
577 write (iout,'(a)') 'SC-p interaction array:'
578 do i=iatscp_s,iatscp_e
579 write (iout,'(i3,2(2x,2i3))')
580 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
583 C Partition local interactions
585 call int_bounds(nres-2,loc_start,loc_end)
586 loc_start=loc_start+1
588 call int_bounds(nres-2,ithet_start,ithet_end)
589 ithet_start=ithet_start+2
590 ithet_end=ithet_end+2
591 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
592 iturn3_start=iturn3_start+nnt
593 iphi_start=iturn3_start+2
594 iturn3_end=iturn3_end+nnt
595 iphi_end=iturn3_end+2
596 iturn3_start=iturn3_start-1
597 iturn3_end=iturn3_end-1
598 call int_bounds(nres-3,iphi1_start,iphi1_end)
599 iphi1_start=iphi1_start+3
600 iphi1_end=iphi1_end+3
601 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
602 iturn4_start=iturn4_start+nnt
603 iphid_start=iturn4_start+2
604 iturn4_end=iturn4_end+nnt
605 iphid_end=iturn4_end+2
606 iturn4_start=iturn4_start-1
607 iturn4_end=iturn4_end-1
608 call int_bounds(nres-2,ibond_start,ibond_end)
609 ibond_start=ibond_start+1
610 ibond_end=ibond_end+1
611 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
612 ibondp_start=ibondp_start+nnt
613 ibondp_end=ibondp_end+nnt
614 call int_bounds1(nres-1,ivec_start,ivec_end)
615 print *,"Processor",myrank,fg_rank,fg_rank1,
616 & " ivec_start",ivec_start," ivec_end",ivec_end
617 iset_start=loc_start+2
619 if (ndih_constr.eq.0) then
623 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
625 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
627 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
628 igrad_start=((2*nlen+1)
629 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
630 jgrad_start(igrad_start)=
631 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
633 jgrad_end(igrad_start)=nres
634 igrad_end=((2*nlen+1)
635 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
636 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
637 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
639 do i=igrad_start+1,igrad_end-1
644 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
645 & ' absolute rank',myrank,
646 & ' loc_start',loc_start,' loc_end',loc_end,
647 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
648 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
649 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
650 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
651 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
652 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
653 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
654 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
655 & ' iset_start',iset_start,' iset_end',iset_end,
656 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
658 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
659 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
660 & ' ngrad_end',ngrad_end
661 do i=igrad_start,igrad_end
662 write(*,*) 'Processor:',fg_rank,myrank,i,
663 & jgrad_start(i),jgrad_end(i)
666 if (nfgtasks.gt.1) then
667 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
668 & MPI_INTEGER,FG_COMM1,IERROR)
669 iaux=ivec_end-ivec_start+1
670 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
671 & MPI_INTEGER,FG_COMM1,IERROR)
672 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
673 & MPI_INTEGER,FG_COMM,IERROR)
674 iaux=iset_end-iset_start+1
675 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
676 & MPI_INTEGER,FG_COMM,IERROR)
677 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
678 & MPI_INTEGER,FG_COMM,IERROR)
679 iaux=ibond_end-ibond_start+1
680 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
681 & MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
683 & MPI_INTEGER,FG_COMM,IERROR)
684 iaux=ithet_end-ithet_start+1
685 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
686 & MPI_INTEGER,FG_COMM,IERROR)
687 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
688 & MPI_INTEGER,FG_COMM,IERROR)
689 iaux=iphi_end-iphi_start+1
690 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
691 & MPI_INTEGER,FG_COMM,IERROR)
692 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
693 & MPI_INTEGER,FG_COMM,IERROR)
694 iaux=iphi1_end-iphi1_start+1
695 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
696 & MPI_INTEGER,FG_COMM,IERROR)
703 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
704 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
705 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
706 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
707 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
708 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
710 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
712 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
714 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
716 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
718 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
720 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
721 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
722 write (iout,*) "iturn3_start_all",
723 & (iturn3_start_all(i),i=0,nfgtasks-1)
724 write (iout,*) "iturn3_end_all",
725 & (iturn3_end_all(i),i=0,nfgtasks-1)
726 write (iout,*) "iturn4_start_all",
727 & (iturn4_start_all(i),i=0,nfgtasks-1)
728 write (iout,*) "iturn4_end_all",
729 & (iturn4_end_all(i),i=0,nfgtasks-1)
730 write (iout,*) "The ielstart_all array"
732 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
734 write (iout,*) "The ielend_all array"
736 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
742 itask_cont_from(0)=fg_rank
743 itask_cont_to(0)=fg_rank
745 do ii=iturn3_start,iturn3_end
746 call add_int(ii,ii+2,iturn3_sent(1,ii),
747 & ntask_cont_to,itask_cont_to,flag)
749 do ii=iturn4_start,iturn4_end
750 call add_int(ii,ii+3,iturn4_sent(1,ii),
751 & ntask_cont_to,itask_cont_to,flag)
753 do ii=iturn3_start,iturn3_end
754 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
756 do ii=iturn4_start,iturn4_end
757 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
760 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
761 & " ntask_cont_to",ntask_cont_to
762 write (iout,*) "itask_cont_from",
763 & (itask_cont_from(i),i=1,ntask_cont_from)
764 write (iout,*) "itask_cont_to",
765 & (itask_cont_to(i),i=1,ntask_cont_to)
768 c write (iout,*) "Loop forward"
771 c write (iout,*) "from loop i=",i
773 do j=ielstart(i),ielend(i)
774 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
777 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
778 c & " iatel_e",iatel_e
782 c write (iout,*) "i",i," ielstart",ielstart(i),
783 c & " ielend",ielend(i)
786 do j=ielstart(i),ielend(i)
787 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
788 & itask_cont_to,flag)
796 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
797 & " ntask_cont_to",ntask_cont_to
798 write (iout,*) "itask_cont_from",
799 & (itask_cont_from(i),i=1,ntask_cont_from)
800 write (iout,*) "itask_cont_to",
801 & (itask_cont_to(i),i=1,ntask_cont_to)
803 write (iout,*) "iint_sent"
806 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
807 & j=ielstart(ii),ielend(ii))
809 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
810 & " iturn3_end",iturn3_end
811 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
812 & i=iturn3_start,iturn3_end)
813 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
814 & " iturn4_end",iturn4_end
815 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
816 & i=iturn4_start,iturn4_end)
819 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
820 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
821 c write (iout,*) "Gather ntask_cont_from ended"
823 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
824 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
826 c write (iout,*) "Gather itask_cont_from ended"
828 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
829 & 1,MPI_INTEGER,king,FG_COMM,IERR)
830 c write (iout,*) "Gather ntask_cont_to ended"
832 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
833 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
834 c write (iout,*) "Gather itask_cont_to ended"
836 if (fg_rank.eq.king) then
837 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
839 write (iout,'(20i4)') i,ntask_cont_from_all(i),
840 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
844 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
846 write (iout,'(20i4)') i,ntask_cont_to_all(i),
847 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
851 C Check if every send will have a matching receive
855 ncheck_to=ncheck_to+ntask_cont_to_all(i)
856 ncheck_from=ncheck_from+ntask_cont_from_all(i)
858 write (iout,*) "Control sums",ncheck_from,ncheck_to
859 if (ncheck_from.ne.ncheck_to) then
860 write (iout,*) "Error: #receive differs from #send."
861 write (iout,*) "Terminating program...!"
867 do j=1,ntask_cont_to_all(i)
868 ii=itask_cont_to_all(j,i)
869 do k=1,ntask_cont_from_all(ii)
870 if (itask_cont_from_all(k,ii).eq.i) then
871 if(lprint)write(iout,*)"Matching send/receive",i,ii
875 if (k.eq.ntask_cont_from_all(ii)+1) then
877 write (iout,*) "Error: send by",j," to",ii,
878 & " would have no matching receive"
884 write (iout,*) "Unmatched sends; terminating program"
888 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
889 c write (iout,*) "flag broadcast ended flag=",flag
892 call MPI_Finalize(IERROR)
893 stop "Error in INIT_INT_TABLE: unmatched send/receive."
895 call MPI_Comm_group(FG_COMM,fg_group,IERR)
896 c write (iout,*) "MPI_Comm_group ended"
898 call MPI_Group_incl(fg_group,ntask_cont_from+1,
899 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
900 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
901 & CONT_TO_GROUP,IERR)
904 iaux=4*(ielend(ii)-ielstart(ii)+1)
905 call MPI_Group_translate_ranks(fg_group,iaux,
906 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
907 & iint_sent_local(1,ielstart(ii),i),IERR )
908 c write (iout,*) "Ranks translated i=",i
911 iaux=4*(iturn3_end-iturn3_start+1)
912 call MPI_Group_translate_ranks(fg_group,iaux,
913 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
914 & iturn3_sent_local(1,iturn3_start),IERR)
915 iaux=4*(iturn4_end-iturn4_start+1)
916 call MPI_Group_translate_ranks(fg_group,iaux,
917 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
918 & iturn4_sent_local(1,iturn4_start),IERR)
920 write (iout,*) "iint_sent_local"
923 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
924 & j=ielstart(ii),ielend(ii))
927 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
928 & " iturn3_end",iturn3_end
929 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
930 & i=iturn3_start,iturn3_end)
931 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
932 & " iturn4_end",iturn4_end
933 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
934 & i=iturn4_start,iturn4_end)
937 call MPI_Group_free(fg_group,ierr)
938 call MPI_Group_free(cont_from_group,ierr)
939 call MPI_Group_free(cont_to_group,ierr)
940 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
941 call MPI_Type_commit(MPI_UYZ,IERROR)
942 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
944 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
945 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
946 call MPI_Type_commit(MPI_MU,IERROR)
947 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
948 call MPI_Type_commit(MPI_MAT1,IERROR)
949 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
950 call MPI_Type_commit(MPI_MAT2,IERROR)
951 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
952 call MPI_Type_commit(MPI_THET,IERROR)
953 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
954 call MPI_Type_commit(MPI_GAM,IERROR)
956 c 9/22/08 Derived types to send matrices which appear in correlation terms
958 if (ivec_count(i).eq.ivec_count(0)) then
964 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
965 if (ind_typ.eq.0) then
975 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
978 c blocklengths(i)=blocklengths(i)*ichunk
980 c write (iout,*) "blocklengths and displs"
982 c write (iout,*) i,blocklengths(i),displs(i)
985 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
986 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
987 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
988 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
994 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
997 c blocklengths(i)=blocklengths(i)*ichunk
999 c write (iout,*) "blocklengths and displs"
1001 c write (iout,*) i,blocklengths(i),displs(i)
1004 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1005 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1006 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1007 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1013 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1016 blocklengths(i)=blocklengths(i)*ichunk
1018 call MPI_Type_indexed(8,blocklengths,displs,
1019 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1020 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1026 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1029 blocklengths(i)=blocklengths(i)*ichunk
1031 call MPI_Type_indexed(8,blocklengths,displs,
1032 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1033 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1039 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1042 blocklengths(i)=blocklengths(i)*ichunk
1044 call MPI_Type_indexed(6,blocklengths,displs,
1045 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1046 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1052 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1055 blocklengths(i)=blocklengths(i)*ichunk
1057 call MPI_Type_indexed(2,blocklengths,displs,
1058 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1059 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1065 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1068 blocklengths(i)=blocklengths(i)*ichunk
1070 call MPI_Type_indexed(4,blocklengths,displs,
1071 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1072 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1076 iint_start=ivec_start+1
1079 iint_count(i)=ivec_count(i)
1080 iint_displ(i)=ivec_displ(i)
1081 ivec_displ(i)=ivec_displ(i)-1
1082 iset_displ(i)=iset_displ(i)-1
1083 ithet_displ(i)=ithet_displ(i)-1
1084 iphi_displ(i)=iphi_displ(i)-1
1085 iphi1_displ(i)=iphi1_displ(i)-1
1086 ibond_displ(i)=ibond_displ(i)-1
1088 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1089 & .and. (me.eq.0 .or. out1file)) then
1090 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1092 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1095 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1096 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1097 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1099 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1102 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1103 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1104 & ' SC-p interactions','were distributed among',nfgtasks,
1105 & ' fine-grain processors.'
1121 idihconstr_end=ndih_constr
1122 iphid_start=iphi_start
1123 iphid_end=iphi_end-1
1138 c---------------------------------------------------------------------------
1139 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1141 include "DIMENSIONS"
1142 include "COMMON.INTERACT"
1143 include "COMMON.SETUP"
1144 include "COMMON.IOUNITS"
1145 integer ii,jj,itask(4),ntask_cont_to,
1146 & itask_cont_to(0:max_fg_procs-1)
1148 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1149 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1150 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1151 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1152 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1153 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1154 & ielend_all(maxres,0:max_fg_procs-1)
1155 integer iproc,isent,k,l
1156 c Determines whether to send interaction ii,jj to other processors; a given
1157 c interaction can be sent to at most 2 processors.
1158 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1159 c one processor, otherwise flag is unchanged from the input value.
1165 c write (iout,*) "ii",ii," jj",jj
1166 c Loop over processors to check if anybody could need interaction ii,jj
1167 do iproc=0,fg_rank-1
1168 c Check if the interaction matches any turn3 at iproc
1169 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1171 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1172 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1174 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1177 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1178 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1181 call add_task(iproc,ntask_cont_to,itask_cont_to)
1185 C Check if the interaction matches any turn4 at iproc
1186 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1188 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1189 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1191 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
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)
1202 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1203 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
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)
1214 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1215 & ielend_all(ii-1,iproc).ge.jj+1) then
1217 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1218 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1221 call add_task(iproc,ntask_cont_to,itask_cont_to)
1228 c---------------------------------------------------------------------------
1229 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1231 include "DIMENSIONS"
1232 include "COMMON.INTERACT"
1233 include "COMMON.SETUP"
1234 include "COMMON.IOUNITS"
1235 integer ii,jj,itask(2),ntask_cont_from,
1236 & itask_cont_from(0:max_fg_procs-1)
1238 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1239 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1240 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1241 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1242 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1243 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1244 & ielend_all(maxres,0:max_fg_procs-1)
1246 do iproc=fg_rank+1,nfgtasks-1
1247 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1249 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1250 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1252 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1253 call add_task(iproc,ntask_cont_from,itask_cont_from)
1256 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1258 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1259 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1261 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1262 call add_task(iproc,ntask_cont_from,itask_cont_from)
1265 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1266 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1268 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1269 & jj+1.le.ielend_all(ii+1,iproc)) then
1270 call add_task(iproc,ntask_cont_from,itask_cont_from)
1272 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1273 & jj-1.le.ielend_all(ii+1,iproc)) then
1274 call add_task(iproc,ntask_cont_from,itask_cont_from)
1277 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1279 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1280 & jj-1.le.ielend_all(ii-1,iproc)) then
1281 call add_task(iproc,ntask_cont_from,itask_cont_from)
1283 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1284 & jj+1.le.ielend_all(ii-1,iproc)) then
1285 call add_task(iproc,ntask_cont_from,itask_cont_from)
1292 c---------------------------------------------------------------------------
1293 subroutine add_task(iproc,ntask_cont,itask_cont)
1295 include "DIMENSIONS"
1296 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1299 if (itask_cont(ii).eq.iproc) return
1301 ntask_cont=ntask_cont+1
1302 itask_cont(ntask_cont)=iproc
1305 c---------------------------------------------------------------------------
1306 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1310 include 'COMMON.SETUP'
1311 integer total_ints,lower_bound,upper_bound
1312 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1313 nint=total_ints/nfgtasks
1317 nexcess=total_ints-nint*nfgtasks
1319 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1323 lower_bound=lower_bound+int4proc(i)
1325 upper_bound=lower_bound+int4proc(fg_rank)
1326 lower_bound=lower_bound+1
1329 c---------------------------------------------------------------------------
1330 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1331 implicit real*8 (a-h,o-z)
1332 include 'DIMENSIONS'
1334 include 'COMMON.SETUP'
1335 integer total_ints,lower_bound,upper_bound
1336 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1337 nint=total_ints/nfgtasks1
1341 nexcess=total_ints-nint*nfgtasks1
1343 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1347 lower_bound=lower_bound+int4proc(i)
1349 upper_bound=lower_bound+int4proc(fg_rank1)
1350 lower_bound=lower_bound+1
1353 c---------------------------------------------------------------------------
1354 subroutine int_partition(int_index,lower_index,upper_index,atom,
1355 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1356 implicit real*8 (a-h,o-z)
1357 include 'DIMENSIONS'
1358 include 'COMMON.IOUNITS'
1359 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1360 & first_atom,last_atom,int_gr,jat_start,jat_end
1363 if (lprn) write (iout,*) 'int_index=',int_index
1364 int_index_old=int_index
1365 int_index=int_index+last_atom-first_atom+1
1367 & write (iout,*) 'int_index=',int_index,
1368 & ' int_index_old',int_index_old,
1369 & ' lower_index=',lower_index,
1370 & ' upper_index=',upper_index,
1371 & ' atom=',atom,' first_atom=',first_atom,
1372 & ' last_atom=',last_atom
1373 if (int_index.ge.lower_index) then
1375 if (at_start.eq.0) then
1377 jat_start=first_atom-1+lower_index-int_index_old
1379 jat_start=first_atom
1381 if (lprn) write (iout,*) 'jat_start',jat_start
1382 if (int_index.ge.upper_index) then
1384 jat_end=first_atom-1+upper_index-int_index_old
1389 if (lprn) write (iout,*) 'jat_end',jat_end
1394 c------------------------------------------------------------------------------
1395 subroutine hpb_partition
1396 implicit real*8 (a-h,o-z)
1397 include 'DIMENSIONS'
1401 include 'COMMON.SBRIDGE'
1402 include 'COMMON.IOUNITS'
1403 include 'COMMON.SETUP'
1404 include 'COMMON.CONTROL'
1406 call int_bounds(nhpb,link_start,link_end)
1408 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1409 & ' absolute rank',MyRank,
1410 & ' nhpb',nhpb,' link_start=',link_start,
1411 & ' link_end',link_end