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'/
63 C The following is just to define auxiliary variables used in angle conversion
102 crc for write_rmsbank1
104 cdr include secondary structure prediction bias
107 C CSA I/O units (separated from others especially for Jooyoung)
118 icsa_bank_reminimized=38
121 crc for ifc error 118
124 C Set default weights of the energy terms.
135 print '(a,$)','Inside initialize'
136 c call memmon_print_usage()
186 gaussc(l,k,j,i)=0.0D0
207 C Initialize the bridge arrays
226 C Initialize variables used in minimization.
235 C Initialize the variables responsible for the mode of gradient storage.
240 C Initialize constants used to split the energy into long- and short-range
246 nprint_ene=nprint_ene-1
250 c-------------------------------------------------------------------------
252 implicit real*8 (a-h,o-z)
254 include 'COMMON.NAMES'
255 include 'COMMON.FFIELD'
257 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
258 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
260 &'C','M','F','I','L','V','W','Y','A','G','T',
261 &'S','Q','N','E','D','H','R','K','P','X'/
262 data potname /'LJ','LJK','BP','GB','GBV'/
264 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
265 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
266 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
267 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
270 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
271 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
272 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
275 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
278 c---------------------------------------------------------------------------
279 subroutine init_int_table
280 implicit real*8 (a-h,o-z)
284 integer blocklengths(15),displs(15)
286 include 'COMMON.CONTROL'
287 include 'COMMON.SETUP'
288 include 'COMMON.CHAIN'
289 include 'COMMON.INTERACT'
290 include 'COMMON.LOCAL'
291 include 'COMMON.SBRIDGE'
292 include 'COMMON.TORCNSTR'
293 include 'COMMON.IOUNITS'
294 include 'COMMON.DERIV'
295 include 'COMMON.CONTACTS'
297 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
298 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
299 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
300 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
301 & ielend_all(maxres,0:max_fg_procs-1),
302 & ntask_cont_from_all(0:max_fg_procs-1),
303 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
304 & ntask_cont_to_all(0:max_fg_procs-1),
305 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
306 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
307 logical scheck,lprint,flag
309 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
310 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
311 C... Determine the numbers of start and end SC-SC interaction
312 C... to deal with by current processor.
314 itask_cont_from(i)=fg_rank
315 itask_cont_to(i)=fg_rank
319 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
320 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
321 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
323 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
324 & ' absolute rank',MyRank,
325 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
326 & ' my_sc_inde',my_sc_inde
346 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
347 cd & (ihpb(i),jhpb(i),i=1,nss)
352 if (ihpb(ii).eq.i+nres) then
359 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
363 c write (iout,*) 'jj=i+1'
364 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
365 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
371 else if (jj.eq.nct) then
373 c write (iout,*) 'jj=nct'
374 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
375 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
383 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
384 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
386 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
387 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
398 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
399 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
404 ind_scint=ind_scint+nct-i
408 ind_scint_old=ind_scint
417 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
418 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
421 write (iout,'(a)') 'Interaction array:'
423 write (iout,'(i3,2(2x,2i3))')
424 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
429 C Now partition the electrostatic-interaction array
431 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
432 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
434 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
435 & ' absolute rank',MyRank,
436 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
437 & ' my_ele_inde',my_ele_inde
444 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
445 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
448 if (iatel_s.eq.0) iatel_s=1
449 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
450 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
451 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
452 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
453 c & " my_ele_inde_vdw",my_ele_inde_vdw
460 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
462 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
464 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
465 c & " ielend_vdw",ielend_vdw(i)
467 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
478 do i=iatel_s_vdw,iatel_e_vdw
484 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
485 & ' absolute rank',MyRank
486 write (iout,*) 'Electrostatic interaction array:'
488 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
493 C Partition the SC-p interaction array
495 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
496 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
497 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
498 & ' absolute rank',myrank,
499 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
500 & ' my_scp_inde',my_scp_inde
506 if (i.lt.nnt+iscp) then
507 cd write (iout,*) 'i.le.nnt+iscp'
508 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
509 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
511 else if (i.gt.nct-iscp) then
512 cd write (iout,*) 'i.gt.nct-iscp'
513 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
514 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
517 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
518 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
521 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
522 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
531 if (i.lt.nnt+iscp) then
533 iscpstart(i,1)=i+iscp
535 elseif (i.gt.nct-iscp) then
543 iscpstart(i,2)=i+iscp
549 write (iout,'(a)') 'SC-p interaction array:'
550 do i=iatscp_s,iatscp_e
551 write (iout,'(i3,2(2x,2i3))')
552 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
555 C Partition local interactions
557 call int_bounds(nres-2,loc_start,loc_end)
558 loc_start=loc_start+1
560 call int_bounds(nres-2,ithet_start,ithet_end)
561 ithet_start=ithet_start+2
562 ithet_end=ithet_end+2
563 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
564 iturn3_start=iturn3_start+nnt
565 iphi_start=iturn3_start+2
566 iturn3_end=iturn3_end+nnt
567 iphi_end=iturn3_end+2
568 iturn3_start=iturn3_start-1
569 iturn3_end=iturn3_end-1
570 call int_bounds(nres-3,itau_start,itau_end)
571 itau_start=itau_start+3
573 call int_bounds(nres-3,iphi1_start,iphi1_end)
574 iphi1_start=iphi1_start+3
575 iphi1_end=iphi1_end+3
576 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
577 iturn4_start=iturn4_start+nnt
578 iphid_start=iturn4_start+2
579 iturn4_end=iturn4_end+nnt
580 iphid_end=iturn4_end+2
581 iturn4_start=iturn4_start-1
582 iturn4_end=iturn4_end-1
583 call int_bounds(nres-2,ibond_start,ibond_end)
584 ibond_start=ibond_start+1
585 ibond_end=ibond_end+1
586 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
587 ibondp_start=ibondp_start+nnt
588 ibondp_end=ibondp_end+nnt
589 call int_bounds1(nres-1,ivec_start,ivec_end)
590 print *,"Processor",myrank,fg_rank,fg_rank1,
591 & " ivec_start",ivec_start," ivec_end",ivec_end
592 iset_start=loc_start+2
594 if (ndih_constr.eq.0) then
598 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
600 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
602 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
603 igrad_start=((2*nlen+1)
604 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
605 jgrad_start(igrad_start)=
606 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
608 jgrad_end(igrad_start)=nres
609 igrad_end=((2*nlen+1)
610 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
611 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
612 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
614 do i=igrad_start+1,igrad_end-1
619 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
620 & ' absolute rank',myrank,
621 & ' loc_start',loc_start,' loc_end',loc_end,
622 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
623 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
624 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
625 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
626 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
627 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
628 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
629 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
630 & ' iset_start',iset_start,' iset_end',iset_end,
631 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
633 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
634 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
635 & ' ngrad_end',ngrad_end
636 do i=igrad_start,igrad_end
637 write(*,*) 'Processor:',fg_rank,myrank,i,
638 & jgrad_start(i),jgrad_end(i)
641 if (nfgtasks.gt.1) then
642 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
643 & MPI_INTEGER,FG_COMM1,IERROR)
644 iaux=ivec_end-ivec_start+1
645 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
646 & MPI_INTEGER,FG_COMM1,IERROR)
647 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
648 & MPI_INTEGER,FG_COMM,IERROR)
649 iaux=iset_end-iset_start+1
650 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
651 & MPI_INTEGER,FG_COMM,IERROR)
652 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
653 & MPI_INTEGER,FG_COMM,IERROR)
654 iaux=ibond_end-ibond_start+1
655 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
656 & MPI_INTEGER,FG_COMM,IERROR)
657 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
658 & MPI_INTEGER,FG_COMM,IERROR)
659 iaux=ithet_end-ithet_start+1
660 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
661 & MPI_INTEGER,FG_COMM,IERROR)
662 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
663 & MPI_INTEGER,FG_COMM,IERROR)
664 iaux=iphi_end-iphi_start+1
665 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
666 & MPI_INTEGER,FG_COMM,IERROR)
667 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
668 & MPI_INTEGER,FG_COMM,IERROR)
669 iaux=iphi1_end-iphi1_start+1
670 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
671 & MPI_INTEGER,FG_COMM,IERROR)
678 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
679 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
680 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
681 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
682 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
683 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
685 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
687 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
688 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
689 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
690 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
691 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
692 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
693 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
695 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
696 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
697 write (iout,*) "iturn3_start_all",
698 & (iturn3_start_all(i),i=0,nfgtasks-1)
699 write (iout,*) "iturn3_end_all",
700 & (iturn3_end_all(i),i=0,nfgtasks-1)
701 write (iout,*) "iturn4_start_all",
702 & (iturn4_start_all(i),i=0,nfgtasks-1)
703 write (iout,*) "iturn4_end_all",
704 & (iturn4_end_all(i),i=0,nfgtasks-1)
705 write (iout,*) "The ielstart_all array"
707 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
709 write (iout,*) "The ielend_all array"
711 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
717 itask_cont_from(0)=fg_rank
718 itask_cont_to(0)=fg_rank
720 do ii=iturn3_start,iturn3_end
721 call add_int(ii,ii+2,iturn3_sent(1,ii),
722 & ntask_cont_to,itask_cont_to,flag)
724 do ii=iturn4_start,iturn4_end
725 call add_int(ii,ii+3,iturn4_sent(1,ii),
726 & ntask_cont_to,itask_cont_to,flag)
728 do ii=iturn3_start,iturn3_end
729 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
731 do ii=iturn4_start,iturn4_end
732 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
735 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
736 & " ntask_cont_to",ntask_cont_to
737 write (iout,*) "itask_cont_from",
738 & (itask_cont_from(i),i=1,ntask_cont_from)
739 write (iout,*) "itask_cont_to",
740 & (itask_cont_to(i),i=1,ntask_cont_to)
743 c write (iout,*) "Loop forward"
746 c write (iout,*) "from loop i=",i
748 do j=ielstart(i),ielend(i)
749 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
752 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
753 c & " iatel_e",iatel_e
757 c write (iout,*) "i",i," ielstart",ielstart(i),
758 c & " ielend",ielend(i)
761 do j=ielstart(i),ielend(i)
762 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
763 & itask_cont_to,flag)
771 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
772 & " ntask_cont_to",ntask_cont_to
773 write (iout,*) "itask_cont_from",
774 & (itask_cont_from(i),i=1,ntask_cont_from)
775 write (iout,*) "itask_cont_to",
776 & (itask_cont_to(i),i=1,ntask_cont_to)
778 write (iout,*) "iint_sent"
781 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
782 & j=ielstart(ii),ielend(ii))
784 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
785 & " iturn3_end",iturn3_end
786 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
787 & i=iturn3_start,iturn3_end)
788 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
789 & " iturn4_end",iturn4_end
790 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
791 & i=iturn4_start,iturn4_end)
794 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
795 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
796 c write (iout,*) "Gather ntask_cont_from ended"
798 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
799 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
801 c write (iout,*) "Gather itask_cont_from ended"
803 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
804 & 1,MPI_INTEGER,king,FG_COMM,IERR)
805 c write (iout,*) "Gather ntask_cont_to ended"
807 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
808 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
809 c write (iout,*) "Gather itask_cont_to ended"
811 if (fg_rank.eq.king) then
812 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
814 write (iout,'(20i4)') i,ntask_cont_from_all(i),
815 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
819 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
821 write (iout,'(20i4)') i,ntask_cont_to_all(i),
822 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
826 C Check if every send will have a matching receive
830 ncheck_to=ncheck_to+ntask_cont_to_all(i)
831 ncheck_from=ncheck_from+ntask_cont_from_all(i)
833 write (iout,*) "Control sums",ncheck_from,ncheck_to
834 if (ncheck_from.ne.ncheck_to) then
835 write (iout,*) "Error: #receive differs from #send."
836 write (iout,*) "Terminating program...!"
842 do j=1,ntask_cont_to_all(i)
843 ii=itask_cont_to_all(j,i)
844 do k=1,ntask_cont_from_all(ii)
845 if (itask_cont_from_all(k,ii).eq.i) then
846 if(lprint)write(iout,*)"Matching send/receive",i,ii
850 if (k.eq.ntask_cont_from_all(ii)+1) then
852 write (iout,*) "Error: send by",j," to",ii,
853 & " would have no matching receive"
859 write (iout,*) "Unmatched sends; terminating program"
863 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
864 c write (iout,*) "flag broadcast ended flag=",flag
867 call MPI_Finalize(IERROR)
868 stop "Error in INIT_INT_TABLE: unmatched send/receive."
870 call MPI_Comm_group(FG_COMM,fg_group,IERR)
871 c write (iout,*) "MPI_Comm_group ended"
873 call MPI_Group_incl(fg_group,ntask_cont_from+1,
874 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
875 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
876 & CONT_TO_GROUP,IERR)
879 iaux=4*(ielend(ii)-ielstart(ii)+1)
880 call MPI_Group_translate_ranks(fg_group,iaux,
881 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
882 & iint_sent_local(1,ielstart(ii),i),IERR )
883 c write (iout,*) "Ranks translated i=",i
886 iaux=4*(iturn3_end-iturn3_start+1)
887 call MPI_Group_translate_ranks(fg_group,iaux,
888 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
889 & iturn3_sent_local(1,iturn3_start),IERR)
890 iaux=4*(iturn4_end-iturn4_start+1)
891 call MPI_Group_translate_ranks(fg_group,iaux,
892 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
893 & iturn4_sent_local(1,iturn4_start),IERR)
895 write (iout,*) "iint_sent_local"
898 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
899 & j=ielstart(ii),ielend(ii))
902 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
903 & " iturn3_end",iturn3_end
904 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
905 & i=iturn3_start,iturn3_end)
906 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
907 & " iturn4_end",iturn4_end
908 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
909 & i=iturn4_start,iturn4_end)
912 call MPI_Group_free(fg_group,ierr)
913 call MPI_Group_free(cont_from_group,ierr)
914 call MPI_Group_free(cont_to_group,ierr)
915 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
916 call MPI_Type_commit(MPI_UYZ,IERROR)
917 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
919 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
920 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
921 call MPI_Type_commit(MPI_MU,IERROR)
922 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
923 call MPI_Type_commit(MPI_MAT1,IERROR)
924 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
925 call MPI_Type_commit(MPI_MAT2,IERROR)
926 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
927 call MPI_Type_commit(MPI_THET,IERROR)
928 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
929 call MPI_Type_commit(MPI_GAM,IERROR)
931 c 9/22/08 Derived types to send matrices which appear in correlation terms
933 if (ivec_count(i).eq.ivec_count(0)) then
939 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
940 if (ind_typ.eq.0) then
950 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
953 c blocklengths(i)=blocklengths(i)*ichunk
955 c write (iout,*) "blocklengths and displs"
957 c write (iout,*) i,blocklengths(i),displs(i)
960 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
961 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
962 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
963 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
969 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
972 c blocklengths(i)=blocklengths(i)*ichunk
974 c write (iout,*) "blocklengths and displs"
976 c write (iout,*) i,blocklengths(i),displs(i)
979 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
980 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
981 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
982 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
988 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
991 blocklengths(i)=blocklengths(i)*ichunk
993 call MPI_Type_indexed(8,blocklengths,displs,
994 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
995 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1001 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1004 blocklengths(i)=blocklengths(i)*ichunk
1006 call MPI_Type_indexed(8,blocklengths,displs,
1007 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1008 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1014 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1017 blocklengths(i)=blocklengths(i)*ichunk
1019 call MPI_Type_indexed(6,blocklengths,displs,
1020 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1021 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1027 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1030 blocklengths(i)=blocklengths(i)*ichunk
1032 call MPI_Type_indexed(2,blocklengths,displs,
1033 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1034 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1040 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1043 blocklengths(i)=blocklengths(i)*ichunk
1045 call MPI_Type_indexed(4,blocklengths,displs,
1046 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1047 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1051 iint_start=ivec_start+1
1054 iint_count(i)=ivec_count(i)
1055 iint_displ(i)=ivec_displ(i)
1056 ivec_displ(i)=ivec_displ(i)-1
1057 iset_displ(i)=iset_displ(i)-1
1058 ithet_displ(i)=ithet_displ(i)-1
1059 iphi_displ(i)=iphi_displ(i)-1
1060 iphi1_displ(i)=iphi1_displ(i)-1
1061 ibond_displ(i)=ibond_displ(i)-1
1063 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1064 & .and. (me.eq.0 .or. out1file)) then
1065 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1067 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1070 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1071 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1072 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1074 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1077 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1078 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1079 & ' SC-p interactions','were distributed among',nfgtasks,
1080 & ' fine-grain processors.'
1096 idihconstr_end=ndih_constr
1097 iphid_start=iphi_start
1098 iphid_end=iphi_end-1
1115 c---------------------------------------------------------------------------
1116 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1118 include "DIMENSIONS"
1119 include "COMMON.INTERACT"
1120 include "COMMON.SETUP"
1121 include "COMMON.IOUNITS"
1122 integer ii,jj,itask(4),
1123 & ntask_cont_to,itask_cont_to(0:max_fg_procs-1)
1125 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1126 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1127 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1128 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1129 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1130 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1131 & ielend_all(maxres,0:max_fg_procs-1)
1132 integer iproc,isent,k,l
1133 c Determines whether to send interaction ii,jj to other processors; a given
1134 c interaction can be sent to at most 2 processors.
1135 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1136 c one processor, otherwise flag is unchanged from the input value.
1142 c write (iout,*) "ii",ii," jj",jj
1143 c Loop over processors to check if anybody could need interaction ii,jj
1144 do iproc=0,fg_rank-1
1145 c Check if the interaction matches any turn3 at iproc
1146 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1148 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1149 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1151 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1154 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1155 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1158 call add_task(iproc,ntask_cont_to,itask_cont_to)
1162 C Check if the interaction matches any turn4 at iproc
1163 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1165 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1166 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1168 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1171 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1172 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1175 call add_task(iproc,ntask_cont_to,itask_cont_to)
1179 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1180 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1181 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1182 & ielend_all(ii-1,iproc).ge.jj-1) then
1184 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1185 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1188 call add_task(iproc,ntask_cont_to,itask_cont_to)
1191 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1192 & ielend_all(ii-1,iproc).ge.jj+1) then
1194 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1195 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1198 call add_task(iproc,ntask_cont_to,itask_cont_to)
1205 c---------------------------------------------------------------------------
1206 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1208 include "DIMENSIONS"
1209 include "COMMON.INTERACT"
1210 include "COMMON.SETUP"
1211 include "COMMON.IOUNITS"
1212 integer ii,jj,itask(2),ntask_cont_from,
1213 & itask_cont_from(0:max_fg_procs-1)
1215 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1216 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1217 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1218 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1219 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1220 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1221 & ielend_all(maxres,0:max_fg_procs-1)
1223 do iproc=fg_rank+1,nfgtasks-1
1224 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1226 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1227 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1229 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1230 call add_task(iproc,ntask_cont_from,itask_cont_from)
1233 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1235 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1236 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1238 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1239 call add_task(iproc,ntask_cont_from,itask_cont_from)
1242 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1243 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1245 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1246 & jj+1.le.ielend_all(ii+1,iproc)) then
1247 call add_task(iproc,ntask_cont_from,itask_cont_from)
1249 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1250 & jj-1.le.ielend_all(ii+1,iproc)) then
1251 call add_task(iproc,ntask_cont_from,itask_cont_from)
1254 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1256 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1257 & jj-1.le.ielend_all(ii-1,iproc)) then
1258 call add_task(iproc,ntask_cont_from,itask_cont_from)
1260 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1261 & jj+1.le.ielend_all(ii-1,iproc)) then
1262 call add_task(iproc,ntask_cont_from,itask_cont_from)
1269 c---------------------------------------------------------------------------
1270 subroutine add_task(iproc,ntask_cont,itask_cont)
1272 include "DIMENSIONS"
1273 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1276 if (itask_cont(ii).eq.iproc) return
1278 ntask_cont=ntask_cont+1
1279 itask_cont(ntask_cont)=iproc
1282 c---------------------------------------------------------------------------
1283 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1284 implicit real*8 (a-h,o-z)
1285 include 'DIMENSIONS'
1287 include 'COMMON.SETUP'
1288 integer total_ints,lower_bound,upper_bound
1289 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1290 nint=total_ints/nfgtasks
1294 nexcess=total_ints-nint*nfgtasks
1296 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1300 lower_bound=lower_bound+int4proc(i)
1302 upper_bound=lower_bound+int4proc(fg_rank)
1303 lower_bound=lower_bound+1
1306 c---------------------------------------------------------------------------
1307 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1308 implicit real*8 (a-h,o-z)
1309 include 'DIMENSIONS'
1311 include 'COMMON.SETUP'
1312 integer total_ints,lower_bound,upper_bound
1313 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1314 nint=total_ints/nfgtasks1
1318 nexcess=total_ints-nint*nfgtasks1
1320 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1324 lower_bound=lower_bound+int4proc(i)
1326 upper_bound=lower_bound+int4proc(fg_rank1)
1327 lower_bound=lower_bound+1
1330 c---------------------------------------------------------------------------
1331 subroutine int_partition(int_index,lower_index,upper_index,atom,
1332 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1333 implicit real*8 (a-h,o-z)
1334 include 'DIMENSIONS'
1335 include 'COMMON.IOUNITS'
1336 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1337 & first_atom,last_atom,int_gr,jat_start,jat_end
1340 if (lprn) write (iout,*) 'int_index=',int_index
1341 int_index_old=int_index
1342 int_index=int_index+last_atom-first_atom+1
1344 & write (iout,*) 'int_index=',int_index,
1345 & ' int_index_old',int_index_old,
1346 & ' lower_index=',lower_index,
1347 & ' upper_index=',upper_index,
1348 & ' atom=',atom,' first_atom=',first_atom,
1349 & ' last_atom=',last_atom
1350 if (int_index.ge.lower_index) then
1352 if (at_start.eq.0) then
1354 jat_start=first_atom-1+lower_index-int_index_old
1356 jat_start=first_atom
1358 if (lprn) write (iout,*) 'jat_start',jat_start
1359 if (int_index.ge.upper_index) then
1361 jat_end=first_atom-1+upper_index-int_index_old
1366 if (lprn) write (iout,*) 'jat_end',jat_end
1371 c------------------------------------------------------------------------------
1372 subroutine hpb_partition
1373 implicit real*8 (a-h,o-z)
1374 include 'DIMENSIONS'
1378 include 'COMMON.SBRIDGE'
1379 include 'COMMON.IOUNITS'
1380 include 'COMMON.SETUP'
1381 include 'COMMON.CONTROL'
1382 c write(2,*)"hpb_partition: nhpb=",nhpb
1384 call int_bounds(nhpb,link_start,link_end)
1386 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1387 & ' absolute rank',MyRank,
1388 & ' nhpb',nhpb,' link_start=',link_start,
1389 & ' link_end',link_end
1394 c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end
1397 c------------------------------------------------------------------------------
1398 subroutine homology_partition
1399 implicit real*8 (a-h,o-z)
1400 include 'DIMENSIONS'
1404 include 'COMMON.SBRIDGE'
1405 include 'COMMON.IOUNITS'
1406 include 'COMMON.SETUP'
1407 include 'COMMON.CONTROL'
1409 include 'COMMON.INTERACT'
1410 write(iout,*)"homology_partition: lim_odl=",lim_odl,
1411 & " lim_dih",lim_dih
1413 write (iout,*) "MPI"
1414 call int_bounds(lim_odl,link_start_homo,link_end_homo)
1415 call int_bounds(lim_dih-nnt+1,idihconstr_start_homo,
1416 & idihconstr_end_homo)
1417 idihconstr_start_homo=idihconstr_start_homo+nnt-1
1418 idihconstr_end_homo=idihconstr_end_homo+nnt-1
1419 if (me.eq.king .or. .not. out1file)
1420 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1421 & ' absolute rank',MyRank,
1422 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1423 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1424 & ' idihconstr_start_homo',idihconstr_start_homo,
1425 & ' idihconstr_end_homo',idihconstr_end_homo
1427 write (iout,*) "Not MPI"
1429 link_end_homo=lim_odl
1430 idihconstr_start_homo=nnt
1431 idihconstr_end_homo=lim_dih
1433 & ' lim_odl',lim_odl,' link_start=',link_start_homo,
1434 & ' link_end',link_end_homo,' lim_dih',lim_dih,
1435 & ' idihconstr_start_homo',idihconstr_start_homo,
1436 & ' idihconstr_end_homo',idihconstr_end_homo