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
447 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
448 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
451 write (iout,'(a)') 'Interaction array:'
453 write (iout,'(i3,2(2x,2i3))')
454 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
459 C Now partition the electrostatic-interaction array
461 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
462 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
464 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
465 & ' absolute rank',MyRank,
466 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
467 & ' my_ele_inde',my_ele_inde
474 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
475 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
478 if (iatel_s.eq.0) iatel_s=1
479 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
480 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
481 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
482 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
483 c & " my_ele_inde_vdw",my_ele_inde_vdw
490 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
492 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
494 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
495 c & " ielend_vdw",ielend_vdw(i)
497 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
508 do i=iatel_s_vdw,iatel_e_vdw
514 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
515 & ' absolute rank',MyRank
516 write (iout,*) 'Electrostatic interaction array:'
518 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
523 C Partition the SC-p interaction array
525 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
526 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
527 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
528 & ' absolute rank',myrank,
529 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
530 & ' my_scp_inde',my_scp_inde
536 if (i.lt.nnt+iscp) then
537 cd write (iout,*) 'i.le.nnt+iscp'
538 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
539 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
541 else if (i.gt.nct-iscp) then
542 cd write (iout,*) 'i.gt.nct-iscp'
543 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
544 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
547 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
548 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
551 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
552 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
561 if (i.lt.nnt+iscp) then
563 iscpstart(i,1)=i+iscp
565 elseif (i.gt.nct-iscp) then
573 iscpstart(i,2)=i+iscp
579 write (iout,'(a)') 'SC-p interaction array:'
580 do i=iatscp_s,iatscp_e
581 write (iout,'(i3,2(2x,2i3))')
582 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
585 C Partition local interactions
587 call int_bounds(nres-2,loc_start,loc_end)
588 loc_start=loc_start+1
590 call int_bounds(nres-2,ithet_start,ithet_end)
591 ithet_start=ithet_start+2
592 ithet_end=ithet_end+2
593 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
594 iturn3_start=iturn3_start+nnt
595 iphi_start=iturn3_start+2
596 iturn3_end=iturn3_end+nnt
597 iphi_end=iturn3_end+2
598 iturn3_start=iturn3_start-1
599 iturn3_end=iturn3_end-1
600 call int_bounds(nres-3,itau_start,itau_end)
601 itau_start=itau_start+3
603 call int_bounds(nres-3,iphi1_start,iphi1_end)
604 iphi1_start=iphi1_start+3
605 iphi1_end=iphi1_end+3
606 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
607 iturn4_start=iturn4_start+nnt
608 iphid_start=iturn4_start+2
609 iturn4_end=iturn4_end+nnt
610 iphid_end=iturn4_end+2
611 iturn4_start=iturn4_start-1
612 iturn4_end=iturn4_end-1
613 call int_bounds(nres-2,ibond_start,ibond_end)
614 ibond_start=ibond_start+1
615 ibond_end=ibond_end+1
616 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
617 ibondp_start=ibondp_start+nnt
618 ibondp_end=ibondp_end+nnt
619 call int_bounds1(nres-1,ivec_start,ivec_end)
620 c print *,"Processor",myrank,fg_rank,fg_rank1,
621 c & " ivec_start",ivec_start," ivec_end",ivec_end
622 iset_start=loc_start+2
624 if (ndih_constr.eq.0) then
628 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
630 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
632 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
634 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
635 igrad_start=((2*nlen+1)
636 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
637 jgrad_start(igrad_start)=
638 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
640 jgrad_end(igrad_start)=nres
641 igrad_end=((2*nlen+1)
642 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
643 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
644 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
646 do i=igrad_start+1,igrad_end-1
651 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
652 & ' absolute rank',myrank,
653 & ' loc_start',loc_start,' loc_end',loc_end,
654 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
655 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
656 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
657 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
658 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
659 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
660 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
661 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
662 & ' iset_start',iset_start,' iset_end',iset_end,
663 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
665 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
666 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
667 & ' ngrad_end',ngrad_end
668 do i=igrad_start,igrad_end
669 write(*,*) 'Processor:',fg_rank,myrank,i,
670 & jgrad_start(i),jgrad_end(i)
673 if (nfgtasks.gt.1) then
674 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
675 & MPI_INTEGER,FG_COMM1,IERROR)
676 iaux=ivec_end-ivec_start+1
677 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
678 & MPI_INTEGER,FG_COMM1,IERROR)
679 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
680 & MPI_INTEGER,FG_COMM,IERROR)
681 iaux=iset_end-iset_start+1
682 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
683 & MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
685 & MPI_INTEGER,FG_COMM,IERROR)
686 iaux=ibond_end-ibond_start+1
687 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
688 & MPI_INTEGER,FG_COMM,IERROR)
689 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
690 & MPI_INTEGER,FG_COMM,IERROR)
691 iaux=ithet_end-ithet_start+1
692 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
693 & MPI_INTEGER,FG_COMM,IERROR)
694 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
696 iaux=iphi_end-iphi_start+1
697 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
698 & MPI_INTEGER,FG_COMM,IERROR)
699 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
700 & MPI_INTEGER,FG_COMM,IERROR)
701 iaux=iphi1_end-iphi1_start+1
702 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
703 & MPI_INTEGER,FG_COMM,IERROR)
710 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
711 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
713 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
714 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
715 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
716 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
717 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
718 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
719 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
720 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
721 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
722 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
723 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
724 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
725 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
727 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
728 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
729 write (iout,*) "iturn3_start_all",
730 & (iturn3_start_all(i),i=0,nfgtasks-1)
731 write (iout,*) "iturn3_end_all",
732 & (iturn3_end_all(i),i=0,nfgtasks-1)
733 write (iout,*) "iturn4_start_all",
734 & (iturn4_start_all(i),i=0,nfgtasks-1)
735 write (iout,*) "iturn4_end_all",
736 & (iturn4_end_all(i),i=0,nfgtasks-1)
737 write (iout,*) "The ielstart_all array"
739 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
741 write (iout,*) "The ielend_all array"
743 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
749 itask_cont_from(0)=fg_rank
750 itask_cont_to(0)=fg_rank
752 do ii=iturn3_start,iturn3_end
753 call add_int(ii,ii+2,iturn3_sent(1,ii),
754 & ntask_cont_to,itask_cont_to,flag)
756 do ii=iturn4_start,iturn4_end
757 call add_int(ii,ii+3,iturn4_sent(1,ii),
758 & ntask_cont_to,itask_cont_to,flag)
760 do ii=iturn3_start,iturn3_end
761 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
763 do ii=iturn4_start,iturn4_end
764 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
767 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
768 & " ntask_cont_to",ntask_cont_to
769 write (iout,*) "itask_cont_from",
770 & (itask_cont_from(i),i=1,ntask_cont_from)
771 write (iout,*) "itask_cont_to",
772 & (itask_cont_to(i),i=1,ntask_cont_to)
775 c write (iout,*) "Loop forward"
778 c write (iout,*) "from loop i=",i
780 do j=ielstart(i),ielend(i)
781 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
784 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
785 c & " iatel_e",iatel_e
789 c write (iout,*) "i",i," ielstart",ielstart(i),
790 c & " ielend",ielend(i)
793 do j=ielstart(i),ielend(i)
794 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
795 & itask_cont_to,flag)
803 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
804 & " ntask_cont_to",ntask_cont_to
805 write (iout,*) "itask_cont_from",
806 & (itask_cont_from(i),i=1,ntask_cont_from)
807 write (iout,*) "itask_cont_to",
808 & (itask_cont_to(i),i=1,ntask_cont_to)
810 write (iout,*) "iint_sent"
813 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
814 & j=ielstart(ii),ielend(ii))
816 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
817 & " iturn3_end",iturn3_end
818 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
819 & i=iturn3_start,iturn3_end)
820 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
821 & " iturn4_end",iturn4_end
822 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
823 & i=iturn4_start,iturn4_end)
826 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
827 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
828 c write (iout,*) "Gather ntask_cont_from ended"
830 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
831 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
833 c write (iout,*) "Gather itask_cont_from ended"
835 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
836 & 1,MPI_INTEGER,king,FG_COMM,IERR)
837 c write (iout,*) "Gather ntask_cont_to ended"
839 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
840 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
841 c write (iout,*) "Gather itask_cont_to ended"
843 if (fg_rank.eq.king) then
844 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
846 write (iout,'(20i4)') i,ntask_cont_from_all(i),
847 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
851 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
853 write (iout,'(20i4)') i,ntask_cont_to_all(i),
854 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
858 C Check if every send will have a matching receive
862 ncheck_to=ncheck_to+ntask_cont_to_all(i)
863 ncheck_from=ncheck_from+ntask_cont_from_all(i)
865 write (iout,*) "Control sums",ncheck_from,ncheck_to
866 if (ncheck_from.ne.ncheck_to) then
867 write (iout,*) "Error: #receive differs from #send."
868 write (iout,*) "Terminating program...!"
874 do j=1,ntask_cont_to_all(i)
875 ii=itask_cont_to_all(j,i)
876 do k=1,ntask_cont_from_all(ii)
877 if (itask_cont_from_all(k,ii).eq.i) then
878 if(lprint)write(iout,*)"Matching send/receive",i,ii
882 if (k.eq.ntask_cont_from_all(ii)+1) then
884 write (iout,*) "Error: send by",j," to",ii,
885 & " would have no matching receive"
891 write (iout,*) "Unmatched sends; terminating program"
895 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
896 c write (iout,*) "flag broadcast ended flag=",flag
899 call MPI_Finalize(IERROR)
900 stop "Error in INIT_INT_TABLE: unmatched send/receive."
902 call MPI_Comm_group(FG_COMM,fg_group,IERR)
903 c write (iout,*) "MPI_Comm_group ended"
905 call MPI_Group_incl(fg_group,ntask_cont_from+1,
906 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
907 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
908 & CONT_TO_GROUP,IERR)
911 iaux=4*(ielend(ii)-ielstart(ii)+1)
912 call MPI_Group_translate_ranks(fg_group,iaux,
913 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
914 & iint_sent_local(1,ielstart(ii),i),IERR )
915 c write (iout,*) "Ranks translated i=",i
918 iaux=4*(iturn3_end-iturn3_start+1)
919 call MPI_Group_translate_ranks(fg_group,iaux,
920 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
921 & iturn3_sent_local(1,iturn3_start),IERR)
922 iaux=4*(iturn4_end-iturn4_start+1)
923 call MPI_Group_translate_ranks(fg_group,iaux,
924 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
925 & iturn4_sent_local(1,iturn4_start),IERR)
927 write (iout,*) "iint_sent_local"
930 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
931 & j=ielstart(ii),ielend(ii))
934 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
935 & " iturn3_end",iturn3_end
936 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
937 & i=iturn3_start,iturn3_end)
938 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
939 & " iturn4_end",iturn4_end
940 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
941 & i=iturn4_start,iturn4_end)
944 call MPI_Group_free(fg_group,ierr)
945 call MPI_Group_free(cont_from_group,ierr)
946 call MPI_Group_free(cont_to_group,ierr)
947 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
948 call MPI_Type_commit(MPI_UYZ,IERROR)
949 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
951 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
952 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
953 call MPI_Type_commit(MPI_MU,IERROR)
954 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
955 call MPI_Type_commit(MPI_MAT1,IERROR)
956 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
957 call MPI_Type_commit(MPI_MAT2,IERROR)
958 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
959 call MPI_Type_commit(MPI_THET,IERROR)
960 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
961 call MPI_Type_commit(MPI_GAM,IERROR)
963 c 9/22/08 Derived types to send matrices which appear in correlation terms
965 if (ivec_count(i).eq.ivec_count(0)) then
971 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
972 if (ind_typ.eq.0) then
982 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
985 c blocklengths(i)=blocklengths(i)*ichunk
987 c write (iout,*) "blocklengths and displs"
989 c write (iout,*) i,blocklengths(i),displs(i)
992 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
993 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
994 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
995 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1001 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1004 c blocklengths(i)=blocklengths(i)*ichunk
1006 c write (iout,*) "blocklengths and displs"
1008 c write (iout,*) i,blocklengths(i),displs(i)
1011 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1012 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1013 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1014 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1020 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1023 blocklengths(i)=blocklengths(i)*ichunk
1025 call MPI_Type_indexed(8,blocklengths,displs,
1026 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1027 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
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_PRECOMP12(ind_typ),IERROR)
1040 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1046 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1049 blocklengths(i)=blocklengths(i)*ichunk
1051 call MPI_Type_indexed(6,blocklengths,displs,
1052 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1053 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1059 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1062 blocklengths(i)=blocklengths(i)*ichunk
1064 call MPI_Type_indexed(2,blocklengths,displs,
1065 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1066 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1072 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1075 blocklengths(i)=blocklengths(i)*ichunk
1077 call MPI_Type_indexed(4,blocklengths,displs,
1078 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1079 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1083 iint_start=ivec_start+1
1086 iint_count(i)=ivec_count(i)
1087 iint_displ(i)=ivec_displ(i)
1088 ivec_displ(i)=ivec_displ(i)-1
1089 iset_displ(i)=iset_displ(i)-1
1090 ithet_displ(i)=ithet_displ(i)-1
1091 iphi_displ(i)=iphi_displ(i)-1
1092 iphi1_displ(i)=iphi1_displ(i)-1
1093 ibond_displ(i)=ibond_displ(i)-1
1095 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1096 & .and. (me.eq.0 .or. .not. out1file)) then
1097 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1099 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1102 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1103 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1104 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1106 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1109 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1110 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1111 & ' SC-p interactions','were distributed among',nfgtasks,
1112 & ' fine-grain processors.'
1128 idihconstr_end=ndih_constr
1129 iphid_start=iphi_start
1130 iphid_end=iphi_end-1
1147 c---------------------------------------------------------------------------
1148 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1150 include "DIMENSIONS"
1151 include "COMMON.INTERACT"
1152 include "COMMON.SETUP"
1153 include "COMMON.IOUNITS"
1154 integer ii,jj,itask(4),ntask_cont_to,
1155 &itask_cont_to(0:max_fg_procs-1)
1157 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1158 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1159 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1160 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1161 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1162 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1163 & ielend_all(maxres,0:max_fg_procs-1)
1164 integer iproc,isent,k,l
1165 c Determines whether to send interaction ii,jj to other processors; a given
1166 c interaction can be sent to at most 2 processors.
1167 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1168 c one processor, otherwise flag is unchanged from the input value.
1174 c write (iout,*) "ii",ii," jj",jj
1175 c Loop over processors to check if anybody could need interaction ii,jj
1176 do iproc=0,fg_rank-1
1177 c Check if the interaction matches any turn3 at iproc
1178 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1180 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1181 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1183 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1186 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1187 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1190 call add_task(iproc,ntask_cont_to,itask_cont_to)
1194 C Check if the interaction matches any turn4 at iproc
1195 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1197 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1198 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1200 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1203 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1204 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1207 call add_task(iproc,ntask_cont_to,itask_cont_to)
1211 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1212 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1213 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1214 & ielend_all(ii-1,iproc).ge.jj-1) then
1216 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1217 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1220 call add_task(iproc,ntask_cont_to,itask_cont_to)
1223 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1224 & ielend_all(ii-1,iproc).ge.jj+1) then
1226 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1227 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1230 call add_task(iproc,ntask_cont_to,itask_cont_to)
1237 c---------------------------------------------------------------------------
1238 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1240 include "DIMENSIONS"
1241 include "COMMON.INTERACT"
1242 include "COMMON.SETUP"
1243 include "COMMON.IOUNITS"
1244 integer ii,jj,itask(2),ntask_cont_from,
1245 & itask_cont_from(0:max_fg_procs-1)
1247 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1248 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1249 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1250 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1251 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1252 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1253 & ielend_all(maxres,0:max_fg_procs-1)
1255 do iproc=fg_rank+1,nfgtasks-1
1256 do k=iturn3_start_all(iproc),iturn3_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,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1262 call add_task(iproc,ntask_cont_from,itask_cont_from)
1265 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1267 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1268 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1270 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1271 call add_task(iproc,ntask_cont_from,itask_cont_from)
1274 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1275 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1277 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1278 & jj+1.le.ielend_all(ii+1,iproc)) then
1279 call add_task(iproc,ntask_cont_from,itask_cont_from)
1281 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1282 & jj-1.le.ielend_all(ii+1,iproc)) then
1283 call add_task(iproc,ntask_cont_from,itask_cont_from)
1286 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1288 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1289 & jj-1.le.ielend_all(ii-1,iproc)) then
1290 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1301 c---------------------------------------------------------------------------
1302 subroutine add_task(iproc,ntask_cont,itask_cont)
1304 include "DIMENSIONS"
1305 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1308 if (itask_cont(ii).eq.iproc) return
1310 ntask_cont=ntask_cont+1
1311 itask_cont(ntask_cont)=iproc
1314 c---------------------------------------------------------------------------
1315 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1316 implicit real*8 (a-h,o-z)
1317 include 'DIMENSIONS'
1319 include 'COMMON.SETUP'
1320 integer total_ints,lower_bound,upper_bound
1321 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1322 nint=total_ints/nfgtasks
1326 nexcess=total_ints-nint*nfgtasks
1328 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1332 lower_bound=lower_bound+int4proc(i)
1334 upper_bound=lower_bound+int4proc(fg_rank)
1335 lower_bound=lower_bound+1
1338 c---------------------------------------------------------------------------
1339 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1340 implicit real*8 (a-h,o-z)
1341 include 'DIMENSIONS'
1343 include 'COMMON.SETUP'
1344 integer total_ints,lower_bound,upper_bound
1345 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1346 nint=total_ints/nfgtasks1
1350 nexcess=total_ints-nint*nfgtasks1
1352 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1356 lower_bound=lower_bound+int4proc(i)
1358 upper_bound=lower_bound+int4proc(fg_rank1)
1359 lower_bound=lower_bound+1
1362 c---------------------------------------------------------------------------
1363 subroutine int_partition(int_index,lower_index,upper_index,atom,
1364 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1365 implicit real*8 (a-h,o-z)
1366 include 'DIMENSIONS'
1367 include 'COMMON.IOUNITS'
1368 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1369 & first_atom,last_atom,int_gr,jat_start,jat_end
1372 if (lprn) write (iout,*) 'int_index=',int_index
1373 int_index_old=int_index
1374 int_index=int_index+last_atom-first_atom+1
1376 & write (iout,*) 'int_index=',int_index,
1377 & ' int_index_old',int_index_old,
1378 & ' lower_index=',lower_index,
1379 & ' upper_index=',upper_index,
1380 & ' atom=',atom,' first_atom=',first_atom,
1381 & ' last_atom=',last_atom
1382 if (int_index.ge.lower_index) then
1384 if (at_start.eq.0) then
1386 jat_start=first_atom-1+lower_index-int_index_old
1388 jat_start=first_atom
1390 if (lprn) write (iout,*) 'jat_start',jat_start
1391 if (int_index.ge.upper_index) then
1393 jat_end=first_atom-1+upper_index-int_index_old
1398 if (lprn) write (iout,*) 'jat_end',jat_end
1403 c------------------------------------------------------------------------------
1404 subroutine hpb_partition
1405 implicit real*8 (a-h,o-z)
1406 include 'DIMENSIONS'
1410 include 'COMMON.SBRIDGE'
1411 include 'COMMON.IOUNITS'
1412 include 'COMMON.SETUP'
1414 call int_bounds(nhpb,link_start,link_end)
1415 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1416 & ' absolute rank',MyRank,
1417 & ' nhpb',nhpb,' link_start=',link_start,
1418 & ' link_end',link_end