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)
381 if (ihpb(ii).eq.i+nres) then
388 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
392 c write (iout,*) 'jj=i+1'
393 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
394 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
400 else if (jj.eq.nct) then
402 c write (iout,*) 'jj=nct'
403 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
404 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
412 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
413 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
415 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
416 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
427 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
428 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
433 ind_scint=ind_scint+nct-i
437 ind_scint_old=ind_scint
446 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
447 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
450 write (iout,'(a)') 'Interaction array:'
452 write (iout,'(i3,2(2x,2i3))')
453 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
458 C Now partition the electrostatic-interaction array
460 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
461 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
463 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
464 & ' absolute rank',MyRank,
465 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
466 & ' my_ele_inde',my_ele_inde
473 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
474 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
477 if (iatel_s.eq.0) iatel_s=1
478 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
479 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
480 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
481 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
482 c & " my_ele_inde_vdw",my_ele_inde_vdw
489 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
491 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
493 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
494 c & " ielend_vdw",ielend_vdw(i)
496 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
507 do i=iatel_s_vdw,iatel_e_vdw
513 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
514 & ' absolute rank',MyRank
515 write (iout,*) 'Electrostatic interaction array:'
517 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
522 C Partition the SC-p interaction array
524 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
525 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
526 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
527 & ' absolute rank',myrank,
528 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
529 & ' my_scp_inde',my_scp_inde
535 if (i.lt.nnt+iscp) then
536 cd write (iout,*) 'i.le.nnt+iscp'
537 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
538 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
540 else if (i.gt.nct-iscp) then
541 cd write (iout,*) 'i.gt.nct-iscp'
542 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
543 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
546 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
547 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
550 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
551 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
560 if (i.lt.nnt+iscp) then
562 iscpstart(i,1)=i+iscp
564 elseif (i.gt.nct-iscp) then
572 iscpstart(i,2)=i+iscp
578 write (iout,'(a)') 'SC-p interaction array:'
579 do i=iatscp_s,iatscp_e
580 write (iout,'(i3,2(2x,2i3))')
581 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
584 C Partition local interactions
586 call int_bounds(nres-2,loc_start,loc_end)
587 loc_start=loc_start+1
589 call int_bounds(nres-2,ithet_start,ithet_end)
590 ithet_start=ithet_start+2
591 ithet_end=ithet_end+2
592 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
593 iturn3_start=iturn3_start+nnt
594 iphi_start=iturn3_start+2
595 iturn3_end=iturn3_end+nnt
596 iphi_end=iturn3_end+2
597 iturn3_start=iturn3_start-1
598 iturn3_end=iturn3_end-1
599 call int_bounds(nres-3,itau_start,itau_end)
600 itau_start=itau_start+3
602 call int_bounds(nres-3,iphi1_start,iphi1_end)
603 iphi1_start=iphi1_start+3
604 iphi1_end=iphi1_end+3
605 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
606 iturn4_start=iturn4_start+nnt
607 iphid_start=iturn4_start+2
608 iturn4_end=iturn4_end+nnt
609 iphid_end=iturn4_end+2
610 iturn4_start=iturn4_start-1
611 iturn4_end=iturn4_end-1
612 call int_bounds(nres-2,ibond_start,ibond_end)
613 ibond_start=ibond_start+1
614 ibond_end=ibond_end+1
615 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
616 ibondp_start=ibondp_start+nnt
617 ibondp_end=ibondp_end+nnt
618 call int_bounds1(nres-1,ivec_start,ivec_end)
619 c print *,"Processor",myrank,fg_rank,fg_rank1,
620 c & " ivec_start",ivec_start," ivec_end",ivec_end
621 iset_start=loc_start+2
623 if (ndih_constr.eq.0) then
627 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
629 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
631 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
633 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
634 igrad_start=((2*nlen+1)
635 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
636 jgrad_start(igrad_start)=
637 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
639 jgrad_end(igrad_start)=nres
640 igrad_end=((2*nlen+1)
641 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
642 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
643 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
645 do i=igrad_start+1,igrad_end-1
650 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
651 & ' absolute rank',myrank,
652 & ' loc_start',loc_start,' loc_end',loc_end,
653 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
654 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
655 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
656 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
657 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
658 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
659 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
660 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
661 & ' iset_start',iset_start,' iset_end',iset_end,
662 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
664 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
665 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
666 & ' ngrad_end',ngrad_end
667 do i=igrad_start,igrad_end
668 write(*,*) 'Processor:',fg_rank,myrank,i,
669 & jgrad_start(i),jgrad_end(i)
672 if (nfgtasks.gt.1) then
673 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
674 & MPI_INTEGER,FG_COMM1,IERROR)
675 iaux=ivec_end-ivec_start+1
676 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
677 & MPI_INTEGER,FG_COMM1,IERROR)
678 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
679 & MPI_INTEGER,FG_COMM,IERROR)
680 iaux=iset_end-iset_start+1
681 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
684 & MPI_INTEGER,FG_COMM,IERROR)
685 iaux=ibond_end-ibond_start+1
686 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
689 & MPI_INTEGER,FG_COMM,IERROR)
690 iaux=ithet_end-ithet_start+1
691 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
694 & MPI_INTEGER,FG_COMM,IERROR)
695 iaux=iphi_end-iphi_start+1
696 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
697 & MPI_INTEGER,FG_COMM,IERROR)
698 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
699 & MPI_INTEGER,FG_COMM,IERROR)
700 iaux=iphi1_end-iphi1_start+1
701 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
702 & MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
710 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
712 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
714 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
716 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
718 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
719 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
720 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
721 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
722 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
723 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
724 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
726 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
727 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
728 write (iout,*) "iturn3_start_all",
729 & (iturn3_start_all(i),i=0,nfgtasks-1)
730 write (iout,*) "iturn3_end_all",
731 & (iturn3_end_all(i),i=0,nfgtasks-1)
732 write (iout,*) "iturn4_start_all",
733 & (iturn4_start_all(i),i=0,nfgtasks-1)
734 write (iout,*) "iturn4_end_all",
735 & (iturn4_end_all(i),i=0,nfgtasks-1)
736 write (iout,*) "The ielstart_all array"
738 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
740 write (iout,*) "The ielend_all array"
742 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
748 itask_cont_from(0)=fg_rank
749 itask_cont_to(0)=fg_rank
751 do ii=iturn3_start,iturn3_end
752 call add_int(ii,ii+2,iturn3_sent(1,ii),
753 & ntask_cont_to,itask_cont_to,flag)
755 do ii=iturn4_start,iturn4_end
756 call add_int(ii,ii+3,iturn4_sent(1,ii),
757 & ntask_cont_to,itask_cont_to,flag)
759 do ii=iturn3_start,iturn3_end
760 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
762 do ii=iturn4_start,iturn4_end
763 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
766 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
767 & " ntask_cont_to",ntask_cont_to
768 write (iout,*) "itask_cont_from",
769 & (itask_cont_from(i),i=1,ntask_cont_from)
770 write (iout,*) "itask_cont_to",
771 & (itask_cont_to(i),i=1,ntask_cont_to)
774 c write (iout,*) "Loop forward"
777 c write (iout,*) "from loop i=",i
779 do j=ielstart(i),ielend(i)
780 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
783 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
784 c & " iatel_e",iatel_e
788 c write (iout,*) "i",i," ielstart",ielstart(i),
789 c & " ielend",ielend(i)
792 do j=ielstart(i),ielend(i)
793 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
794 & itask_cont_to,flag)
802 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
803 & " ntask_cont_to",ntask_cont_to
804 write (iout,*) "itask_cont_from",
805 & (itask_cont_from(i),i=1,ntask_cont_from)
806 write (iout,*) "itask_cont_to",
807 & (itask_cont_to(i),i=1,ntask_cont_to)
809 write (iout,*) "iint_sent"
812 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
813 & j=ielstart(ii),ielend(ii))
815 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
816 & " iturn3_end",iturn3_end
817 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
818 & i=iturn3_start,iturn3_end)
819 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
820 & " iturn4_end",iturn4_end
821 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
822 & i=iturn4_start,iturn4_end)
825 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
826 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
827 c write (iout,*) "Gather ntask_cont_from ended"
829 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
830 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
832 c write (iout,*) "Gather itask_cont_from ended"
834 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
835 & 1,MPI_INTEGER,king,FG_COMM,IERR)
836 c write (iout,*) "Gather ntask_cont_to ended"
838 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
839 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
840 c write (iout,*) "Gather itask_cont_to ended"
842 if (fg_rank.eq.king) then
843 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
845 write (iout,'(20i4)') i,ntask_cont_from_all(i),
846 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
850 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
852 write (iout,'(20i4)') i,ntask_cont_to_all(i),
853 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
857 C Check if every send will have a matching receive
861 ncheck_to=ncheck_to+ntask_cont_to_all(i)
862 ncheck_from=ncheck_from+ntask_cont_from_all(i)
864 write (iout,*) "Control sums",ncheck_from,ncheck_to
865 if (ncheck_from.ne.ncheck_to) then
866 write (iout,*) "Error: #receive differs from #send."
867 write (iout,*) "Terminating program...!"
873 do j=1,ntask_cont_to_all(i)
874 ii=itask_cont_to_all(j,i)
875 do k=1,ntask_cont_from_all(ii)
876 if (itask_cont_from_all(k,ii).eq.i) then
877 if(lprint)write(iout,*)"Matching send/receive",i,ii
881 if (k.eq.ntask_cont_from_all(ii)+1) then
883 write (iout,*) "Error: send by",j," to",ii,
884 & " would have no matching receive"
890 write (iout,*) "Unmatched sends; terminating program"
894 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
895 c write (iout,*) "flag broadcast ended flag=",flag
898 call MPI_Finalize(IERROR)
899 stop "Error in INIT_INT_TABLE: unmatched send/receive."
901 call MPI_Comm_group(FG_COMM,fg_group,IERR)
902 c write (iout,*) "MPI_Comm_group ended"
904 call MPI_Group_incl(fg_group,ntask_cont_from+1,
905 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
906 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
907 & CONT_TO_GROUP,IERR)
910 iaux=4*(ielend(ii)-ielstart(ii)+1)
911 call MPI_Group_translate_ranks(fg_group,iaux,
912 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
913 & iint_sent_local(1,ielstart(ii),i),IERR )
914 c write (iout,*) "Ranks translated i=",i
917 iaux=4*(iturn3_end-iturn3_start+1)
918 call MPI_Group_translate_ranks(fg_group,iaux,
919 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
920 & iturn3_sent_local(1,iturn3_start),IERR)
921 iaux=4*(iturn4_end-iturn4_start+1)
922 call MPI_Group_translate_ranks(fg_group,iaux,
923 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
924 & iturn4_sent_local(1,iturn4_start),IERR)
926 write (iout,*) "iint_sent_local"
929 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
930 & j=ielstart(ii),ielend(ii))
933 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
934 & " iturn3_end",iturn3_end
935 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
936 & i=iturn3_start,iturn3_end)
937 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
938 & " iturn4_end",iturn4_end
939 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
940 & i=iturn4_start,iturn4_end)
943 call MPI_Group_free(fg_group,ierr)
944 call MPI_Group_free(cont_from_group,ierr)
945 call MPI_Group_free(cont_to_group,ierr)
946 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
947 call MPI_Type_commit(MPI_UYZ,IERROR)
948 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
950 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
951 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
952 call MPI_Type_commit(MPI_MU,IERROR)
953 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
954 call MPI_Type_commit(MPI_MAT1,IERROR)
955 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
956 call MPI_Type_commit(MPI_MAT2,IERROR)
957 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
958 call MPI_Type_commit(MPI_THET,IERROR)
959 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
960 call MPI_Type_commit(MPI_GAM,IERROR)
962 c 9/22/08 Derived types to send matrices which appear in correlation terms
964 if (ivec_count(i).eq.ivec_count(0)) then
970 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
971 if (ind_typ.eq.0) then
981 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
984 c blocklengths(i)=blocklengths(i)*ichunk
986 c write (iout,*) "blocklengths and displs"
988 c write (iout,*) i,blocklengths(i),displs(i)
991 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
992 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
993 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
994 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1000 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1003 c blocklengths(i)=blocklengths(i)*ichunk
1005 c write (iout,*) "blocklengths and displs"
1007 c write (iout,*) i,blocklengths(i),displs(i)
1010 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1011 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1012 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1013 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1019 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1022 blocklengths(i)=blocklengths(i)*ichunk
1024 call MPI_Type_indexed(8,blocklengths,displs,
1025 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1026 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
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_PRECOMP12(ind_typ),IERROR)
1039 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1045 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1048 blocklengths(i)=blocklengths(i)*ichunk
1050 call MPI_Type_indexed(6,blocklengths,displs,
1051 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1052 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1058 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1061 blocklengths(i)=blocklengths(i)*ichunk
1063 call MPI_Type_indexed(2,blocklengths,displs,
1064 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1065 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1071 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1074 blocklengths(i)=blocklengths(i)*ichunk
1076 call MPI_Type_indexed(4,blocklengths,displs,
1077 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1078 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1082 iint_start=ivec_start+1
1085 iint_count(i)=ivec_count(i)
1086 iint_displ(i)=ivec_displ(i)
1087 ivec_displ(i)=ivec_displ(i)-1
1088 iset_displ(i)=iset_displ(i)-1
1089 ithet_displ(i)=ithet_displ(i)-1
1090 iphi_displ(i)=iphi_displ(i)-1
1091 iphi1_displ(i)=iphi1_displ(i)-1
1092 ibond_displ(i)=ibond_displ(i)-1
1094 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1095 & .and. (me.eq.0 .or. .not. out1file)) then
1096 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1098 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1101 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1102 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1103 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1105 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1108 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1109 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1110 & ' SC-p interactions','were distributed among',nfgtasks,
1111 & ' fine-grain processors.'
1127 idihconstr_end=ndih_constr
1128 iphid_start=iphi_start
1129 iphid_end=iphi_end-1
1146 c---------------------------------------------------------------------------
1147 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1149 include "DIMENSIONS"
1150 include "COMMON.INTERACT"
1151 include "COMMON.SETUP"
1152 include "COMMON.IOUNITS"
1153 integer ii,jj,itask(4),ntask_cont_to,
1154 &itask_cont_to(0:max_fg_procs-1)
1156 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1157 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1158 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1159 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1160 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1161 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1162 & ielend_all(maxres,0:max_fg_procs-1)
1163 integer iproc,isent,k,l
1164 c Determines whether to send interaction ii,jj to other processors; a given
1165 c interaction can be sent to at most 2 processors.
1166 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1167 c one processor, otherwise flag is unchanged from the input value.
1173 c write (iout,*) "ii",ii," jj",jj
1174 c Loop over processors to check if anybody could need interaction ii,jj
1175 do iproc=0,fg_rank-1
1176 c Check if the interaction matches any turn3 at iproc
1177 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1179 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1180 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1182 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1185 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1186 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1189 call add_task(iproc,ntask_cont_to,itask_cont_to)
1193 C Check if the interaction matches any turn4 at iproc
1194 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1196 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1197 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1199 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1202 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1203 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1206 call add_task(iproc,ntask_cont_to,itask_cont_to)
1210 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1211 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1212 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1213 & ielend_all(ii-1,iproc).ge.jj-1) then
1215 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1216 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1219 call add_task(iproc,ntask_cont_to,itask_cont_to)
1222 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1223 & ielend_all(ii-1,iproc).ge.jj+1) then
1225 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1226 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1229 call add_task(iproc,ntask_cont_to,itask_cont_to)
1236 c---------------------------------------------------------------------------
1237 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1239 include "DIMENSIONS"
1240 include "COMMON.INTERACT"
1241 include "COMMON.SETUP"
1242 include "COMMON.IOUNITS"
1243 integer ii,jj,itask(2),ntask_cont_from,
1244 & itask_cont_from(0:max_fg_procs-1)
1246 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1247 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1248 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1249 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1250 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1251 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1252 & ielend_all(maxres,0:max_fg_procs-1)
1254 do iproc=fg_rank+1,nfgtasks-1
1255 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1257 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1258 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1260 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1261 call add_task(iproc,ntask_cont_from,itask_cont_from)
1264 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1266 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1267 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1269 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1270 call add_task(iproc,ntask_cont_from,itask_cont_from)
1273 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1274 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1276 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1277 & jj+1.le.ielend_all(ii+1,iproc)) then
1278 call add_task(iproc,ntask_cont_from,itask_cont_from)
1280 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1281 & jj-1.le.ielend_all(ii+1,iproc)) then
1282 call add_task(iproc,ntask_cont_from,itask_cont_from)
1285 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1287 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1288 & jj-1.le.ielend_all(ii-1,iproc)) then
1289 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1300 c---------------------------------------------------------------------------
1301 subroutine add_task(iproc,ntask_cont,itask_cont)
1303 include "DIMENSIONS"
1304 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1307 if (itask_cont(ii).eq.iproc) return
1309 ntask_cont=ntask_cont+1
1310 itask_cont(ntask_cont)=iproc
1313 c---------------------------------------------------------------------------
1314 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1315 implicit real*8 (a-h,o-z)
1316 include 'DIMENSIONS'
1318 include 'COMMON.SETUP'
1319 integer total_ints,lower_bound,upper_bound
1320 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1321 nint=total_ints/nfgtasks
1325 nexcess=total_ints-nint*nfgtasks
1327 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1331 lower_bound=lower_bound+int4proc(i)
1333 upper_bound=lower_bound+int4proc(fg_rank)
1334 lower_bound=lower_bound+1
1337 c---------------------------------------------------------------------------
1338 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1339 implicit real*8 (a-h,o-z)
1340 include 'DIMENSIONS'
1342 include 'COMMON.SETUP'
1343 integer total_ints,lower_bound,upper_bound
1344 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1345 nint=total_ints/nfgtasks1
1349 nexcess=total_ints-nint*nfgtasks1
1351 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1355 lower_bound=lower_bound+int4proc(i)
1357 upper_bound=lower_bound+int4proc(fg_rank1)
1358 lower_bound=lower_bound+1
1361 c---------------------------------------------------------------------------
1362 subroutine int_partition(int_index,lower_index,upper_index,atom,
1363 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1364 implicit real*8 (a-h,o-z)
1365 include 'DIMENSIONS'
1366 include 'COMMON.IOUNITS'
1367 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1368 & first_atom,last_atom,int_gr,jat_start,jat_end
1371 if (lprn) write (iout,*) 'int_index=',int_index
1372 int_index_old=int_index
1373 int_index=int_index+last_atom-first_atom+1
1375 & write (iout,*) 'int_index=',int_index,
1376 & ' int_index_old',int_index_old,
1377 & ' lower_index=',lower_index,
1378 & ' upper_index=',upper_index,
1379 & ' atom=',atom,' first_atom=',first_atom,
1380 & ' last_atom=',last_atom
1381 if (int_index.ge.lower_index) then
1383 if (at_start.eq.0) then
1385 jat_start=first_atom-1+lower_index-int_index_old
1387 jat_start=first_atom
1389 if (lprn) write (iout,*) 'jat_start',jat_start
1390 if (int_index.ge.upper_index) then
1392 jat_end=first_atom-1+upper_index-int_index_old
1397 if (lprn) write (iout,*) 'jat_end',jat_end
1402 c------------------------------------------------------------------------------
1403 subroutine hpb_partition
1404 implicit real*8 (a-h,o-z)
1405 include 'DIMENSIONS'
1409 include 'COMMON.SBRIDGE'
1410 include 'COMMON.IOUNITS'
1411 include 'COMMON.SETUP'
1413 call int_bounds(nhpb,link_start,link_end)
1414 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1415 & ' absolute rank',MyRank,
1416 & ' nhpb',nhpb,' link_start=',link_start,
1417 & ' link_end',link_end