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 print *,ntheta_constr,ithetaconstr_start,ithetaconstr_end
640 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
642 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
644 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
645 igrad_start=((2*nlen+1)
646 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
647 jgrad_start(igrad_start)=
648 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
650 jgrad_end(igrad_start)=nres
651 igrad_end=((2*nlen+1)
652 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
653 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
654 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
656 do i=igrad_start+1,igrad_end-1
661 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
662 & ' absolute rank',myrank,
663 & ' loc_start',loc_start,' loc_end',loc_end,
664 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
665 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
666 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
667 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
668 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
669 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
670 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
671 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
672 & ' iset_start',iset_start,' iset_end',iset_end,
673 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
675 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
678 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
679 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
680 & ' ngrad_end',ngrad_end
681 do i=igrad_start,igrad_end
682 write(*,*) 'Processor:',fg_rank,myrank,i,
683 & jgrad_start(i),jgrad_end(i)
686 if (nfgtasks.gt.1) then
687 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
688 & MPI_INTEGER,FG_COMM1,IERROR)
689 iaux=ivec_end-ivec_start+1
690 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
691 & MPI_INTEGER,FG_COMM1,IERROR)
692 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
693 & MPI_INTEGER,FG_COMM,IERROR)
694 iaux=iset_end-iset_start+1
695 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
696 & MPI_INTEGER,FG_COMM,IERROR)
697 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
698 & MPI_INTEGER,FG_COMM,IERROR)
699 iaux=ibond_end-ibond_start+1
700 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
701 & MPI_INTEGER,FG_COMM,IERROR)
702 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
703 & MPI_INTEGER,FG_COMM,IERROR)
704 iaux=ithet_end-ithet_start+1
705 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
706 & MPI_INTEGER,FG_COMM,IERROR)
707 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
708 & MPI_INTEGER,FG_COMM,IERROR)
709 iaux=iphi_end-iphi_start+1
710 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
711 & MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
713 & MPI_INTEGER,FG_COMM,IERROR)
714 iaux=iphi1_end-iphi1_start+1
715 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
716 & MPI_INTEGER,FG_COMM,IERROR)
723 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
724 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
725 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
726 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
727 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
728 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
729 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
730 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
731 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
732 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
733 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
734 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
735 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
736 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
737 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
738 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
740 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
741 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
742 write (iout,*) "iturn3_start_all",
743 & (iturn3_start_all(i),i=0,nfgtasks-1)
744 write (iout,*) "iturn3_end_all",
745 & (iturn3_end_all(i),i=0,nfgtasks-1)
746 write (iout,*) "iturn4_start_all",
747 & (iturn4_start_all(i),i=0,nfgtasks-1)
748 write (iout,*) "iturn4_end_all",
749 & (iturn4_end_all(i),i=0,nfgtasks-1)
750 write (iout,*) "The ielstart_all array"
752 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
754 write (iout,*) "The ielend_all array"
756 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
762 itask_cont_from(0)=fg_rank
763 itask_cont_to(0)=fg_rank
765 do ii=iturn3_start,iturn3_end
766 call add_int(ii,ii+2,iturn3_sent(1,ii),
767 & ntask_cont_to,itask_cont_to,flag)
769 do ii=iturn4_start,iturn4_end
770 call add_int(ii,ii+3,iturn4_sent(1,ii),
771 & ntask_cont_to,itask_cont_to,flag)
773 do ii=iturn3_start,iturn3_end
774 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
776 do ii=iturn4_start,iturn4_end
777 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
780 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
781 & " ntask_cont_to",ntask_cont_to
782 write (iout,*) "itask_cont_from",
783 & (itask_cont_from(i),i=1,ntask_cont_from)
784 write (iout,*) "itask_cont_to",
785 & (itask_cont_to(i),i=1,ntask_cont_to)
788 c write (iout,*) "Loop forward"
791 c write (iout,*) "from loop i=",i
793 do j=ielstart(i),ielend(i)
794 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
797 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
798 c & " iatel_e",iatel_e
802 c write (iout,*) "i",i," ielstart",ielstart(i),
803 c & " ielend",ielend(i)
806 do j=ielstart(i),ielend(i)
807 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
808 & itask_cont_to,flag)
816 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
817 & " ntask_cont_to",ntask_cont_to
818 write (iout,*) "itask_cont_from",
819 & (itask_cont_from(i),i=1,ntask_cont_from)
820 write (iout,*) "itask_cont_to",
821 & (itask_cont_to(i),i=1,ntask_cont_to)
823 write (iout,*) "iint_sent"
826 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
827 & j=ielstart(ii),ielend(ii))
829 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
830 & " iturn3_end",iturn3_end
831 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
832 & i=iturn3_start,iturn3_end)
833 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
834 & " iturn4_end",iturn4_end
835 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
836 & i=iturn4_start,iturn4_end)
839 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
840 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
841 c write (iout,*) "Gather ntask_cont_from ended"
843 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
844 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
846 c write (iout,*) "Gather itask_cont_from ended"
848 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
849 & 1,MPI_INTEGER,king,FG_COMM,IERR)
850 c write (iout,*) "Gather ntask_cont_to ended"
852 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
853 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
854 c write (iout,*) "Gather itask_cont_to ended"
856 if (fg_rank.eq.king) then
857 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
859 write (iout,'(20i4)') i,ntask_cont_from_all(i),
860 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
864 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
866 write (iout,'(20i4)') i,ntask_cont_to_all(i),
867 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
871 C Check if every send will have a matching receive
875 ncheck_to=ncheck_to+ntask_cont_to_all(i)
876 ncheck_from=ncheck_from+ntask_cont_from_all(i)
878 write (iout,*) "Control sums",ncheck_from,ncheck_to
879 if (ncheck_from.ne.ncheck_to) then
880 write (iout,*) "Error: #receive differs from #send."
881 write (iout,*) "Terminating program...!"
887 do j=1,ntask_cont_to_all(i)
888 ii=itask_cont_to_all(j,i)
889 do k=1,ntask_cont_from_all(ii)
890 if (itask_cont_from_all(k,ii).eq.i) then
891 if(lprint)write(iout,*)"Matching send/receive",i,ii
895 if (k.eq.ntask_cont_from_all(ii)+1) then
897 write (iout,*) "Error: send by",j," to",ii,
898 & " would have no matching receive"
904 write (iout,*) "Unmatched sends; terminating program"
908 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
909 c write (iout,*) "flag broadcast ended flag=",flag
912 call MPI_Finalize(IERROR)
913 stop "Error in INIT_INT_TABLE: unmatched send/receive."
915 call MPI_Comm_group(FG_COMM,fg_group,IERR)
916 c write (iout,*) "MPI_Comm_group ended"
918 call MPI_Group_incl(fg_group,ntask_cont_from+1,
919 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
920 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
921 & CONT_TO_GROUP,IERR)
924 iaux=4*(ielend(ii)-ielstart(ii)+1)
925 call MPI_Group_translate_ranks(fg_group,iaux,
926 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
927 & iint_sent_local(1,ielstart(ii),i),IERR )
928 c write (iout,*) "Ranks translated i=",i
931 iaux=4*(iturn3_end-iturn3_start+1)
932 call MPI_Group_translate_ranks(fg_group,iaux,
933 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
934 & iturn3_sent_local(1,iturn3_start),IERR)
935 iaux=4*(iturn4_end-iturn4_start+1)
936 call MPI_Group_translate_ranks(fg_group,iaux,
937 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
938 & iturn4_sent_local(1,iturn4_start),IERR)
940 write (iout,*) "iint_sent_local"
943 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
944 & j=ielstart(ii),ielend(ii))
947 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
948 & " iturn3_end",iturn3_end
949 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
950 & i=iturn3_start,iturn3_end)
951 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
952 & " iturn4_end",iturn4_end
953 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
954 & i=iturn4_start,iturn4_end)
957 call MPI_Group_free(fg_group,ierr)
958 call MPI_Group_free(cont_from_group,ierr)
959 call MPI_Group_free(cont_to_group,ierr)
960 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
961 call MPI_Type_commit(MPI_UYZ,IERROR)
962 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
964 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
965 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
966 call MPI_Type_commit(MPI_MU,IERROR)
967 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
968 call MPI_Type_commit(MPI_MAT1,IERROR)
969 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
970 call MPI_Type_commit(MPI_MAT2,IERROR)
971 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
972 call MPI_Type_commit(MPI_THET,IERROR)
973 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
974 call MPI_Type_commit(MPI_GAM,IERROR)
976 c 9/22/08 Derived types to send matrices which appear in correlation terms
978 if (ivec_count(i).eq.ivec_count(0)) then
984 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
985 if (ind_typ.eq.0) then
995 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
998 c blocklengths(i)=blocklengths(i)*ichunk
1000 c write (iout,*) "blocklengths and displs"
1002 c write (iout,*) i,blocklengths(i),displs(i)
1005 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1006 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1007 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1008 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1014 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1017 c blocklengths(i)=blocklengths(i)*ichunk
1019 c write (iout,*) "blocklengths and displs"
1021 c write (iout,*) i,blocklengths(i),displs(i)
1024 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1025 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1026 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1027 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1033 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1036 blocklengths(i)=blocklengths(i)*ichunk
1038 call MPI_Type_indexed(8,blocklengths,displs,
1039 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1040 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1046 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1049 blocklengths(i)=blocklengths(i)*ichunk
1051 call MPI_Type_indexed(8,blocklengths,displs,
1052 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1053 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1059 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1062 blocklengths(i)=blocklengths(i)*ichunk
1064 call MPI_Type_indexed(6,blocklengths,displs,
1065 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1066 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1072 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1075 blocklengths(i)=blocklengths(i)*ichunk
1077 call MPI_Type_indexed(2,blocklengths,displs,
1078 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1079 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1085 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1088 blocklengths(i)=blocklengths(i)*ichunk
1090 call MPI_Type_indexed(4,blocklengths,displs,
1091 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1092 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1096 iint_start=ivec_start+1
1099 iint_count(i)=ivec_count(i)
1100 iint_displ(i)=ivec_displ(i)
1101 ivec_displ(i)=ivec_displ(i)-1
1102 iset_displ(i)=iset_displ(i)-1
1103 ithet_displ(i)=ithet_displ(i)-1
1104 iphi_displ(i)=iphi_displ(i)-1
1105 iphi1_displ(i)=iphi1_displ(i)-1
1106 ibond_displ(i)=ibond_displ(i)-1
1108 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1109 & .and. (me.eq.0 .or. .not. out1file)) then
1110 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1112 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1115 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1116 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1117 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1119 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1122 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1123 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1124 & ' SC-p interactions','were distributed among',nfgtasks,
1125 & ' fine-grain processors.'
1141 idihconstr_end=ndih_constr
1142 ithetaconstr_start=1
1143 ithetaconstr_end=ntheta_constr
1144 iphid_start=iphi_start
1145 iphid_end=iphi_end-1
1162 c---------------------------------------------------------------------------
1163 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1165 include "DIMENSIONS"
1166 include "COMMON.INTERACT"
1167 include "COMMON.SETUP"
1168 include "COMMON.IOUNITS"
1169 integer ii,jj,itask(4),ntask_cont_to,
1170 &itask_cont_to(0:max_fg_procs-1)
1172 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1173 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1174 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1175 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1176 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1177 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1178 & ielend_all(maxres,0:max_fg_procs-1)
1179 integer iproc,isent,k,l
1180 c Determines whether to send interaction ii,jj to other processors; a given
1181 c interaction can be sent to at most 2 processors.
1182 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1183 c one processor, otherwise flag is unchanged from the input value.
1189 c write (iout,*) "ii",ii," jj",jj
1190 c Loop over processors to check if anybody could need interaction ii,jj
1191 do iproc=0,fg_rank-1
1192 c Check if the interaction matches any turn3 at iproc
1193 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1195 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1196 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1198 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1201 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1202 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1205 call add_task(iproc,ntask_cont_to,itask_cont_to)
1209 C Check if the interaction matches any turn4 at iproc
1210 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1212 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1213 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1215 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1218 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1219 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1222 call add_task(iproc,ntask_cont_to,itask_cont_to)
1226 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1227 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1228 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1229 & ielend_all(ii-1,iproc).ge.jj-1) then
1231 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1232 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1235 call add_task(iproc,ntask_cont_to,itask_cont_to)
1238 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1239 & ielend_all(ii-1,iproc).ge.jj+1) then
1241 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1242 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1245 call add_task(iproc,ntask_cont_to,itask_cont_to)
1252 c---------------------------------------------------------------------------
1253 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1255 include "DIMENSIONS"
1256 include "COMMON.INTERACT"
1257 include "COMMON.SETUP"
1258 include "COMMON.IOUNITS"
1259 integer ii,jj,itask(2),ntask_cont_from,
1260 & itask_cont_from(0:max_fg_procs-1)
1262 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1263 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1264 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1265 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1266 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1267 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1268 & ielend_all(maxres,0:max_fg_procs-1)
1270 do iproc=fg_rank+1,nfgtasks-1
1271 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1273 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1274 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1276 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1277 call add_task(iproc,ntask_cont_from,itask_cont_from)
1280 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1282 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1283 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1285 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1286 call add_task(iproc,ntask_cont_from,itask_cont_from)
1289 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1290 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1292 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1293 & jj+1.le.ielend_all(ii+1,iproc)) then
1294 call add_task(iproc,ntask_cont_from,itask_cont_from)
1296 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1297 & jj-1.le.ielend_all(ii+1,iproc)) then
1298 call add_task(iproc,ntask_cont_from,itask_cont_from)
1301 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1303 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1304 & jj-1.le.ielend_all(ii-1,iproc)) then
1305 call add_task(iproc,ntask_cont_from,itask_cont_from)
1307 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1308 & jj+1.le.ielend_all(ii-1,iproc)) then
1309 call add_task(iproc,ntask_cont_from,itask_cont_from)
1316 c---------------------------------------------------------------------------
1317 subroutine add_task(iproc,ntask_cont,itask_cont)
1319 include "DIMENSIONS"
1320 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1323 if (itask_cont(ii).eq.iproc) return
1325 ntask_cont=ntask_cont+1
1326 itask_cont(ntask_cont)=iproc
1329 c---------------------------------------------------------------------------
1330 subroutine int_bounds(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/nfgtasks
1341 nexcess=total_ints-nint*nfgtasks
1343 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1347 lower_bound=lower_bound+int4proc(i)
1349 upper_bound=lower_bound+int4proc(fg_rank)
1350 lower_bound=lower_bound+1
1353 c---------------------------------------------------------------------------
1354 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1355 implicit real*8 (a-h,o-z)
1356 include 'DIMENSIONS'
1358 include 'COMMON.SETUP'
1359 integer total_ints,lower_bound,upper_bound
1360 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1361 nint=total_ints/nfgtasks1
1365 nexcess=total_ints-nint*nfgtasks1
1367 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1371 lower_bound=lower_bound+int4proc(i)
1373 upper_bound=lower_bound+int4proc(fg_rank1)
1374 lower_bound=lower_bound+1
1377 c---------------------------------------------------------------------------
1378 subroutine int_partition(int_index,lower_index,upper_index,atom,
1379 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1380 implicit real*8 (a-h,o-z)
1381 include 'DIMENSIONS'
1382 include 'COMMON.IOUNITS'
1383 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1384 & first_atom,last_atom,int_gr,jat_start,jat_end
1387 if (lprn) write (iout,*) 'int_index=',int_index
1388 int_index_old=int_index
1389 int_index=int_index+last_atom-first_atom+1
1391 & write (iout,*) 'int_index=',int_index,
1392 & ' int_index_old',int_index_old,
1393 & ' lower_index=',lower_index,
1394 & ' upper_index=',upper_index,
1395 & ' atom=',atom,' first_atom=',first_atom,
1396 & ' last_atom=',last_atom
1397 if (int_index.ge.lower_index) then
1399 if (at_start.eq.0) then
1401 jat_start=first_atom-1+lower_index-int_index_old
1403 jat_start=first_atom
1405 if (lprn) write (iout,*) 'jat_start',jat_start
1406 if (int_index.ge.upper_index) then
1408 jat_end=first_atom-1+upper_index-int_index_old
1413 if (lprn) write (iout,*) 'jat_end',jat_end
1418 c------------------------------------------------------------------------------
1419 subroutine hpb_partition
1420 implicit real*8 (a-h,o-z)
1421 include 'DIMENSIONS'
1425 include 'COMMON.SBRIDGE'
1426 include 'COMMON.IOUNITS'
1427 include 'COMMON.SETUP'
1429 call int_bounds(nhpb,link_start,link_end)
1430 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1431 & ' absolute rank',MyRank,
1432 & ' nhpb',nhpb,' link_start=',link_start,
1433 & ' link_end',link_end