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
200 v1(k,j,i,iblock)=0.0D0
201 v2(k,j,i,iblock)=0.0D0
211 v1c(1,l,i,j,k,iblock)=0.0D0
212 v1s(1,l,i,j,k,iblock)=0.0D0
213 v1c(2,l,i,j,k,iblock)=0.0D0
214 v1s(2,l,i,j,k,iblock)=0.0D0
218 v2c(m,l,i,j,k,iblock)=0.0D0
219 v2s(m,l,i,j,k,iblock)=0.0D0
231 C Initialize the bridge arrays
250 C Initialize variables used in minimization.
259 C Initialize the variables responsible for the mode of gradient storage.
264 C Initialize constants used to split the energy into long- and short-range
270 nprint_ene=nprint_ene-1
274 c-------------------------------------------------------------------------
276 implicit real*8 (a-h,o-z)
278 include 'COMMON.NAMES'
279 include 'COMMON.FFIELD'
281 &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
282 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
283 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
284 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
286 &'z','p','k','r','h','d','e','n','q','s','t','g',
287 &'a','y','w','v','l','i','f','m','c','x',
288 &'C','M','F','I','L','V','W','Y','A','G','T',
289 &'S','Q','N','E','D','H','R','K','P','X'/
290 data potname /'LJ','LJK','BP','GB','GBV'/
292 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
293 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
294 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
295 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/
297 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
298 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
299 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
301 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
304 c---------------------------------------------------------------------------
305 subroutine init_int_table
306 implicit real*8 (a-h,o-z)
310 integer blocklengths(15),displs(15)
312 include 'COMMON.CONTROL'
313 include 'COMMON.SETUP'
314 include 'COMMON.CHAIN'
315 include 'COMMON.INTERACT'
316 include 'COMMON.LOCAL'
317 include 'COMMON.SBRIDGE'
318 include 'COMMON.TORCNSTR'
319 include 'COMMON.IOUNITS'
320 include 'COMMON.DERIV'
321 include 'COMMON.CONTACTS'
322 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
323 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
324 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
325 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
326 & ielend_all(maxres,0:MaxProcs-1),
327 & ntask_cont_from_all(0:max_fg_procs-1),
328 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
329 & ntask_cont_to_all(0:max_fg_procs-1),
330 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
331 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
332 logical scheck,lprint,flag
334 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
335 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
336 C... Determine the numbers of start and end SC-SC interaction
337 C... to deal with by current processor.
339 itask_cont_from(i)=fg_rank
340 itask_cont_to(i)=fg_rank
344 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
345 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
346 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
348 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
349 & ' absolute rank',MyRank,
350 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
351 & ' my_sc_inde',my_sc_inde
371 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
372 cd & (ihpb(i),jhpb(i),i=1,nss)
376 if (ihpb(ii).eq.i+nres) then
383 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
387 c write (iout,*) 'jj=i+1'
388 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
389 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
395 else if (jj.eq.nct) then
397 c write (iout,*) 'jj=nct'
398 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
399 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
407 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
408 & iatsc_s,iatsc_e,i+1,jj-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,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
422 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
423 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
428 ind_scint=ind_scint+nct-i
432 ind_scint_old=ind_scint
441 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
442 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
445 write (iout,'(a)') 'Interaction array:'
447 write (iout,'(i3,2(2x,2i3))')
448 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
453 C Now partition the electrostatic-interaction array
455 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
456 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
458 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
459 & ' absolute rank',MyRank,
460 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
461 & ' my_ele_inde',my_ele_inde
468 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
469 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
472 if (iatel_s.eq.0) iatel_s=1
473 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
474 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
475 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
476 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
477 c & " my_ele_inde_vdw",my_ele_inde_vdw
484 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
486 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
488 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
489 c & " ielend_vdw",ielend_vdw(i)
491 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
502 do i=iatel_s_vdw,iatel_e_vdw
508 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
509 & ' absolute rank',MyRank
510 write (iout,*) 'Electrostatic interaction array:'
512 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
517 C Partition the SC-p interaction array
519 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
520 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
521 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
522 & ' absolute rank',myrank,
523 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
524 & ' my_scp_inde',my_scp_inde
530 if (i.lt.nnt+iscp) then
531 cd write (iout,*) 'i.le.nnt+iscp'
532 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
533 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
535 else if (i.gt.nct-iscp) then
536 cd write (iout,*) 'i.gt.nct-iscp'
537 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
538 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
541 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
542 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
545 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
546 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
555 if (i.lt.nnt+iscp) then
557 iscpstart(i,1)=i+iscp
559 elseif (i.gt.nct-iscp) then
567 iscpstart(i,2)=i+iscp
573 write (iout,'(a)') 'SC-p interaction array:'
574 do i=iatscp_s,iatscp_e
575 write (iout,'(i3,2(2x,2i3))')
576 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
579 C Partition local interactions
581 call int_bounds(nres-2,loc_start,loc_end)
582 loc_start=loc_start+1
584 call int_bounds(nres-2,ithet_start,ithet_end)
585 ithet_start=ithet_start+2
586 ithet_end=ithet_end+2
587 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
588 iturn3_start=iturn3_start+nnt
589 iphi_start=iturn3_start+2
590 iturn3_end=iturn3_end+nnt
591 iphi_end=iturn3_end+2
592 iturn3_start=iturn3_start-1
593 iturn3_end=iturn3_end-1
594 call int_bounds(nres-3,iphi1_start,iphi1_end)
595 iphi1_start=iphi1_start+3
596 iphi1_end=iphi1_end+3
597 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
598 iturn4_start=iturn4_start+nnt
599 iphid_start=iturn4_start+2
600 iturn4_end=iturn4_end+nnt
601 iphid_end=iturn4_end+2
602 iturn4_start=iturn4_start-1
603 iturn4_end=iturn4_end-1
604 call int_bounds(nres-2,ibond_start,ibond_end)
605 ibond_start=ibond_start+1
606 ibond_end=ibond_end+1
607 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
608 ibondp_start=ibondp_start+nnt
609 ibondp_end=ibondp_end+nnt
610 call int_bounds1(nres-1,ivec_start,ivec_end)
611 c print *,"Processor",myrank,fg_rank,fg_rank1,
612 c & " ivec_start",ivec_start," ivec_end",ivec_end
613 iset_start=loc_start+2
615 if (ndih_constr.eq.0) then
619 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
621 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
623 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
625 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
626 igrad_start=((2*nlen+1)
627 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
628 jgrad_start(igrad_start)=
629 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
631 jgrad_end(igrad_start)=nres
632 igrad_end=((2*nlen+1)
633 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
634 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
635 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
637 do i=igrad_start+1,igrad_end-1
642 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
643 & ' absolute rank',myrank,
644 & ' loc_start',loc_start,' loc_end',loc_end,
645 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
646 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
647 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
648 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
649 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
650 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
651 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
652 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
653 & ' iset_start',iset_start,' iset_end',iset_end,
654 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
656 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
657 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
658 & ' ngrad_end',ngrad_end
659 do i=igrad_start,igrad_end
660 write(*,*) 'Processor:',fg_rank,myrank,i,
661 & jgrad_start(i),jgrad_end(i)
664 if (nfgtasks.gt.1) then
665 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
666 & MPI_INTEGER,FG_COMM1,IERROR)
667 iaux=ivec_end-ivec_start+1
668 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
669 & MPI_INTEGER,FG_COMM1,IERROR)
670 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
671 & MPI_INTEGER,FG_COMM,IERROR)
672 iaux=iset_end-iset_start+1
673 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
674 & MPI_INTEGER,FG_COMM,IERROR)
675 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
676 & MPI_INTEGER,FG_COMM,IERROR)
677 iaux=ibond_end-ibond_start+1
678 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
679 & MPI_INTEGER,FG_COMM,IERROR)
680 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
681 & MPI_INTEGER,FG_COMM,IERROR)
682 iaux=ithet_end-ithet_start+1
683 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
684 & MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
686 & MPI_INTEGER,FG_COMM,IERROR)
687 iaux=iphi_end-iphi_start+1
688 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
689 & MPI_INTEGER,FG_COMM,IERROR)
690 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
691 & MPI_INTEGER,FG_COMM,IERROR)
692 iaux=iphi1_end-iphi1_start+1
693 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
694 & MPI_INTEGER,FG_COMM,IERROR)
701 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
702 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
703 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
704 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
705 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
706 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
707 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
708 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
710 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
712 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
714 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
716 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
718 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
719 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
720 write (iout,*) "iturn3_start_all",
721 & (iturn3_start_all(i),i=0,nfgtasks-1)
722 write (iout,*) "iturn3_end_all",
723 & (iturn3_end_all(i),i=0,nfgtasks-1)
724 write (iout,*) "iturn4_start_all",
725 & (iturn4_start_all(i),i=0,nfgtasks-1)
726 write (iout,*) "iturn4_end_all",
727 & (iturn4_end_all(i),i=0,nfgtasks-1)
728 write (iout,*) "The ielstart_all array"
730 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
732 write (iout,*) "The ielend_all array"
734 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
740 itask_cont_from(0)=fg_rank
741 itask_cont_to(0)=fg_rank
743 do ii=iturn3_start,iturn3_end
744 call add_int(ii,ii+2,iturn3_sent(1,ii),
745 & ntask_cont_to,itask_cont_to,flag)
747 do ii=iturn4_start,iturn4_end
748 call add_int(ii,ii+3,iturn4_sent(1,ii),
749 & ntask_cont_to,itask_cont_to,flag)
751 do ii=iturn3_start,iturn3_end
752 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
754 do ii=iturn4_start,iturn4_end
755 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
758 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
759 & " ntask_cont_to",ntask_cont_to
760 write (iout,*) "itask_cont_from",
761 & (itask_cont_from(i),i=1,ntask_cont_from)
762 write (iout,*) "itask_cont_to",
763 & (itask_cont_to(i),i=1,ntask_cont_to)
766 c write (iout,*) "Loop forward"
769 c write (iout,*) "from loop i=",i
771 do j=ielstart(i),ielend(i)
772 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
775 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
776 c & " iatel_e",iatel_e
780 c write (iout,*) "i",i," ielstart",ielstart(i),
781 c & " ielend",ielend(i)
784 do j=ielstart(i),ielend(i)
785 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
786 & itask_cont_to,flag)
794 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
795 & " ntask_cont_to",ntask_cont_to
796 write (iout,*) "itask_cont_from",
797 & (itask_cont_from(i),i=1,ntask_cont_from)
798 write (iout,*) "itask_cont_to",
799 & (itask_cont_to(i),i=1,ntask_cont_to)
801 write (iout,*) "iint_sent"
804 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
805 & j=ielstart(ii),ielend(ii))
807 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
808 & " iturn3_end",iturn3_end
809 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
810 & i=iturn3_start,iturn3_end)
811 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
812 & " iturn4_end",iturn4_end
813 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
814 & i=iturn4_start,iturn4_end)
817 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
818 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
819 c write (iout,*) "Gather ntask_cont_from ended"
821 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
822 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
824 c write (iout,*) "Gather itask_cont_from ended"
826 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
827 & 1,MPI_INTEGER,king,FG_COMM,IERR)
828 c write (iout,*) "Gather ntask_cont_to ended"
830 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
831 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
832 c write (iout,*) "Gather itask_cont_to ended"
834 if (fg_rank.eq.king) then
835 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
837 write (iout,'(20i4)') i,ntask_cont_from_all(i),
838 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
842 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
844 write (iout,'(20i4)') i,ntask_cont_to_all(i),
845 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
849 C Check if every send will have a matching receive
853 ncheck_to=ncheck_to+ntask_cont_to_all(i)
854 ncheck_from=ncheck_from+ntask_cont_from_all(i)
856 write (iout,*) "Control sums",ncheck_from,ncheck_to
857 if (ncheck_from.ne.ncheck_to) then
858 write (iout,*) "Error: #receive differs from #send."
859 write (iout,*) "Terminating program...!"
865 do j=1,ntask_cont_to_all(i)
866 ii=itask_cont_to_all(j,i)
867 do k=1,ntask_cont_from_all(ii)
868 if (itask_cont_from_all(k,ii).eq.i) then
869 if(lprint)write(iout,*)"Matching send/receive",i,ii
873 if (k.eq.ntask_cont_from_all(ii)+1) then
875 write (iout,*) "Error: send by",j," to",ii,
876 & " would have no matching receive"
882 write (iout,*) "Unmatched sends; terminating program"
886 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
887 c write (iout,*) "flag broadcast ended flag=",flag
890 call MPI_Finalize(IERROR)
891 stop "Error in INIT_INT_TABLE: unmatched send/receive."
893 call MPI_Comm_group(FG_COMM,fg_group,IERR)
894 c write (iout,*) "MPI_Comm_group ended"
896 call MPI_Group_incl(fg_group,ntask_cont_from+1,
897 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
898 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
899 & CONT_TO_GROUP,IERR)
902 iaux=4*(ielend(ii)-ielstart(ii)+1)
903 call MPI_Group_translate_ranks(fg_group,iaux,
904 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
905 & iint_sent_local(1,ielstart(ii),i),IERR )
906 c write (iout,*) "Ranks translated i=",i
909 iaux=4*(iturn3_end-iturn3_start+1)
910 call MPI_Group_translate_ranks(fg_group,iaux,
911 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
912 & iturn3_sent_local(1,iturn3_start),IERR)
913 iaux=4*(iturn4_end-iturn4_start+1)
914 call MPI_Group_translate_ranks(fg_group,iaux,
915 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
916 & iturn4_sent_local(1,iturn4_start),IERR)
918 write (iout,*) "iint_sent_local"
921 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
922 & j=ielstart(ii),ielend(ii))
925 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
926 & " iturn3_end",iturn3_end
927 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
928 & i=iturn3_start,iturn3_end)
929 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
930 & " iturn4_end",iturn4_end
931 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
932 & i=iturn4_start,iturn4_end)
935 call MPI_Group_free(fg_group,ierr)
936 call MPI_Group_free(cont_from_group,ierr)
937 call MPI_Group_free(cont_to_group,ierr)
938 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
939 call MPI_Type_commit(MPI_UYZ,IERROR)
940 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
942 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
943 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
944 call MPI_Type_commit(MPI_MU,IERROR)
945 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
946 call MPI_Type_commit(MPI_MAT1,IERROR)
947 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
948 call MPI_Type_commit(MPI_MAT2,IERROR)
949 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
950 call MPI_Type_commit(MPI_THET,IERROR)
951 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
952 call MPI_Type_commit(MPI_GAM,IERROR)
954 c 9/22/08 Derived types to send matrices which appear in correlation terms
956 if (ivec_count(i).eq.ivec_count(0)) then
962 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
963 if (ind_typ.eq.0) then
973 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
976 c blocklengths(i)=blocklengths(i)*ichunk
978 c write (iout,*) "blocklengths and displs"
980 c write (iout,*) i,blocklengths(i),displs(i)
983 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
984 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
985 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
986 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
992 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
995 c blocklengths(i)=blocklengths(i)*ichunk
997 c write (iout,*) "blocklengths and displs"
999 c write (iout,*) i,blocklengths(i),displs(i)
1002 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1003 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1004 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1005 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1011 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1014 blocklengths(i)=blocklengths(i)*ichunk
1016 call MPI_Type_indexed(8,blocklengths,displs,
1017 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1018 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1024 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1027 blocklengths(i)=blocklengths(i)*ichunk
1029 call MPI_Type_indexed(8,blocklengths,displs,
1030 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1031 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1037 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1040 blocklengths(i)=blocklengths(i)*ichunk
1042 call MPI_Type_indexed(6,blocklengths,displs,
1043 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1044 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1050 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1053 blocklengths(i)=blocklengths(i)*ichunk
1055 call MPI_Type_indexed(2,blocklengths,displs,
1056 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1057 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1063 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1066 blocklengths(i)=blocklengths(i)*ichunk
1068 call MPI_Type_indexed(4,blocklengths,displs,
1069 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1070 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1074 iint_start=ivec_start+1
1077 iint_count(i)=ivec_count(i)
1078 iint_displ(i)=ivec_displ(i)
1079 ivec_displ(i)=ivec_displ(i)-1
1080 iset_displ(i)=iset_displ(i)-1
1081 ithet_displ(i)=ithet_displ(i)-1
1082 iphi_displ(i)=iphi_displ(i)-1
1083 iphi1_displ(i)=iphi1_displ(i)-1
1084 ibond_displ(i)=ibond_displ(i)-1
1086 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1087 & .and. (me.eq.0 .or. .not. out1file)) then
1088 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1090 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1093 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1094 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1095 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1097 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1100 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1101 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1102 & ' SC-p interactions','were distributed among',nfgtasks,
1103 & ' fine-grain processors.'
1119 idihconstr_end=ndih_constr
1120 iphid_start=iphi_start
1121 iphid_end=iphi_end-1
1136 c---------------------------------------------------------------------------
1137 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1139 include "DIMENSIONS"
1140 include "COMMON.INTERACT"
1141 include "COMMON.SETUP"
1142 include "COMMON.IOUNITS"
1143 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1145 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1146 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1147 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1148 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1149 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1150 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1151 & ielend_all(maxres,0:MaxProcs-1)
1152 integer iproc,isent,k,l
1153 c Determines whether to send interaction ii,jj to other processors; a given
1154 c interaction can be sent to at most 2 processors.
1155 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1156 c one processor, otherwise flag is unchanged from the input value.
1162 c write (iout,*) "ii",ii," jj",jj
1163 c Loop over processors to check if anybody could need interaction ii,jj
1164 do iproc=0,fg_rank-1
1165 c Check if the interaction matches any turn3 at iproc
1166 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1168 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1169 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1171 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1174 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1175 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1178 call add_task(iproc,ntask_cont_to,itask_cont_to)
1182 C Check if the interaction matches any turn4 at iproc
1183 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1185 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1186 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1188 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1191 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1192 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1195 call add_task(iproc,ntask_cont_to,itask_cont_to)
1199 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1200 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1201 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1202 & ielend_all(ii-1,iproc).ge.jj-1) then
1204 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1205 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1208 call add_task(iproc,ntask_cont_to,itask_cont_to)
1211 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1212 & ielend_all(ii-1,iproc).ge.jj+1) then
1214 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1215 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1218 call add_task(iproc,ntask_cont_to,itask_cont_to)
1225 c---------------------------------------------------------------------------
1226 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1228 include "DIMENSIONS"
1229 include "COMMON.INTERACT"
1230 include "COMMON.SETUP"
1231 include "COMMON.IOUNITS"
1232 integer ii,jj,itask(2),ntask_cont_from,
1233 & itask_cont_from(0:MaxProcs-1)
1235 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1236 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1237 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1238 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1239 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1240 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1241 & ielend_all(maxres,0:MaxProcs-1)
1243 do iproc=fg_rank+1,nfgtasks-1
1244 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1246 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1247 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1249 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1250 call add_task(iproc,ntask_cont_from,itask_cont_from)
1253 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1255 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1256 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1258 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1259 call add_task(iproc,ntask_cont_from,itask_cont_from)
1262 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1263 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1265 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1266 & jj+1.le.ielend_all(ii+1,iproc)) then
1267 call add_task(iproc,ntask_cont_from,itask_cont_from)
1269 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1270 & jj-1.le.ielend_all(ii+1,iproc)) then
1271 call add_task(iproc,ntask_cont_from,itask_cont_from)
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)
1289 c---------------------------------------------------------------------------
1290 subroutine add_task(iproc,ntask_cont,itask_cont)
1292 include "DIMENSIONS"
1293 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1296 if (itask_cont(ii).eq.iproc) return
1298 ntask_cont=ntask_cont+1
1299 itask_cont(ntask_cont)=iproc
1302 c---------------------------------------------------------------------------
1303 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1304 implicit real*8 (a-h,o-z)
1305 include 'DIMENSIONS'
1307 include 'COMMON.SETUP'
1308 integer total_ints,lower_bound,upper_bound
1309 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1310 nint=total_ints/nfgtasks
1314 nexcess=total_ints-nint*nfgtasks
1316 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1320 lower_bound=lower_bound+int4proc(i)
1322 upper_bound=lower_bound+int4proc(fg_rank)
1323 lower_bound=lower_bound+1
1326 c---------------------------------------------------------------------------
1327 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1328 implicit real*8 (a-h,o-z)
1329 include 'DIMENSIONS'
1331 include 'COMMON.SETUP'
1332 integer total_ints,lower_bound,upper_bound
1333 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1334 nint=total_ints/nfgtasks1
1338 nexcess=total_ints-nint*nfgtasks1
1340 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1344 lower_bound=lower_bound+int4proc(i)
1346 upper_bound=lower_bound+int4proc(fg_rank1)
1347 lower_bound=lower_bound+1
1350 c---------------------------------------------------------------------------
1351 subroutine int_partition(int_index,lower_index,upper_index,atom,
1352 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1353 implicit real*8 (a-h,o-z)
1354 include 'DIMENSIONS'
1355 include 'COMMON.IOUNITS'
1356 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1357 & first_atom,last_atom,int_gr,jat_start,jat_end
1360 if (lprn) write (iout,*) 'int_index=',int_index
1361 int_index_old=int_index
1362 int_index=int_index+last_atom-first_atom+1
1364 & write (iout,*) 'int_index=',int_index,
1365 & ' int_index_old',int_index_old,
1366 & ' lower_index=',lower_index,
1367 & ' upper_index=',upper_index,
1368 & ' atom=',atom,' first_atom=',first_atom,
1369 & ' last_atom=',last_atom
1370 if (int_index.ge.lower_index) then
1372 if (at_start.eq.0) then
1374 jat_start=first_atom-1+lower_index-int_index_old
1376 jat_start=first_atom
1378 if (lprn) write (iout,*) 'jat_start',jat_start
1379 if (int_index.ge.upper_index) then
1381 jat_end=first_atom-1+upper_index-int_index_old
1386 if (lprn) write (iout,*) 'jat_end',jat_end
1391 c------------------------------------------------------------------------------
1392 subroutine hpb_partition
1393 implicit real*8 (a-h,o-z)
1394 include 'DIMENSIONS'
1398 include 'COMMON.SBRIDGE'
1399 include 'COMMON.IOUNITS'
1400 include 'COMMON.SETUP'
1402 call int_bounds(nhpb,link_start,link_end)
1403 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1404 & ' absolute rank',MyRank,
1405 & ' nhpb',nhpb,' link_start=',link_start,
1406 & ' link_end',link_end