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
445 if (iatsc_s.eq.0) iatsc_s=1
447 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
448 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
451 write (iout,'(a)') 'Interaction array:'
453 write (iout,'(i3,2(2x,2i3))')
454 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
459 C Now partition the electrostatic-interaction array
461 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
462 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
464 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
465 & ' absolute rank',MyRank,
466 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
467 & ' my_ele_inde',my_ele_inde
474 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
475 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
478 if (iatel_s.eq.0) iatel_s=1
479 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
480 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
481 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
482 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
483 c & " my_ele_inde_vdw",my_ele_inde_vdw
490 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
492 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
494 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
495 c & " ielend_vdw",ielend_vdw(i)
497 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
508 do i=iatel_s_vdw,iatel_e_vdw
514 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
515 & ' absolute rank',MyRank
516 write (iout,*) 'Electrostatic interaction array:'
518 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
523 C Partition the SC-p interaction array
525 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
526 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
527 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
528 & ' absolute rank',myrank,
529 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
530 & ' my_scp_inde',my_scp_inde
536 if (i.lt.nnt+iscp) then
537 cd write (iout,*) 'i.le.nnt+iscp'
538 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
539 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
541 else if (i.gt.nct-iscp) then
542 cd write (iout,*) 'i.gt.nct-iscp'
543 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
544 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
547 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
548 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
551 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
552 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
561 if (i.lt.nnt+iscp) then
563 iscpstart(i,1)=i+iscp
565 elseif (i.gt.nct-iscp) then
573 iscpstart(i,2)=i+iscp
578 if (iatscp_s.eq.0) iatscp_s=1
580 write (iout,'(a)') 'SC-p interaction array:'
581 do i=iatscp_s,iatscp_e
582 write (iout,'(i3,2(2x,2i3))')
583 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
586 C Partition local interactions
588 call int_bounds(nres-2,loc_start,loc_end)
589 loc_start=loc_start+1
591 call int_bounds(nres-2,ithet_start,ithet_end)
592 ithet_start=ithet_start+2
593 ithet_end=ithet_end+2
594 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
595 iturn3_start=iturn3_start+nnt
596 iphi_start=iturn3_start+2
597 iturn3_end=iturn3_end+nnt
598 iphi_end=iturn3_end+2
599 iturn3_start=iturn3_start-1
600 iturn3_end=iturn3_end-1
601 call int_bounds(nres-3,itau_start,itau_end)
602 itau_start=itau_start+3
604 call int_bounds(nres-3,iphi1_start,iphi1_end)
605 iphi1_start=iphi1_start+3
606 iphi1_end=iphi1_end+3
607 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
608 iturn4_start=iturn4_start+nnt
609 iphid_start=iturn4_start+2
610 iturn4_end=iturn4_end+nnt
611 iphid_end=iturn4_end+2
612 iturn4_start=iturn4_start-1
613 iturn4_end=iturn4_end-1
614 call int_bounds(nres-2,ibond_start,ibond_end)
615 ibond_start=ibond_start+1
616 ibond_end=ibond_end+1
617 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
618 ibondp_start=ibondp_start+nnt
619 ibondp_end=ibondp_end+nnt
620 call int_bounds1(nres-1,ivec_start,ivec_end)
621 c print *,"Processor",myrank,fg_rank,fg_rank1,
622 c & " ivec_start",ivec_start," ivec_end",ivec_end
623 iset_start=loc_start+2
625 if (ndih_constr.eq.0) then
629 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
631 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
633 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
635 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
636 igrad_start=((2*nlen+1)
637 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
638 jgrad_start(igrad_start)=
639 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
641 jgrad_end(igrad_start)=nres
642 igrad_end=((2*nlen+1)
643 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
644 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
645 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
647 do i=igrad_start+1,igrad_end-1
652 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
653 & ' absolute rank',myrank,
654 & ' loc_start',loc_start,' loc_end',loc_end,
655 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
656 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
657 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
658 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
659 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
660 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
661 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
662 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
663 & ' iset_start',iset_start,' iset_end',iset_end,
664 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
666 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
667 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
668 & ' ngrad_end',ngrad_end
669 do i=igrad_start,igrad_end
670 write(*,*) 'Processor:',fg_rank,myrank,i,
671 & jgrad_start(i),jgrad_end(i)
674 if (nfgtasks.gt.1) then
675 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
676 & MPI_INTEGER,FG_COMM1,IERROR)
677 iaux=ivec_end-ivec_start+1
678 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
679 & MPI_INTEGER,FG_COMM1,IERROR)
680 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
681 & MPI_INTEGER,FG_COMM,IERROR)
682 iaux=iset_end-iset_start+1
683 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
684 & MPI_INTEGER,FG_COMM,IERROR)
685 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
686 & MPI_INTEGER,FG_COMM,IERROR)
687 iaux=ibond_end-ibond_start+1
688 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
689 & MPI_INTEGER,FG_COMM,IERROR)
690 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
691 & MPI_INTEGER,FG_COMM,IERROR)
692 iaux=ithet_end-ithet_start+1
693 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
694 & MPI_INTEGER,FG_COMM,IERROR)
695 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
696 & MPI_INTEGER,FG_COMM,IERROR)
697 iaux=iphi_end-iphi_start+1
698 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
699 & MPI_INTEGER,FG_COMM,IERROR)
700 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
701 & MPI_INTEGER,FG_COMM,IERROR)
702 iaux=iphi1_end-iphi1_start+1
703 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
704 & MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
712 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
714 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
716 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
718 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
719 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
720 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
721 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
722 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
723 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
724 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
725 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
726 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
728 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
729 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
730 write (iout,*) "iturn3_start_all",
731 & (iturn3_start_all(i),i=0,nfgtasks-1)
732 write (iout,*) "iturn3_end_all",
733 & (iturn3_end_all(i),i=0,nfgtasks-1)
734 write (iout,*) "iturn4_start_all",
735 & (iturn4_start_all(i),i=0,nfgtasks-1)
736 write (iout,*) "iturn4_end_all",
737 & (iturn4_end_all(i),i=0,nfgtasks-1)
738 write (iout,*) "The ielstart_all array"
740 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
742 write (iout,*) "The ielend_all array"
744 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
750 itask_cont_from(0)=fg_rank
751 itask_cont_to(0)=fg_rank
753 do ii=iturn3_start,iturn3_end
754 call add_int(ii,ii+2,iturn3_sent(1,ii),
755 & ntask_cont_to,itask_cont_to,flag)
757 do ii=iturn4_start,iturn4_end
758 call add_int(ii,ii+3,iturn4_sent(1,ii),
759 & ntask_cont_to,itask_cont_to,flag)
761 do ii=iturn3_start,iturn3_end
762 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
764 do ii=iturn4_start,iturn4_end
765 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
768 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
769 & " ntask_cont_to",ntask_cont_to
770 write (iout,*) "itask_cont_from",
771 & (itask_cont_from(i),i=1,ntask_cont_from)
772 write (iout,*) "itask_cont_to",
773 & (itask_cont_to(i),i=1,ntask_cont_to)
776 c write (iout,*) "Loop forward"
779 c write (iout,*) "from loop i=",i
781 do j=ielstart(i),ielend(i)
782 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
785 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
786 c & " iatel_e",iatel_e
790 c write (iout,*) "i",i," ielstart",ielstart(i),
791 c & " ielend",ielend(i)
794 do j=ielstart(i),ielend(i)
795 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
796 & itask_cont_to,flag)
804 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
805 & " ntask_cont_to",ntask_cont_to
806 write (iout,*) "itask_cont_from",
807 & (itask_cont_from(i),i=1,ntask_cont_from)
808 write (iout,*) "itask_cont_to",
809 & (itask_cont_to(i),i=1,ntask_cont_to)
811 write (iout,*) "iint_sent"
814 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
815 & j=ielstart(ii),ielend(ii))
817 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
818 & " iturn3_end",iturn3_end
819 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
820 & i=iturn3_start,iturn3_end)
821 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
822 & " iturn4_end",iturn4_end
823 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
824 & i=iturn4_start,iturn4_end)
827 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
828 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
829 c write (iout,*) "Gather ntask_cont_from ended"
831 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
832 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
834 c write (iout,*) "Gather itask_cont_from ended"
836 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
837 & 1,MPI_INTEGER,king,FG_COMM,IERR)
838 c write (iout,*) "Gather ntask_cont_to ended"
840 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
841 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
842 c write (iout,*) "Gather itask_cont_to ended"
844 if (fg_rank.eq.king) then
845 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
847 write (iout,'(20i4)') i,ntask_cont_from_all(i),
848 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
852 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
854 write (iout,'(20i4)') i,ntask_cont_to_all(i),
855 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
859 C Check if every send will have a matching receive
863 ncheck_to=ncheck_to+ntask_cont_to_all(i)
864 ncheck_from=ncheck_from+ntask_cont_from_all(i)
866 write (iout,*) "Control sums",ncheck_from,ncheck_to
867 if (ncheck_from.ne.ncheck_to) then
868 write (iout,*) "Error: #receive differs from #send."
869 write (iout,*) "Terminating program...!"
875 do j=1,ntask_cont_to_all(i)
876 ii=itask_cont_to_all(j,i)
877 do k=1,ntask_cont_from_all(ii)
878 if (itask_cont_from_all(k,ii).eq.i) then
879 if(lprint)write(iout,*)"Matching send/receive",i,ii
883 if (k.eq.ntask_cont_from_all(ii)+1) then
885 write (iout,*) "Error: send by",j," to",ii,
886 & " would have no matching receive"
892 write (iout,*) "Unmatched sends; terminating program"
896 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
897 c write (iout,*) "flag broadcast ended flag=",flag
900 call MPI_Finalize(IERROR)
901 stop "Error in INIT_INT_TABLE: unmatched send/receive."
903 call MPI_Comm_group(FG_COMM,fg_group,IERR)
904 c write (iout,*) "MPI_Comm_group ended"
906 call MPI_Group_incl(fg_group,ntask_cont_from+1,
907 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
908 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
909 & CONT_TO_GROUP,IERR)
912 iaux=4*(ielend(ii)-ielstart(ii)+1)
913 call MPI_Group_translate_ranks(fg_group,iaux,
914 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
915 & iint_sent_local(1,ielstart(ii),i),IERR )
916 c write (iout,*) "Ranks translated i=",i
919 iaux=4*(iturn3_end-iturn3_start+1)
920 call MPI_Group_translate_ranks(fg_group,iaux,
921 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
922 & iturn3_sent_local(1,iturn3_start),IERR)
923 iaux=4*(iturn4_end-iturn4_start+1)
924 call MPI_Group_translate_ranks(fg_group,iaux,
925 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
926 & iturn4_sent_local(1,iturn4_start),IERR)
928 write (iout,*) "iint_sent_local"
931 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
932 & j=ielstart(ii),ielend(ii))
935 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
936 & " iturn3_end",iturn3_end
937 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
938 & i=iturn3_start,iturn3_end)
939 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
940 & " iturn4_end",iturn4_end
941 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
942 & i=iturn4_start,iturn4_end)
945 call MPI_Group_free(fg_group,ierr)
946 call MPI_Group_free(cont_from_group,ierr)
947 call MPI_Group_free(cont_to_group,ierr)
948 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
949 call MPI_Type_commit(MPI_UYZ,IERROR)
950 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
952 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
953 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
954 call MPI_Type_commit(MPI_MU,IERROR)
955 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
956 call MPI_Type_commit(MPI_MAT1,IERROR)
957 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
958 call MPI_Type_commit(MPI_MAT2,IERROR)
959 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
960 call MPI_Type_commit(MPI_THET,IERROR)
961 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
962 call MPI_Type_commit(MPI_GAM,IERROR)
964 c 9/22/08 Derived types to send matrices which appear in correlation terms
966 if (ivec_count(i).eq.ivec_count(0)) then
972 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
973 if (ind_typ.eq.0) then
983 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
986 c blocklengths(i)=blocklengths(i)*ichunk
988 c write (iout,*) "blocklengths and displs"
990 c write (iout,*) i,blocklengths(i),displs(i)
993 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
994 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
995 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
996 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1002 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1005 c blocklengths(i)=blocklengths(i)*ichunk
1007 c write (iout,*) "blocklengths and displs"
1009 c write (iout,*) i,blocklengths(i),displs(i)
1012 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1013 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1014 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1015 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1021 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1024 blocklengths(i)=blocklengths(i)*ichunk
1026 call MPI_Type_indexed(8,blocklengths,displs,
1027 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1028 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1034 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1037 blocklengths(i)=blocklengths(i)*ichunk
1039 call MPI_Type_indexed(8,blocklengths,displs,
1040 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1041 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1047 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1050 blocklengths(i)=blocklengths(i)*ichunk
1052 call MPI_Type_indexed(6,blocklengths,displs,
1053 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1054 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1060 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1063 blocklengths(i)=blocklengths(i)*ichunk
1065 call MPI_Type_indexed(2,blocklengths,displs,
1066 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1067 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1073 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1076 blocklengths(i)=blocklengths(i)*ichunk
1078 call MPI_Type_indexed(4,blocklengths,displs,
1079 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1080 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1084 iint_start=ivec_start+1
1087 iint_count(i)=ivec_count(i)
1088 iint_displ(i)=ivec_displ(i)
1089 ivec_displ(i)=ivec_displ(i)-1
1090 iset_displ(i)=iset_displ(i)-1
1091 ithet_displ(i)=ithet_displ(i)-1
1092 iphi_displ(i)=iphi_displ(i)-1
1093 iphi1_displ(i)=iphi1_displ(i)-1
1094 ibond_displ(i)=ibond_displ(i)-1
1096 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1097 & .and. (me.eq.0 .or. .not. out1file)) then
1098 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1100 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1103 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1104 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1105 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1107 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1110 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1111 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1112 & ' SC-p interactions','were distributed among',nfgtasks,
1113 & ' fine-grain processors.'
1129 idihconstr_end=ndih_constr
1130 iphid_start=iphi_start
1131 iphid_end=iphi_end-1
1148 c---------------------------------------------------------------------------
1149 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1151 include "DIMENSIONS"
1152 include "COMMON.INTERACT"
1153 include "COMMON.SETUP"
1154 include "COMMON.IOUNITS"
1155 integer ii,jj,itask(4),ntask_cont_to,
1156 &itask_cont_to(0:max_fg_procs-1)
1158 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1159 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1160 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1161 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1162 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1163 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1164 & ielend_all(maxres,0:max_fg_procs-1)
1165 integer iproc,isent,k,l
1166 c Determines whether to send interaction ii,jj to other processors; a given
1167 c interaction can be sent to at most 2 processors.
1168 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1169 c one processor, otherwise flag is unchanged from the input value.
1175 c write (iout,*) "ii",ii," jj",jj
1176 c Loop over processors to check if anybody could need interaction ii,jj
1177 do iproc=0,fg_rank-1
1178 c Check if the interaction matches any turn3 at iproc
1179 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1181 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1182 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1184 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1187 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1188 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1191 call add_task(iproc,ntask_cont_to,itask_cont_to)
1195 C Check if the interaction matches any turn4 at iproc
1196 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1198 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1199 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1201 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
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)
1212 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1213 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1214 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1215 & ielend_all(ii-1,iproc).ge.jj-1) then
1217 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1218 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1221 call add_task(iproc,ntask_cont_to,itask_cont_to)
1224 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1225 & ielend_all(ii-1,iproc).ge.jj+1) then
1227 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1228 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1231 call add_task(iproc,ntask_cont_to,itask_cont_to)
1238 c---------------------------------------------------------------------------
1239 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1241 include "DIMENSIONS"
1242 include "COMMON.INTERACT"
1243 include "COMMON.SETUP"
1244 include "COMMON.IOUNITS"
1245 integer ii,jj,itask(2),ntask_cont_from,
1246 & itask_cont_from(0:max_fg_procs-1)
1248 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1249 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1250 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1251 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1252 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1253 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1254 & ielend_all(maxres,0:max_fg_procs-1)
1256 do iproc=fg_rank+1,nfgtasks-1
1257 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1259 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1260 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1262 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1263 call add_task(iproc,ntask_cont_from,itask_cont_from)
1266 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1268 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1269 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1271 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1272 call add_task(iproc,ntask_cont_from,itask_cont_from)
1275 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1276 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1278 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1279 & jj+1.le.ielend_all(ii+1,iproc)) then
1280 call add_task(iproc,ntask_cont_from,itask_cont_from)
1282 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1283 & jj-1.le.ielend_all(ii+1,iproc)) then
1284 call add_task(iproc,ntask_cont_from,itask_cont_from)
1287 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1289 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1290 & jj-1.le.ielend_all(ii-1,iproc)) then
1291 call add_task(iproc,ntask_cont_from,itask_cont_from)
1293 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1294 & jj+1.le.ielend_all(ii-1,iproc)) then
1295 call add_task(iproc,ntask_cont_from,itask_cont_from)
1302 c---------------------------------------------------------------------------
1303 subroutine add_task(iproc,ntask_cont,itask_cont)
1305 include "DIMENSIONS"
1306 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1309 if (itask_cont(ii).eq.iproc) return
1311 ntask_cont=ntask_cont+1
1312 itask_cont(ntask_cont)=iproc
1315 c---------------------------------------------------------------------------
1316 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1317 implicit real*8 (a-h,o-z)
1318 include 'DIMENSIONS'
1320 include 'COMMON.SETUP'
1321 integer total_ints,lower_bound,upper_bound
1322 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1323 nint=total_ints/nfgtasks
1327 nexcess=total_ints-nint*nfgtasks
1329 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1333 lower_bound=lower_bound+int4proc(i)
1335 upper_bound=lower_bound+int4proc(fg_rank)
1336 lower_bound=lower_bound+1
1339 c---------------------------------------------------------------------------
1340 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1341 implicit real*8 (a-h,o-z)
1342 include 'DIMENSIONS'
1344 include 'COMMON.SETUP'
1345 integer total_ints,lower_bound,upper_bound
1346 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1347 nint=total_ints/nfgtasks1
1351 nexcess=total_ints-nint*nfgtasks1
1353 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1357 lower_bound=lower_bound+int4proc(i)
1359 upper_bound=lower_bound+int4proc(fg_rank1)
1360 lower_bound=lower_bound+1
1363 c---------------------------------------------------------------------------
1364 subroutine int_partition(int_index,lower_index,upper_index,atom,
1365 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1366 implicit real*8 (a-h,o-z)
1367 include 'DIMENSIONS'
1368 include 'COMMON.IOUNITS'
1369 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1370 & first_atom,last_atom,int_gr,jat_start,jat_end
1373 if (lprn) write (iout,*) 'int_index=',int_index
1374 int_index_old=int_index
1375 int_index=int_index+last_atom-first_atom+1
1377 & write (iout,*) 'int_index=',int_index,
1378 & ' int_index_old',int_index_old,
1379 & ' lower_index=',lower_index,
1380 & ' upper_index=',upper_index,
1381 & ' atom=',atom,' first_atom=',first_atom,
1382 & ' last_atom=',last_atom
1383 if (int_index.ge.lower_index) then
1385 if (at_start.eq.0) then
1387 jat_start=first_atom-1+lower_index-int_index_old
1389 jat_start=first_atom
1391 if (lprn) write (iout,*) 'jat_start',jat_start
1392 if (int_index.ge.upper_index) then
1394 jat_end=first_atom-1+upper_index-int_index_old
1399 if (lprn) write (iout,*) 'jat_end',jat_end
1404 c------------------------------------------------------------------------------
1405 subroutine hpb_partition
1406 implicit real*8 (a-h,o-z)
1407 include 'DIMENSIONS'
1411 include 'COMMON.SBRIDGE'
1412 include 'COMMON.IOUNITS'
1413 include 'COMMON.SETUP'
1415 call int_bounds(nhpb,link_start,link_end)
1416 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1417 & ' absolute rank',MyRank,
1418 & ' nhpb',nhpb,' link_start=',link_start,
1419 & ' link_end',link_end