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
99 crc for write_rmsbank1
101 cdr include secondary structure prediction bias
104 C CSA I/O units (separated from others especially for Jooyoung)
115 icsa_bank_reminimized=38
118 crc for ifc error 118
121 C Set default weights of the energy terms.
132 c print '(a,$)','Inside initialize'
133 c call memmon_print_usage()
166 athet(j,i,ichir1,ichir2)=0.0D0
167 bthet(j,i,ichir1,ichir2)=0.0D0
187 gaussc(l,k,j,i)=0.0D0
197 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
201 v1(k,j,i,iblock)=0.0D0
202 v2(k,j,i,iblock)=0.0D0
212 v1c(1,l,i,j,k,iblock)=0.0D0
213 v1s(1,l,i,j,k,iblock)=0.0D0
214 v1c(2,l,i,j,k,iblock)=0.0D0
215 v1s(2,l,i,j,k,iblock)=0.0D0
219 v2c(m,l,i,j,k,iblock)=0.0D0
220 v2s(m,l,i,j,k,iblock)=0.0D0
232 C Initialize the bridge arrays
251 C Initialize variables used in minimization.
260 C Initialize the variables responsible for the mode of gradient storage.
265 C Initialize constants used to split the energy into long- and short-range
271 nprint_ene=nprint_ene-1
275 c-------------------------------------------------------------------------
277 implicit real*8 (a-h,o-z)
279 include 'COMMON.NAMES'
280 include 'COMMON.FFIELD'
282 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
283 & 'DSG','DGN','DSN','DTH',
284 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
285 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
286 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
289 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
290 &'a','y','w','v','l','i','f','m','c','x',
291 &'C','M','F','I','L','V','W','Y','A','G','T',
292 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
293 data potname /'LJ','LJK','BP','GB','GBV'/
295 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
296 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
297 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
298 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
300 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
301 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
302 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
304 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
307 c---------------------------------------------------------------------------
308 subroutine init_int_table
309 implicit real*8 (a-h,o-z)
313 integer blocklengths(15),displs(15)
315 include 'COMMON.CONTROL'
316 include 'COMMON.SETUP'
317 include 'COMMON.CHAIN'
318 include 'COMMON.INTERACT'
319 include 'COMMON.LOCAL'
320 include 'COMMON.SBRIDGE'
321 include 'COMMON.TORCNSTR'
322 include 'COMMON.IOUNITS'
323 include 'COMMON.DERIV'
324 include 'COMMON.CONTACTS'
325 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
326 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
327 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
328 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
329 & ielend_all(maxres,0:MaxProcs-1),
330 & ntask_cont_from_all(0:max_fg_procs-1),
331 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
332 & ntask_cont_to_all(0:max_fg_procs-1),
333 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
334 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
335 logical scheck,lprint,flag
337 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
338 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
339 C... Determine the numbers of start and end SC-SC interaction
340 C... to deal with by current processor.
342 itask_cont_from(i)=fg_rank
343 itask_cont_to(i)=fg_rank
347 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
348 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
349 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
351 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
352 & ' absolute rank',MyRank,
353 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
354 & ' my_sc_inde',my_sc_inde
374 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
375 cd & (ihpb(i),jhpb(i),i=1,nss)
379 if (ihpb(ii).eq.i+nres) then
386 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
390 c write (iout,*) 'jj=i+1'
391 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
392 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
398 else if (jj.eq.nct) then
400 c write (iout,*) 'jj=nct'
401 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
402 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
410 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
411 & iatsc_s,iatsc_e,i+1,jj-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,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
425 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
426 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
431 ind_scint=ind_scint+nct-i
435 ind_scint_old=ind_scint
444 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
445 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
448 write (iout,'(a)') 'Interaction array:'
450 write (iout,'(i3,2(2x,2i3))')
451 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
456 C Now partition the electrostatic-interaction array
458 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
459 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
461 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
462 & ' absolute rank',MyRank,
463 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
464 & ' my_ele_inde',my_ele_inde
471 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
472 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
475 if (iatel_s.eq.0) iatel_s=1
476 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
477 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
478 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
479 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
480 c & " my_ele_inde_vdw",my_ele_inde_vdw
487 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
489 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
491 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
492 c & " ielend_vdw",ielend_vdw(i)
494 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
505 do i=iatel_s_vdw,iatel_e_vdw
511 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
512 & ' absolute rank',MyRank
513 write (iout,*) 'Electrostatic interaction array:'
515 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
520 C Partition the SC-p interaction array
522 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
523 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
524 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
525 & ' absolute rank',myrank,
526 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
527 & ' my_scp_inde',my_scp_inde
533 if (i.lt.nnt+iscp) then
534 cd write (iout,*) 'i.le.nnt+iscp'
535 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
536 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
538 else if (i.gt.nct-iscp) then
539 cd write (iout,*) 'i.gt.nct-iscp'
540 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
541 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
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,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
558 if (i.lt.nnt+iscp) then
560 iscpstart(i,1)=i+iscp
562 elseif (i.gt.nct-iscp) then
570 iscpstart(i,2)=i+iscp
576 write (iout,'(a)') 'SC-p interaction array:'
577 do i=iatscp_s,iatscp_e
578 write (iout,'(i3,2(2x,2i3))')
579 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
582 C Partition local interactions
584 call int_bounds(nres-2,loc_start,loc_end)
585 loc_start=loc_start+1
587 call int_bounds(nres-2,ithet_start,ithet_end)
588 ithet_start=ithet_start+2
589 ithet_end=ithet_end+2
590 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
591 iturn3_start=iturn3_start+nnt
592 iphi_start=iturn3_start+2
593 iturn3_end=iturn3_end+nnt
594 iphi_end=iturn3_end+2
595 iturn3_start=iturn3_start-1
596 iturn3_end=iturn3_end-1
597 call int_bounds(nres-3,itau_start,itau_end)
598 itau_start=itau_start+3
600 call int_bounds(nres-3,iphi1_start,iphi1_end)
601 iphi1_start=iphi1_start+3
602 iphi1_end=iphi1_end+3
603 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
604 iturn4_start=iturn4_start+nnt
605 iphid_start=iturn4_start+2
606 iturn4_end=iturn4_end+nnt
607 iphid_end=iturn4_end+2
608 iturn4_start=iturn4_start-1
609 iturn4_end=iturn4_end-1
610 call int_bounds(nres-2,ibond_start,ibond_end)
611 ibond_start=ibond_start+1
612 ibond_end=ibond_end+1
613 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
614 ibondp_start=ibondp_start+nnt
615 ibondp_end=ibondp_end+nnt
616 call int_bounds1(nres-1,ivec_start,ivec_end)
617 c print *,"Processor",myrank,fg_rank,fg_rank1,
618 c & " ivec_start",ivec_start," ivec_end",ivec_end
619 iset_start=loc_start+2
621 if (ndih_constr.eq.0) then
625 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
627 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
629 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
631 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
632 igrad_start=((2*nlen+1)
633 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
634 jgrad_start(igrad_start)=
635 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
637 jgrad_end(igrad_start)=nres
638 igrad_end=((2*nlen+1)
639 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
640 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
641 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
643 do i=igrad_start+1,igrad_end-1
648 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
649 & ' absolute rank',myrank,
650 & ' loc_start',loc_start,' loc_end',loc_end,
651 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
652 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
653 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
654 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
655 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
656 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
657 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
658 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
659 & ' iset_start',iset_start,' iset_end',iset_end,
660 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
662 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
663 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
664 & ' ngrad_end',ngrad_end
665 do i=igrad_start,igrad_end
666 write(*,*) 'Processor:',fg_rank,myrank,i,
667 & jgrad_start(i),jgrad_end(i)
670 if (nfgtasks.gt.1) then
671 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
672 & MPI_INTEGER,FG_COMM1,IERROR)
673 iaux=ivec_end-ivec_start+1
674 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
675 & MPI_INTEGER,FG_COMM1,IERROR)
676 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
677 & MPI_INTEGER,FG_COMM,IERROR)
678 iaux=iset_end-iset_start+1
679 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
680 & MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 iaux=ibond_end-ibond_start+1
684 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
685 & MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
688 iaux=ithet_end-ithet_start+1
689 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
690 & MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 iaux=iphi_end-iphi_start+1
694 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
696 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
697 & MPI_INTEGER,FG_COMM,IERROR)
698 iaux=iphi1_end-iphi1_start+1
699 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
700 & MPI_INTEGER,FG_COMM,IERROR)
707 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
708 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
710 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
712 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
714 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
716 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
718 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
719 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
720 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
721 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
722 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
724 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
725 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
726 write (iout,*) "iturn3_start_all",
727 & (iturn3_start_all(i),i=0,nfgtasks-1)
728 write (iout,*) "iturn3_end_all",
729 & (iturn3_end_all(i),i=0,nfgtasks-1)
730 write (iout,*) "iturn4_start_all",
731 & (iturn4_start_all(i),i=0,nfgtasks-1)
732 write (iout,*) "iturn4_end_all",
733 & (iturn4_end_all(i),i=0,nfgtasks-1)
734 write (iout,*) "The ielstart_all array"
736 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
738 write (iout,*) "The ielend_all array"
740 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
746 itask_cont_from(0)=fg_rank
747 itask_cont_to(0)=fg_rank
749 do ii=iturn3_start,iturn3_end
750 call add_int(ii,ii+2,iturn3_sent(1,ii),
751 & ntask_cont_to,itask_cont_to,flag)
753 do ii=iturn4_start,iturn4_end
754 call add_int(ii,ii+3,iturn4_sent(1,ii),
755 & ntask_cont_to,itask_cont_to,flag)
757 do ii=iturn3_start,iturn3_end
758 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
760 do ii=iturn4_start,iturn4_end
761 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
764 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
765 & " ntask_cont_to",ntask_cont_to
766 write (iout,*) "itask_cont_from",
767 & (itask_cont_from(i),i=1,ntask_cont_from)
768 write (iout,*) "itask_cont_to",
769 & (itask_cont_to(i),i=1,ntask_cont_to)
772 c write (iout,*) "Loop forward"
775 c write (iout,*) "from loop i=",i
777 do j=ielstart(i),ielend(i)
778 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
781 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
782 c & " iatel_e",iatel_e
786 c write (iout,*) "i",i," ielstart",ielstart(i),
787 c & " ielend",ielend(i)
790 do j=ielstart(i),ielend(i)
791 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
792 & itask_cont_to,flag)
800 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
801 & " ntask_cont_to",ntask_cont_to
802 write (iout,*) "itask_cont_from",
803 & (itask_cont_from(i),i=1,ntask_cont_from)
804 write (iout,*) "itask_cont_to",
805 & (itask_cont_to(i),i=1,ntask_cont_to)
807 write (iout,*) "iint_sent"
810 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
811 & j=ielstart(ii),ielend(ii))
813 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
814 & " iturn3_end",iturn3_end
815 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
816 & i=iturn3_start,iturn3_end)
817 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
818 & " iturn4_end",iturn4_end
819 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
820 & i=iturn4_start,iturn4_end)
823 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
824 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
825 c write (iout,*) "Gather ntask_cont_from ended"
827 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
828 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
830 c write (iout,*) "Gather itask_cont_from ended"
832 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
833 & 1,MPI_INTEGER,king,FG_COMM,IERR)
834 c write (iout,*) "Gather ntask_cont_to ended"
836 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
837 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
838 c write (iout,*) "Gather itask_cont_to ended"
840 if (fg_rank.eq.king) then
841 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
843 write (iout,'(20i4)') i,ntask_cont_from_all(i),
844 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
848 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
850 write (iout,'(20i4)') i,ntask_cont_to_all(i),
851 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
855 C Check if every send will have a matching receive
859 ncheck_to=ncheck_to+ntask_cont_to_all(i)
860 ncheck_from=ncheck_from+ntask_cont_from_all(i)
862 write (iout,*) "Control sums",ncheck_from,ncheck_to
863 if (ncheck_from.ne.ncheck_to) then
864 write (iout,*) "Error: #receive differs from #send."
865 write (iout,*) "Terminating program...!"
871 do j=1,ntask_cont_to_all(i)
872 ii=itask_cont_to_all(j,i)
873 do k=1,ntask_cont_from_all(ii)
874 if (itask_cont_from_all(k,ii).eq.i) then
875 if(lprint)write(iout,*)"Matching send/receive",i,ii
879 if (k.eq.ntask_cont_from_all(ii)+1) then
881 write (iout,*) "Error: send by",j," to",ii,
882 & " would have no matching receive"
888 write (iout,*) "Unmatched sends; terminating program"
892 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
893 c write (iout,*) "flag broadcast ended flag=",flag
896 call MPI_Finalize(IERROR)
897 stop "Error in INIT_INT_TABLE: unmatched send/receive."
899 call MPI_Comm_group(FG_COMM,fg_group,IERR)
900 c write (iout,*) "MPI_Comm_group ended"
902 call MPI_Group_incl(fg_group,ntask_cont_from+1,
903 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
904 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
905 & CONT_TO_GROUP,IERR)
908 iaux=4*(ielend(ii)-ielstart(ii)+1)
909 call MPI_Group_translate_ranks(fg_group,iaux,
910 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
911 & iint_sent_local(1,ielstart(ii),i),IERR )
912 c write (iout,*) "Ranks translated i=",i
915 iaux=4*(iturn3_end-iturn3_start+1)
916 call MPI_Group_translate_ranks(fg_group,iaux,
917 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
918 & iturn3_sent_local(1,iturn3_start),IERR)
919 iaux=4*(iturn4_end-iturn4_start+1)
920 call MPI_Group_translate_ranks(fg_group,iaux,
921 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
922 & iturn4_sent_local(1,iturn4_start),IERR)
924 write (iout,*) "iint_sent_local"
927 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
928 & j=ielstart(ii),ielend(ii))
931 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
932 & " iturn3_end",iturn3_end
933 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
934 & i=iturn3_start,iturn3_end)
935 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
936 & " iturn4_end",iturn4_end
937 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
938 & i=iturn4_start,iturn4_end)
941 call MPI_Group_free(fg_group,ierr)
942 call MPI_Group_free(cont_from_group,ierr)
943 call MPI_Group_free(cont_to_group,ierr)
944 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
945 call MPI_Type_commit(MPI_UYZ,IERROR)
946 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
948 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
949 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
950 call MPI_Type_commit(MPI_MU,IERROR)
951 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
952 call MPI_Type_commit(MPI_MAT1,IERROR)
953 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
954 call MPI_Type_commit(MPI_MAT2,IERROR)
955 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
956 call MPI_Type_commit(MPI_THET,IERROR)
957 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
958 call MPI_Type_commit(MPI_GAM,IERROR)
960 c 9/22/08 Derived types to send matrices which appear in correlation terms
962 if (ivec_count(i).eq.ivec_count(0)) then
968 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
969 if (ind_typ.eq.0) then
979 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
982 c blocklengths(i)=blocklengths(i)*ichunk
984 c write (iout,*) "blocklengths and displs"
986 c write (iout,*) i,blocklengths(i),displs(i)
989 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
990 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
991 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
992 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
998 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1001 c blocklengths(i)=blocklengths(i)*ichunk
1003 c write (iout,*) "blocklengths and displs"
1005 c write (iout,*) i,blocklengths(i),displs(i)
1008 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1009 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1010 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1011 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1017 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1020 blocklengths(i)=blocklengths(i)*ichunk
1022 call MPI_Type_indexed(8,blocklengths,displs,
1023 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1024 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1030 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1033 blocklengths(i)=blocklengths(i)*ichunk
1035 call MPI_Type_indexed(8,blocklengths,displs,
1036 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1037 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1043 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1046 blocklengths(i)=blocklengths(i)*ichunk
1048 call MPI_Type_indexed(6,blocklengths,displs,
1049 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1050 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1056 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1059 blocklengths(i)=blocklengths(i)*ichunk
1061 call MPI_Type_indexed(2,blocklengths,displs,
1062 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1063 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1069 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1072 blocklengths(i)=blocklengths(i)*ichunk
1074 call MPI_Type_indexed(4,blocklengths,displs,
1075 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1076 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1080 iint_start=ivec_start+1
1083 iint_count(i)=ivec_count(i)
1084 iint_displ(i)=ivec_displ(i)
1085 ivec_displ(i)=ivec_displ(i)-1
1086 iset_displ(i)=iset_displ(i)-1
1087 ithet_displ(i)=ithet_displ(i)-1
1088 iphi_displ(i)=iphi_displ(i)-1
1089 iphi1_displ(i)=iphi1_displ(i)-1
1090 ibond_displ(i)=ibond_displ(i)-1
1092 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1093 & .and. (me.eq.0 .or. .not. out1file)) then
1094 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1096 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1099 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1100 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1101 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1103 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1106 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1107 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1108 & ' SC-p interactions','were distributed among',nfgtasks,
1109 & ' fine-grain processors.'
1125 idihconstr_end=ndih_constr
1126 iphid_start=iphi_start
1127 iphid_end=iphi_end-1
1144 c---------------------------------------------------------------------------
1145 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1147 include "DIMENSIONS"
1148 include "COMMON.INTERACT"
1149 include "COMMON.SETUP"
1150 include "COMMON.IOUNITS"
1151 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1153 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1154 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1155 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1156 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1157 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1158 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1159 & ielend_all(maxres,0:MaxProcs-1)
1160 integer iproc,isent,k,l
1161 c Determines whether to send interaction ii,jj to other processors; a given
1162 c interaction can be sent to at most 2 processors.
1163 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1164 c one processor, otherwise flag is unchanged from the input value.
1170 c write (iout,*) "ii",ii," jj",jj
1171 c Loop over processors to check if anybody could need interaction ii,jj
1172 do iproc=0,fg_rank-1
1173 c Check if the interaction matches any turn3 at iproc
1174 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1176 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1177 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1179 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1182 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1183 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1186 call add_task(iproc,ntask_cont_to,itask_cont_to)
1190 C Check if the interaction matches any turn4 at iproc
1191 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1193 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1194 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1196 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1199 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1200 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1203 call add_task(iproc,ntask_cont_to,itask_cont_to)
1207 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1208 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1209 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1210 & ielend_all(ii-1,iproc).ge.jj-1) then
1212 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1213 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1216 call add_task(iproc,ntask_cont_to,itask_cont_to)
1219 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1220 & ielend_all(ii-1,iproc).ge.jj+1) then
1222 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1223 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1226 call add_task(iproc,ntask_cont_to,itask_cont_to)
1233 c---------------------------------------------------------------------------
1234 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1236 include "DIMENSIONS"
1237 include "COMMON.INTERACT"
1238 include "COMMON.SETUP"
1239 include "COMMON.IOUNITS"
1240 integer ii,jj,itask(2),ntask_cont_from,
1241 & itask_cont_from(0:MaxProcs-1)
1243 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1244 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1245 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1246 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1247 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1248 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1249 & ielend_all(maxres,0:MaxProcs-1)
1251 do iproc=fg_rank+1,nfgtasks-1
1252 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1254 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1255 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1257 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1258 call add_task(iproc,ntask_cont_from,itask_cont_from)
1261 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1263 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1264 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1266 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1267 call add_task(iproc,ntask_cont_from,itask_cont_from)
1270 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1271 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1273 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1274 & jj+1.le.ielend_all(ii+1,iproc)) then
1275 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1282 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1284 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1285 & jj-1.le.ielend_all(ii-1,iproc)) then
1286 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1297 c---------------------------------------------------------------------------
1298 subroutine add_task(iproc,ntask_cont,itask_cont)
1300 include "DIMENSIONS"
1301 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1304 if (itask_cont(ii).eq.iproc) return
1306 ntask_cont=ntask_cont+1
1307 itask_cont(ntask_cont)=iproc
1310 c---------------------------------------------------------------------------
1311 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1312 implicit real*8 (a-h,o-z)
1313 include 'DIMENSIONS'
1315 include 'COMMON.SETUP'
1316 integer total_ints,lower_bound,upper_bound
1317 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1318 nint=total_ints/nfgtasks
1322 nexcess=total_ints-nint*nfgtasks
1324 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1328 lower_bound=lower_bound+int4proc(i)
1330 upper_bound=lower_bound+int4proc(fg_rank)
1331 lower_bound=lower_bound+1
1334 c---------------------------------------------------------------------------
1335 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1336 implicit real*8 (a-h,o-z)
1337 include 'DIMENSIONS'
1339 include 'COMMON.SETUP'
1340 integer total_ints,lower_bound,upper_bound
1341 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1342 nint=total_ints/nfgtasks1
1346 nexcess=total_ints-nint*nfgtasks1
1348 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1352 lower_bound=lower_bound+int4proc(i)
1354 upper_bound=lower_bound+int4proc(fg_rank1)
1355 lower_bound=lower_bound+1
1358 c---------------------------------------------------------------------------
1359 subroutine int_partition(int_index,lower_index,upper_index,atom,
1360 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1361 implicit real*8 (a-h,o-z)
1362 include 'DIMENSIONS'
1363 include 'COMMON.IOUNITS'
1364 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1365 & first_atom,last_atom,int_gr,jat_start,jat_end
1368 if (lprn) write (iout,*) 'int_index=',int_index
1369 int_index_old=int_index
1370 int_index=int_index+last_atom-first_atom+1
1372 & write (iout,*) 'int_index=',int_index,
1373 & ' int_index_old',int_index_old,
1374 & ' lower_index=',lower_index,
1375 & ' upper_index=',upper_index,
1376 & ' atom=',atom,' first_atom=',first_atom,
1377 & ' last_atom=',last_atom
1378 if (int_index.ge.lower_index) then
1380 if (at_start.eq.0) then
1382 jat_start=first_atom-1+lower_index-int_index_old
1384 jat_start=first_atom
1386 if (lprn) write (iout,*) 'jat_start',jat_start
1387 if (int_index.ge.upper_index) then
1389 jat_end=first_atom-1+upper_index-int_index_old
1394 if (lprn) write (iout,*) 'jat_end',jat_end
1399 c------------------------------------------------------------------------------
1400 subroutine hpb_partition
1401 implicit real*8 (a-h,o-z)
1402 include 'DIMENSIONS'
1406 include 'COMMON.SBRIDGE'
1407 include 'COMMON.IOUNITS'
1408 include 'COMMON.SETUP'
1410 call int_bounds(nhpb,link_start,link_end)
1411 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1412 & ' absolute rank',MyRank,
1413 & ' nhpb',nhpb,' link_start=',link_start,
1414 & ' link_end',link_end