2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
123 C Set default weights of the energy terms.
134 c print '(a,$)','Inside initialize'
135 c call memmon_print_usage()
168 athet(j,i,ichir1,ichir2)=0.0D0
169 bthet(j,i,ichir1,ichir2)=0.0D0
189 gaussc(l,k,j,i)=0.0D0
199 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
203 v1(k,j,i,iblock)=0.0D0
204 v2(k,j,i,iblock)=0.0D0
214 v1c(1,l,i,j,k,iblock)=0.0D0
215 v1s(1,l,i,j,k,iblock)=0.0D0
216 v1c(2,l,i,j,k,iblock)=0.0D0
217 v1s(2,l,i,j,k,iblock)=0.0D0
221 v2c(m,l,i,j,k,iblock)=0.0D0
222 v2s(m,l,i,j,k,iblock)=0.0D0
234 C Initialize the bridge arrays
253 C Initialize variables used in minimization.
262 C Initialize the variables responsible for the mode of gradient storage.
267 C Initialize constants used to split the energy into long- and short-range
273 nprint_ene=nprint_ene-1
277 c-------------------------------------------------------------------------
279 implicit real*8 (a-h,o-z)
281 include 'COMMON.NAMES'
282 include 'COMMON.FFIELD'
284 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
285 & 'DSG','DGN','DSN','DTH',
286 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
287 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
288 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
291 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
292 &'a','y','w','v','l','i','f','m','c','x',
293 &'C','M','F','I','L','V','W','Y','A','G','T',
294 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
295 data potname /'LJ','LJK','BP','GB','GBV'/
297 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
298 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
299 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
300 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
302 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
303 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
304 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
306 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
309 c---------------------------------------------------------------------------
310 subroutine init_int_table
311 implicit real*8 (a-h,o-z)
315 integer blocklengths(15),displs(15)
317 include 'COMMON.CONTROL'
318 include 'COMMON.SETUP'
319 include 'COMMON.CHAIN'
320 include 'COMMON.INTERACT'
321 include 'COMMON.LOCAL'
322 include 'COMMON.SBRIDGE'
323 include 'COMMON.TORCNSTR'
324 include 'COMMON.IOUNITS'
325 include 'COMMON.DERIV'
326 include 'COMMON.CONTACTS'
327 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
328 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
329 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
330 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
331 & ielend_all(maxres,0:max_fg_procs-1),
332 & ntask_cont_from_all(0:max_fg_procs-1),
333 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
334 & ntask_cont_to_all(0:max_fg_procs-1),
335 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
336 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
337 logical scheck,lprint,flag
339 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
340 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
341 C... Determine the numbers of start and end SC-SC interaction
342 C... to deal with by current processor.
344 itask_cont_from(i)=fg_rank
345 itask_cont_to(i)=fg_rank
349 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
350 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
351 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
353 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
354 & ' absolute rank',MyRank,
355 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
356 & ' my_sc_inde',my_sc_inde
376 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
377 cd & (ihpb(i),jhpb(i),i=1,nss)
382 if (ihpb(ii).eq.i+nres) then
389 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
393 c write (iout,*) 'jj=i+1'
394 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
395 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
401 else if (jj.eq.nct) then
403 c write (iout,*) 'jj=nct'
404 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
405 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
413 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
414 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
416 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
417 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
428 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
429 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
434 ind_scint=ind_scint+nct-i
438 ind_scint_old=ind_scint
446 if (iatsc_s.eq.0) iatsc_s=1
448 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
449 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
452 write (iout,'(a)') 'Interaction array:'
454 write (iout,'(i3,2(2x,2i3))')
455 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
460 C Now partition the electrostatic-interaction array
462 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
463 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
465 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
466 & ' absolute rank',MyRank,
467 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
468 & ' my_ele_inde',my_ele_inde
475 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
476 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
479 if (iatel_s.eq.0) iatel_s=1
480 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
481 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
482 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
483 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
484 c & " my_ele_inde_vdw",my_ele_inde_vdw
491 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
493 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
495 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
496 c & " ielend_vdw",ielend_vdw(i)
498 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
509 do i=iatel_s_vdw,iatel_e_vdw
515 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
516 & ' absolute rank',MyRank
517 write (iout,*) 'Electrostatic interaction array:'
519 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
524 C Partition the SC-p interaction array
526 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
527 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
528 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
529 & ' absolute rank',myrank,
530 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
531 & ' my_scp_inde',my_scp_inde
537 if (i.lt.nnt+iscp) then
538 cd write (iout,*) 'i.le.nnt+iscp'
539 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
540 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
542 else if (i.gt.nct-iscp) then
543 cd write (iout,*) 'i.gt.nct-iscp'
544 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
545 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
548 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
549 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
552 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
553 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
562 if (i.lt.nnt+iscp) then
564 iscpstart(i,1)=i+iscp
566 elseif (i.gt.nct-iscp) then
574 iscpstart(i,2)=i+iscp
579 if (iatscp_s.eq.0) iatscp_s=1
581 write (iout,'(a)') 'SC-p interaction array:'
582 do i=iatscp_s,iatscp_e
583 write (iout,'(i3,2(2x,2i3))')
584 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
587 C Partition local interactions
589 call int_bounds(nres-2,loc_start,loc_end)
590 loc_start=loc_start+1
592 call int_bounds(nres-2,ithet_start,ithet_end)
593 ithet_start=ithet_start+2
594 ithet_end=ithet_end+2
595 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
596 iturn3_start=iturn3_start+nnt
597 iphi_start=iturn3_start+2
598 iturn3_end=iturn3_end+nnt
599 iphi_end=iturn3_end+2
600 iturn3_start=iturn3_start-1
601 iturn3_end=iturn3_end-1
602 call int_bounds(nres-3,itau_start,itau_end)
603 itau_start=itau_start+3
605 call int_bounds(nres-3,iphi1_start,iphi1_end)
606 iphi1_start=iphi1_start+3
607 iphi1_end=iphi1_end+3
608 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
609 iturn4_start=iturn4_start+nnt
610 iphid_start=iturn4_start+2
611 iturn4_end=iturn4_end+nnt
612 iphid_end=iturn4_end+2
613 iturn4_start=iturn4_start-1
614 iturn4_end=iturn4_end-1
615 call int_bounds(nres-2,ibond_start,ibond_end)
616 ibond_start=ibond_start+1
617 ibond_end=ibond_end+1
618 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
619 ibondp_start=ibondp_start+nnt
620 ibondp_end=ibondp_end+nnt
621 call int_bounds1(nres-1,ivec_start,ivec_end)
622 c print *,"Processor",myrank,fg_rank,fg_rank1,
623 c & " ivec_start",ivec_start," ivec_end",ivec_end
624 iset_start=loc_start+2
626 if (ndih_constr.eq.0) then
630 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
632 if (ntheta_constr.eq.0) then
637 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
639 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
641 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
643 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
644 igrad_start=((2*nlen+1)
645 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
646 jgrad_start(igrad_start)=
647 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
649 jgrad_end(igrad_start)=nres
650 igrad_end=((2*nlen+1)
651 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
652 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
653 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
655 do i=igrad_start+1,igrad_end-1
660 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
661 & ' absolute rank',myrank,
662 & ' loc_start',loc_start,' loc_end',loc_end,
663 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
664 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
665 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
666 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
667 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
668 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
669 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
670 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
671 & ' iset_start',iset_start,' iset_end',iset_end,
672 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
674 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
677 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
678 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
679 & ' ngrad_end',ngrad_end
680 do i=igrad_start,igrad_end
681 write(*,*) 'Processor:',fg_rank,myrank,i,
682 & jgrad_start(i),jgrad_end(i)
685 if (nfgtasks.gt.1) then
686 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
687 & MPI_INTEGER,FG_COMM1,IERROR)
688 iaux=ivec_end-ivec_start+1
689 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
690 & MPI_INTEGER,FG_COMM1,IERROR)
691 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 iaux=iset_end-iset_start+1
694 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
696 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
697 & MPI_INTEGER,FG_COMM,IERROR)
698 iaux=ibond_end-ibond_start+1
699 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
700 & MPI_INTEGER,FG_COMM,IERROR)
701 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
702 & MPI_INTEGER,FG_COMM,IERROR)
703 iaux=ithet_end-ithet_start+1
704 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
705 & MPI_INTEGER,FG_COMM,IERROR)
706 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
707 & MPI_INTEGER,FG_COMM,IERROR)
708 iaux=iphi_end-iphi_start+1
709 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
710 & MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
712 & MPI_INTEGER,FG_COMM,IERROR)
713 iaux=iphi1_end-iphi1_start+1
714 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
715 & MPI_INTEGER,FG_COMM,IERROR)
722 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
723 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
724 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
725 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
726 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
727 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
728 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
729 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
730 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
731 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
732 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
733 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
734 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
735 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
736 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
737 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
739 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
740 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
741 write (iout,*) "iturn3_start_all",
742 & (iturn3_start_all(i),i=0,nfgtasks-1)
743 write (iout,*) "iturn3_end_all",
744 & (iturn3_end_all(i),i=0,nfgtasks-1)
745 write (iout,*) "iturn4_start_all",
746 & (iturn4_start_all(i),i=0,nfgtasks-1)
747 write (iout,*) "iturn4_end_all",
748 & (iturn4_end_all(i),i=0,nfgtasks-1)
749 write (iout,*) "The ielstart_all array"
751 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
753 write (iout,*) "The ielend_all array"
755 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
761 itask_cont_from(0)=fg_rank
762 itask_cont_to(0)=fg_rank
764 do ii=iturn3_start,iturn3_end
765 call add_int(ii,ii+2,iturn3_sent(1,ii),
766 & ntask_cont_to,itask_cont_to,flag)
768 do ii=iturn4_start,iturn4_end
769 call add_int(ii,ii+3,iturn4_sent(1,ii),
770 & ntask_cont_to,itask_cont_to,flag)
772 do ii=iturn3_start,iturn3_end
773 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
775 do ii=iturn4_start,iturn4_end
776 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
779 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
780 & " ntask_cont_to",ntask_cont_to
781 write (iout,*) "itask_cont_from",
782 & (itask_cont_from(i),i=1,ntask_cont_from)
783 write (iout,*) "itask_cont_to",
784 & (itask_cont_to(i),i=1,ntask_cont_to)
787 c write (iout,*) "Loop forward"
790 c write (iout,*) "from loop i=",i
792 do j=ielstart(i),ielend(i)
793 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
796 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
797 c & " iatel_e",iatel_e
801 c write (iout,*) "i",i," ielstart",ielstart(i),
802 c & " ielend",ielend(i)
805 do j=ielstart(i),ielend(i)
806 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
807 & itask_cont_to,flag)
815 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
816 & " ntask_cont_to",ntask_cont_to
817 write (iout,*) "itask_cont_from",
818 & (itask_cont_from(i),i=1,ntask_cont_from)
819 write (iout,*) "itask_cont_to",
820 & (itask_cont_to(i),i=1,ntask_cont_to)
822 write (iout,*) "iint_sent"
825 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
826 & j=ielstart(ii),ielend(ii))
828 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
829 & " iturn3_end",iturn3_end
830 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
831 & i=iturn3_start,iturn3_end)
832 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
833 & " iturn4_end",iturn4_end
834 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
835 & i=iturn4_start,iturn4_end)
838 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
839 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
840 c write (iout,*) "Gather ntask_cont_from ended"
842 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
843 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
845 c write (iout,*) "Gather itask_cont_from ended"
847 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
848 & 1,MPI_INTEGER,king,FG_COMM,IERR)
849 c write (iout,*) "Gather ntask_cont_to ended"
851 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
852 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
853 c write (iout,*) "Gather itask_cont_to ended"
855 if (fg_rank.eq.king) then
856 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
858 write (iout,'(20i4)') i,ntask_cont_from_all(i),
859 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
863 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
865 write (iout,'(20i4)') i,ntask_cont_to_all(i),
866 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
870 C Check if every send will have a matching receive
874 ncheck_to=ncheck_to+ntask_cont_to_all(i)
875 ncheck_from=ncheck_from+ntask_cont_from_all(i)
877 write (iout,*) "Control sums",ncheck_from,ncheck_to
878 if (ncheck_from.ne.ncheck_to) then
879 write (iout,*) "Error: #receive differs from #send."
880 write (iout,*) "Terminating program...!"
886 do j=1,ntask_cont_to_all(i)
887 ii=itask_cont_to_all(j,i)
888 do k=1,ntask_cont_from_all(ii)
889 if (itask_cont_from_all(k,ii).eq.i) then
890 if(lprint)write(iout,*)"Matching send/receive",i,ii
894 if (k.eq.ntask_cont_from_all(ii)+1) then
896 write (iout,*) "Error: send by",j," to",ii,
897 & " would have no matching receive"
903 write (iout,*) "Unmatched sends; terminating program"
907 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
908 c write (iout,*) "flag broadcast ended flag=",flag
911 call MPI_Finalize(IERROR)
912 stop "Error in INIT_INT_TABLE: unmatched send/receive."
914 call MPI_Comm_group(FG_COMM,fg_group,IERR)
915 c write (iout,*) "MPI_Comm_group ended"
917 call MPI_Group_incl(fg_group,ntask_cont_from+1,
918 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
919 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
920 & CONT_TO_GROUP,IERR)
923 iaux=4*(ielend(ii)-ielstart(ii)+1)
924 call MPI_Group_translate_ranks(fg_group,iaux,
925 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
926 & iint_sent_local(1,ielstart(ii),i),IERR )
927 c write (iout,*) "Ranks translated i=",i
930 iaux=4*(iturn3_end-iturn3_start+1)
931 call MPI_Group_translate_ranks(fg_group,iaux,
932 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
933 & iturn3_sent_local(1,iturn3_start),IERR)
934 iaux=4*(iturn4_end-iturn4_start+1)
935 call MPI_Group_translate_ranks(fg_group,iaux,
936 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
937 & iturn4_sent_local(1,iturn4_start),IERR)
939 write (iout,*) "iint_sent_local"
942 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
943 & j=ielstart(ii),ielend(ii))
946 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
947 & " iturn3_end",iturn3_end
948 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
949 & i=iturn3_start,iturn3_end)
950 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
951 & " iturn4_end",iturn4_end
952 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
953 & i=iturn4_start,iturn4_end)
956 call MPI_Group_free(fg_group,ierr)
957 call MPI_Group_free(cont_from_group,ierr)
958 call MPI_Group_free(cont_to_group,ierr)
959 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
960 call MPI_Type_commit(MPI_UYZ,IERROR)
961 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
963 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
964 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
965 call MPI_Type_commit(MPI_MU,IERROR)
966 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
967 call MPI_Type_commit(MPI_MAT1,IERROR)
968 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
969 call MPI_Type_commit(MPI_MAT2,IERROR)
970 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
971 call MPI_Type_commit(MPI_THET,IERROR)
972 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
973 call MPI_Type_commit(MPI_GAM,IERROR)
975 c 9/22/08 Derived types to send matrices which appear in correlation terms
977 if (ivec_count(i).eq.ivec_count(0)) then
983 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
984 if (ind_typ.eq.0) then
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_ROTAT1(ind_typ),IERROR)
1006 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1007 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1013 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1016 c blocklengths(i)=blocklengths(i)*ichunk
1018 c write (iout,*) "blocklengths and displs"
1020 c write (iout,*) i,blocklengths(i),displs(i)
1023 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1024 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1025 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1026 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1032 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1035 blocklengths(i)=blocklengths(i)*ichunk
1037 call MPI_Type_indexed(8,blocklengths,displs,
1038 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1039 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1045 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1048 blocklengths(i)=blocklengths(i)*ichunk
1050 call MPI_Type_indexed(8,blocklengths,displs,
1051 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1052 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1058 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1061 blocklengths(i)=blocklengths(i)*ichunk
1063 call MPI_Type_indexed(6,blocklengths,displs,
1064 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1065 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1071 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1074 blocklengths(i)=blocklengths(i)*ichunk
1076 call MPI_Type_indexed(2,blocklengths,displs,
1077 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1078 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1084 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1087 blocklengths(i)=blocklengths(i)*ichunk
1089 call MPI_Type_indexed(4,blocklengths,displs,
1090 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1091 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1095 iint_start=ivec_start+1
1098 iint_count(i)=ivec_count(i)
1099 iint_displ(i)=ivec_displ(i)
1100 ivec_displ(i)=ivec_displ(i)-1
1101 iset_displ(i)=iset_displ(i)-1
1102 ithet_displ(i)=ithet_displ(i)-1
1103 iphi_displ(i)=iphi_displ(i)-1
1104 iphi1_displ(i)=iphi1_displ(i)-1
1105 ibond_displ(i)=ibond_displ(i)-1
1107 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1108 & .and. (me.eq.0 .or. .not. out1file)) then
1109 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1111 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1114 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1115 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1116 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1118 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1121 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1122 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1123 & ' SC-p interactions','were distributed among',nfgtasks,
1124 & ' fine-grain processors.'
1140 idihconstr_end=ndih_constr
1141 ithetaconstr_start=1
1142 ithetaconstr_end=ntheta_constr
1143 iphid_start=iphi_start
1144 iphid_end=iphi_end-1
1161 c---------------------------------------------------------------------------
1162 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1164 include "DIMENSIONS"
1165 include "COMMON.INTERACT"
1166 include "COMMON.SETUP"
1167 include "COMMON.IOUNITS"
1168 integer ii,jj,itask(4),ntask_cont_to,
1169 &itask_cont_to(0:max_fg_procs-1)
1171 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1172 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1173 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1174 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1175 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1176 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1177 & ielend_all(maxres,0:max_fg_procs-1)
1178 integer iproc,isent,k,l
1179 c Determines whether to send interaction ii,jj to other processors; a given
1180 c interaction can be sent to at most 2 processors.
1181 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1182 c one processor, otherwise flag is unchanged from the input value.
1188 c write (iout,*) "ii",ii," jj",jj
1189 c Loop over processors to check if anybody could need interaction ii,jj
1190 do iproc=0,fg_rank-1
1191 c Check if the interaction matches any turn3 at iproc
1192 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1194 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1195 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1197 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1200 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1201 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1204 call add_task(iproc,ntask_cont_to,itask_cont_to)
1208 C Check if the interaction matches any turn4 at iproc
1209 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1211 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1212 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1214 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
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)
1225 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1226 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1227 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1228 & ielend_all(ii-1,iproc).ge.jj-1) then
1230 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1231 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1234 call add_task(iproc,ntask_cont_to,itask_cont_to)
1237 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1238 & ielend_all(ii-1,iproc).ge.jj+1) then
1240 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1241 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1244 call add_task(iproc,ntask_cont_to,itask_cont_to)
1251 c---------------------------------------------------------------------------
1252 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1254 include "DIMENSIONS"
1255 include "COMMON.INTERACT"
1256 include "COMMON.SETUP"
1257 include "COMMON.IOUNITS"
1258 integer ii,jj,itask(2),ntask_cont_from,
1259 & itask_cont_from(0:max_fg_procs-1)
1261 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1262 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1263 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1264 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1265 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1266 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1267 & ielend_all(maxres,0:max_fg_procs-1)
1269 do iproc=fg_rank+1,nfgtasks-1
1270 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1272 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1273 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1275 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1276 call add_task(iproc,ntask_cont_from,itask_cont_from)
1279 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1281 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1282 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1284 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1285 call add_task(iproc,ntask_cont_from,itask_cont_from)
1288 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1289 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1291 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1292 & jj+1.le.ielend_all(ii+1,iproc)) then
1293 call add_task(iproc,ntask_cont_from,itask_cont_from)
1295 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1296 & jj-1.le.ielend_all(ii+1,iproc)) then
1297 call add_task(iproc,ntask_cont_from,itask_cont_from)
1300 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1302 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1303 & jj-1.le.ielend_all(ii-1,iproc)) then
1304 call add_task(iproc,ntask_cont_from,itask_cont_from)
1306 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1307 & jj+1.le.ielend_all(ii-1,iproc)) then
1308 call add_task(iproc,ntask_cont_from,itask_cont_from)
1315 c---------------------------------------------------------------------------
1316 subroutine add_task(iproc,ntask_cont,itask_cont)
1318 include "DIMENSIONS"
1319 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1322 if (itask_cont(ii).eq.iproc) return
1324 ntask_cont=ntask_cont+1
1325 itask_cont(ntask_cont)=iproc
1328 c---------------------------------------------------------------------------
1329 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1330 implicit real*8 (a-h,o-z)
1331 include 'DIMENSIONS'
1333 include 'COMMON.SETUP'
1334 integer total_ints,lower_bound,upper_bound
1335 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1336 nint=total_ints/nfgtasks
1340 nexcess=total_ints-nint*nfgtasks
1342 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1346 lower_bound=lower_bound+int4proc(i)
1348 upper_bound=lower_bound+int4proc(fg_rank)
1349 lower_bound=lower_bound+1
1352 c---------------------------------------------------------------------------
1353 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1354 implicit real*8 (a-h,o-z)
1355 include 'DIMENSIONS'
1357 include 'COMMON.SETUP'
1358 integer total_ints,lower_bound,upper_bound
1359 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1360 nint=total_ints/nfgtasks1
1364 nexcess=total_ints-nint*nfgtasks1
1366 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1370 lower_bound=lower_bound+int4proc(i)
1372 upper_bound=lower_bound+int4proc(fg_rank1)
1373 lower_bound=lower_bound+1
1376 c---------------------------------------------------------------------------
1377 subroutine int_partition(int_index,lower_index,upper_index,atom,
1378 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1379 implicit real*8 (a-h,o-z)
1380 include 'DIMENSIONS'
1381 include 'COMMON.IOUNITS'
1382 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1383 & first_atom,last_atom,int_gr,jat_start,jat_end
1386 if (lprn) write (iout,*) 'int_index=',int_index
1387 int_index_old=int_index
1388 int_index=int_index+last_atom-first_atom+1
1390 & write (iout,*) 'int_index=',int_index,
1391 & ' int_index_old',int_index_old,
1392 & ' lower_index=',lower_index,
1393 & ' upper_index=',upper_index,
1394 & ' atom=',atom,' first_atom=',first_atom,
1395 & ' last_atom=',last_atom
1396 if (int_index.ge.lower_index) then
1398 if (at_start.eq.0) then
1400 jat_start=first_atom-1+lower_index-int_index_old
1402 jat_start=first_atom
1404 if (lprn) write (iout,*) 'jat_start',jat_start
1405 if (int_index.ge.upper_index) then
1407 jat_end=first_atom-1+upper_index-int_index_old
1412 if (lprn) write (iout,*) 'jat_end',jat_end
1417 c------------------------------------------------------------------------------
1418 subroutine hpb_partition
1419 implicit real*8 (a-h,o-z)
1420 include 'DIMENSIONS'
1424 include 'COMMON.SBRIDGE'
1425 include 'COMMON.IOUNITS'
1426 include 'COMMON.SETUP'
1428 call int_bounds(nhpb,link_start,link_end)
1429 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1430 & ' absolute rank',MyRank,
1431 & ' nhpb',nhpb,' link_start=',link_start,
1432 & ' link_end',link_end