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 c 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()
169 athet(j,i,ichir1,ichir2)=0.0D0
170 bthet(j,i,ichir1,ichir2)=0.0D0
190 gaussc(l,k,j,i)=0.0D0
203 v1(k,j,i,iblock)=0.0D0
204 v2(k,j,i,iblock)=0.0D0
213 v1c(1,l,i,j,k,iblock)=0.0D0
214 v1s(1,l,i,j,k,iblock)=0.0D0
215 v1c(2,l,i,j,k,iblock)=0.0D0
216 v1s(2,l,i,j,k,iblock)=0.0D0
220 v2c(m,l,i,j,k,iblock)=0.0D0
221 v2s(m,l,i,j,k,iblock)=0.0D0
232 C Initialize the bridge arrays
251 C Initialize variables used in minimization.
260 C Initialize the variables responsible for the mode of gradient storage.
265 C Initialize constants used to split the energy into long- and short-range
271 nprint_ene=nprint_ene-1
275 c-------------------------------------------------------------------------
277 implicit real*8 (a-h,o-z)
279 include 'COMMON.NAMES'
280 include 'COMMON.FFIELD'
282 &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH',
283 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
284 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
285 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
287 &'z','p','k','r','h','d','e','n','q','s','t','g',
288 &'a','y','w','v','l','i','f','m','c','x',
289 &'C','M','F','I','L','V','W','Y','A','G','T',
290 &'S','Q','N','E','D','H','R','K','P','X'/
291 data potname /'LJ','LJK','BP','GB','GBV'/
293 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
294 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
295 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
296 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ",
297 & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/
299 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
300 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
301 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
302 & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/
304 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
305 & 21,24,25,26,27,0,0,0/
307 c---------------------------------------------------------------------------
308 subroutine init_int_table
309 implicit real*8 (a-h,o-z)
313 integer blocklengths(15),displs(15)
315 include 'COMMON.CONTROL'
316 include 'COMMON.SETUP'
317 include 'COMMON.CHAIN'
318 include 'COMMON.INTERACT'
319 include 'COMMON.LOCAL'
320 include 'COMMON.SBRIDGE'
321 include 'COMMON.TORCNSTR'
322 include 'COMMON.IOUNITS'
323 include 'COMMON.DERIV'
324 include 'COMMON.CONTACTS'
325 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
326 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
327 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
328 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
329 & ielend_all(maxres,0:MaxProcs-1),
330 & ntask_cont_from_all(0:max_fg_procs-1),
331 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
332 & ntask_cont_to_all(0:max_fg_procs-1),
333 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
334 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
335 logical scheck,lprint,flag
337 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
338 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
339 C... Determine the numbers of start and end SC-SC interaction
340 C... to deal with by current processor.
342 itask_cont_from(i)=fg_rank
343 itask_cont_to(i)=fg_rank
347 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
348 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
349 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
351 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
352 & ' absolute rank',MyRank,
353 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
354 & ' my_sc_inde',my_sc_inde
374 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
375 cd & (ihpb(i),jhpb(i),i=1,nss)
379 if (ihpb(ii).eq.i+nres) then
386 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
390 c write (iout,*) 'jj=i+1'
391 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
392 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
398 else if (jj.eq.nct) then
400 c write (iout,*) 'jj=nct'
401 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
402 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
410 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
411 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
413 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
414 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
425 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
426 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
431 ind_scint=ind_scint+nct-i
435 ind_scint_old=ind_scint
444 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
445 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
448 write (iout,'(a)') 'Interaction array:'
450 write (iout,'(i3,2(2x,2i3))')
451 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
456 C Now partition the electrostatic-interaction array
458 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
459 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
461 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
462 & ' absolute rank',MyRank,
463 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
464 & ' my_ele_inde',my_ele_inde
471 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
472 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
475 if (iatel_s.eq.0) iatel_s=1
476 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
477 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
478 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
479 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
480 c & " my_ele_inde_vdw",my_ele_inde_vdw
487 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
489 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
491 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
492 c & " ielend_vdw",ielend_vdw(i)
494 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
505 do i=iatel_s_vdw,iatel_e_vdw
511 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
512 & ' absolute rank',MyRank
513 write (iout,*) 'Electrostatic interaction array:'
515 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
520 C Partition the SC-p interaction array
522 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
523 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
524 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
525 & ' absolute rank',myrank,
526 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
527 & ' my_scp_inde',my_scp_inde
533 if (i.lt.nnt+iscp) then
534 cd write (iout,*) 'i.le.nnt+iscp'
535 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
536 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
538 else if (i.gt.nct-iscp) then
539 cd write (iout,*) 'i.gt.nct-iscp'
540 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
541 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
544 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
545 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
548 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
549 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
558 if (i.lt.nnt+iscp) then
560 iscpstart(i,1)=i+iscp
562 elseif (i.gt.nct-iscp) then
570 iscpstart(i,2)=i+iscp
576 write (iout,'(a)') 'SC-p interaction array:'
577 do i=iatscp_s,iatscp_e
578 write (iout,'(i3,2(2x,2i3))')
579 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
582 C Partition local interactions
584 call int_bounds(nres-2,loc_start,loc_end)
585 loc_start=loc_start+1
587 call int_bounds(nres-2,ithet_start,ithet_end)
588 ithet_start=ithet_start+2
589 ithet_end=ithet_end+2
590 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
591 iturn3_start=iturn3_start+nnt
592 iphi_start=iturn3_start+2
593 iturn3_end=iturn3_end+nnt
594 iphi_end=iturn3_end+2
595 iturn3_start=iturn3_start-1
596 iturn3_end=iturn3_end-1
597 call int_bounds(nres-3,iphi1_start,iphi1_end)
598 iphi1_start=iphi1_start+3
599 iphi1_end=iphi1_end+3
600 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
601 iturn4_start=iturn4_start+nnt
602 iphid_start=iturn4_start+2
603 iturn4_end=iturn4_end+nnt
604 iphid_end=iturn4_end+2
605 iturn4_start=iturn4_start-1
606 iturn4_end=iturn4_end-1
607 call int_bounds(nres-2,ibond_start,ibond_end)
608 ibond_start=ibond_start+1
609 ibond_end=ibond_end+1
610 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
611 ibondp_start=ibondp_start+nnt
612 ibondp_end=ibondp_end+nnt
613 call int_bounds1(nres-1,ivec_start,ivec_end)
614 print *,"Processor",myrank,fg_rank,fg_rank1,
615 & " ivec_start",ivec_start," ivec_end",ivec_end
616 iset_start=loc_start+2
618 if (ndih_constr.eq.0) then
622 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
624 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
626 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
627 igrad_start=((2*nlen+1)
628 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
629 jgrad_start(igrad_start)=
630 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
632 jgrad_end(igrad_start)=nres
633 igrad_end=((2*nlen+1)
634 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
635 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
636 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
638 do i=igrad_start+1,igrad_end-1
643 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
644 & ' absolute rank',myrank,
645 & ' loc_start',loc_start,' loc_end',loc_end,
646 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
647 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
648 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
649 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
650 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
651 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
652 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
653 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
654 & ' iset_start',iset_start,' iset_end',iset_end,
655 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
657 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
658 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
659 & ' ngrad_end',ngrad_end
660 do i=igrad_start,igrad_end
661 write(*,*) 'Processor:',fg_rank,myrank,i,
662 & jgrad_start(i),jgrad_end(i)
665 if (nfgtasks.gt.1) then
666 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
667 & MPI_INTEGER,FG_COMM1,IERROR)
668 iaux=ivec_end-ivec_start+1
669 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
670 & MPI_INTEGER,FG_COMM1,IERROR)
671 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
672 & MPI_INTEGER,FG_COMM,IERROR)
673 iaux=iset_end-iset_start+1
674 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
675 & MPI_INTEGER,FG_COMM,IERROR)
676 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
677 & MPI_INTEGER,FG_COMM,IERROR)
678 iaux=ibond_end-ibond_start+1
679 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
680 & MPI_INTEGER,FG_COMM,IERROR)
681 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
682 & MPI_INTEGER,FG_COMM,IERROR)
683 iaux=ithet_end-ithet_start+1
684 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
685 & MPI_INTEGER,FG_COMM,IERROR)
686 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
687 & MPI_INTEGER,FG_COMM,IERROR)
688 iaux=iphi_end-iphi_start+1
689 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
690 & MPI_INTEGER,FG_COMM,IERROR)
691 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
692 & MPI_INTEGER,FG_COMM,IERROR)
693 iaux=iphi1_end-iphi1_start+1
694 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
702 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
703 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
704 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
705 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
706 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
707 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
708 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
709 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
710 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
711 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
712 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
713 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
714 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
715 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
716 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
717 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
719 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
720 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
721 write (iout,*) "iturn3_start_all",
722 & (iturn3_start_all(i),i=0,nfgtasks-1)
723 write (iout,*) "iturn3_end_all",
724 & (iturn3_end_all(i),i=0,nfgtasks-1)
725 write (iout,*) "iturn4_start_all",
726 & (iturn4_start_all(i),i=0,nfgtasks-1)
727 write (iout,*) "iturn4_end_all",
728 & (iturn4_end_all(i),i=0,nfgtasks-1)
729 write (iout,*) "The ielstart_all array"
731 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
733 write (iout,*) "The ielend_all array"
735 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
741 itask_cont_from(0)=fg_rank
742 itask_cont_to(0)=fg_rank
744 do ii=iturn3_start,iturn3_end
745 call add_int(ii,ii+2,iturn3_sent(1,ii),
746 & ntask_cont_to,itask_cont_to,flag)
748 do ii=iturn4_start,iturn4_end
749 call add_int(ii,ii+3,iturn4_sent(1,ii),
750 & ntask_cont_to,itask_cont_to,flag)
752 do ii=iturn3_start,iturn3_end
753 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
755 do ii=iturn4_start,iturn4_end
756 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
759 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
760 & " ntask_cont_to",ntask_cont_to
761 write (iout,*) "itask_cont_from",
762 & (itask_cont_from(i),i=1,ntask_cont_from)
763 write (iout,*) "itask_cont_to",
764 & (itask_cont_to(i),i=1,ntask_cont_to)
767 c write (iout,*) "Loop forward"
770 c write (iout,*) "from loop i=",i
772 do j=ielstart(i),ielend(i)
773 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
776 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
777 c & " iatel_e",iatel_e
781 c write (iout,*) "i",i," ielstart",ielstart(i),
782 c & " ielend",ielend(i)
785 do j=ielstart(i),ielend(i)
786 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
787 & itask_cont_to,flag)
795 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
796 & " ntask_cont_to",ntask_cont_to
797 write (iout,*) "itask_cont_from",
798 & (itask_cont_from(i),i=1,ntask_cont_from)
799 write (iout,*) "itask_cont_to",
800 & (itask_cont_to(i),i=1,ntask_cont_to)
802 write (iout,*) "iint_sent"
805 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
806 & j=ielstart(ii),ielend(ii))
808 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
809 & " iturn3_end",iturn3_end
810 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
811 & i=iturn3_start,iturn3_end)
812 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
813 & " iturn4_end",iturn4_end
814 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
815 & i=iturn4_start,iturn4_end)
818 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
819 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
820 c write (iout,*) "Gather ntask_cont_from ended"
822 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
823 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
825 c write (iout,*) "Gather itask_cont_from ended"
827 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
828 & 1,MPI_INTEGER,king,FG_COMM,IERR)
829 c write (iout,*) "Gather ntask_cont_to ended"
831 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
832 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
833 c write (iout,*) "Gather itask_cont_to ended"
835 if (fg_rank.eq.king) then
836 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
838 write (iout,'(20i4)') i,ntask_cont_from_all(i),
839 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
843 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
845 write (iout,'(20i4)') i,ntask_cont_to_all(i),
846 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
850 C Check if every send will have a matching receive
854 ncheck_to=ncheck_to+ntask_cont_to_all(i)
855 ncheck_from=ncheck_from+ntask_cont_from_all(i)
857 write (iout,*) "Control sums",ncheck_from,ncheck_to
858 if (ncheck_from.ne.ncheck_to) then
859 write (iout,*) "Error: #receive differs from #send."
860 write (iout,*) "Terminating program...!"
866 do j=1,ntask_cont_to_all(i)
867 ii=itask_cont_to_all(j,i)
868 do k=1,ntask_cont_from_all(ii)
869 if (itask_cont_from_all(k,ii).eq.i) then
870 if(lprint)write(iout,*)"Matching send/receive",i,ii
874 if (k.eq.ntask_cont_from_all(ii)+1) then
876 write (iout,*) "Error: send by",j," to",ii,
877 & " would have no matching receive"
883 write (iout,*) "Unmatched sends; terminating program"
887 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
888 c write (iout,*) "flag broadcast ended flag=",flag
891 call MPI_Finalize(IERROR)
892 stop "Error in INIT_INT_TABLE: unmatched send/receive."
894 call MPI_Comm_group(FG_COMM,fg_group,IERR)
895 c write (iout,*) "MPI_Comm_group ended"
897 call MPI_Group_incl(fg_group,ntask_cont_from+1,
898 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
899 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
900 & CONT_TO_GROUP,IERR)
903 iaux=4*(ielend(ii)-ielstart(ii)+1)
904 call MPI_Group_translate_ranks(fg_group,iaux,
905 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
906 & iint_sent_local(1,ielstart(ii),i),IERR )
907 c write (iout,*) "Ranks translated i=",i
910 iaux=4*(iturn3_end-iturn3_start+1)
911 call MPI_Group_translate_ranks(fg_group,iaux,
912 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
913 & iturn3_sent_local(1,iturn3_start),IERR)
914 iaux=4*(iturn4_end-iturn4_start+1)
915 call MPI_Group_translate_ranks(fg_group,iaux,
916 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
917 & iturn4_sent_local(1,iturn4_start),IERR)
919 write (iout,*) "iint_sent_local"
922 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
923 & j=ielstart(ii),ielend(ii))
926 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
927 & " iturn3_end",iturn3_end
928 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
929 & i=iturn3_start,iturn3_end)
930 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
931 & " iturn4_end",iturn4_end
932 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
933 & i=iturn4_start,iturn4_end)
936 call MPI_Group_free(fg_group,ierr)
937 call MPI_Group_free(cont_from_group,ierr)
938 call MPI_Group_free(cont_to_group,ierr)
939 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
940 call MPI_Type_commit(MPI_UYZ,IERROR)
941 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
943 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
944 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
945 call MPI_Type_commit(MPI_MU,IERROR)
946 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
947 call MPI_Type_commit(MPI_MAT1,IERROR)
948 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
949 call MPI_Type_commit(MPI_MAT2,IERROR)
950 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
951 call MPI_Type_commit(MPI_THET,IERROR)
952 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
953 call MPI_Type_commit(MPI_GAM,IERROR)
955 c 9/22/08 Derived types to send matrices which appear in correlation terms
957 if (ivec_count(i).eq.ivec_count(0)) then
963 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
964 if (ind_typ.eq.0) then
974 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
977 c blocklengths(i)=blocklengths(i)*ichunk
979 c write (iout,*) "blocklengths and displs"
981 c write (iout,*) i,blocklengths(i),displs(i)
984 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
985 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
986 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
987 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
993 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
996 c blocklengths(i)=blocklengths(i)*ichunk
998 c write (iout,*) "blocklengths and displs"
1000 c write (iout,*) i,blocklengths(i),displs(i)
1003 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1004 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1005 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1006 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1012 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1015 blocklengths(i)=blocklengths(i)*ichunk
1017 call MPI_Type_indexed(8,blocklengths,displs,
1018 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1019 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1025 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1028 blocklengths(i)=blocklengths(i)*ichunk
1030 call MPI_Type_indexed(8,blocklengths,displs,
1031 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1032 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1038 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1041 blocklengths(i)=blocklengths(i)*ichunk
1043 call MPI_Type_indexed(6,blocklengths,displs,
1044 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1045 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1051 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1054 blocklengths(i)=blocklengths(i)*ichunk
1056 call MPI_Type_indexed(2,blocklengths,displs,
1057 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1058 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1064 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1067 blocklengths(i)=blocklengths(i)*ichunk
1069 call MPI_Type_indexed(4,blocklengths,displs,
1070 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1071 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1075 iint_start=ivec_start+1
1078 iint_count(i)=ivec_count(i)
1079 iint_displ(i)=ivec_displ(i)
1080 ivec_displ(i)=ivec_displ(i)-1
1081 iset_displ(i)=iset_displ(i)-1
1082 ithet_displ(i)=ithet_displ(i)-1
1083 iphi_displ(i)=iphi_displ(i)-1
1084 iphi1_displ(i)=iphi1_displ(i)-1
1085 ibond_displ(i)=ibond_displ(i)-1
1087 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1088 & .and. (me.eq.0 .or. out1file)) then
1089 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1091 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1094 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1095 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1096 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1098 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1101 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1102 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1103 & ' SC-p interactions','were distributed among',nfgtasks,
1104 & ' fine-grain processors.'
1120 idihconstr_end=ndih_constr
1121 iphid_start=iphi_start
1122 iphid_end=iphi_end-1
1137 c---------------------------------------------------------------------------
1138 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1140 include "DIMENSIONS"
1141 include "COMMON.INTERACT"
1142 include "COMMON.SETUP"
1143 include "COMMON.IOUNITS"
1144 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1146 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1147 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1148 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1149 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1150 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1151 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1152 & ielend_all(maxres,0:MaxProcs-1)
1153 integer iproc,isent,k,l
1154 c Determines whether to send interaction ii,jj to other processors; a given
1155 c interaction can be sent to at most 2 processors.
1156 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1157 c one processor, otherwise flag is unchanged from the input value.
1163 c write (iout,*) "ii",ii," jj",jj
1164 c Loop over processors to check if anybody could need interaction ii,jj
1165 do iproc=0,fg_rank-1
1166 c Check if the interaction matches any turn3 at iproc
1167 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1169 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1170 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1172 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1175 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1176 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1179 call add_task(iproc,ntask_cont_to,itask_cont_to)
1183 C Check if the interaction matches any turn4 at iproc
1184 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1186 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1187 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1189 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1192 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1193 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1196 call add_task(iproc,ntask_cont_to,itask_cont_to)
1200 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1201 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1202 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1203 & ielend_all(ii-1,iproc).ge.jj-1) then
1205 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1206 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1209 call add_task(iproc,ntask_cont_to,itask_cont_to)
1212 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1213 & ielend_all(ii-1,iproc).ge.jj+1) then
1215 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1216 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1219 call add_task(iproc,ntask_cont_to,itask_cont_to)
1226 c---------------------------------------------------------------------------
1227 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1229 include "DIMENSIONS"
1230 include "COMMON.INTERACT"
1231 include "COMMON.SETUP"
1232 include "COMMON.IOUNITS"
1233 integer ii,jj,itask(2),ntask_cont_from,
1234 & itask_cont_from(0:MaxProcs-1)
1236 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1237 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1238 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1239 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1240 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1241 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1242 & ielend_all(maxres,0:MaxProcs-1)
1244 do iproc=fg_rank+1,nfgtasks-1
1245 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1247 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1248 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1250 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1251 call add_task(iproc,ntask_cont_from,itask_cont_from)
1254 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1256 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1257 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1259 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1260 call add_task(iproc,ntask_cont_from,itask_cont_from)
1263 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1264 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1266 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1267 & jj+1.le.ielend_all(ii+1,iproc)) then
1268 call add_task(iproc,ntask_cont_from,itask_cont_from)
1270 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1271 & jj-1.le.ielend_all(ii+1,iproc)) then
1272 call add_task(iproc,ntask_cont_from,itask_cont_from)
1275 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1277 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1278 & jj-1.le.ielend_all(ii-1,iproc)) then
1279 call add_task(iproc,ntask_cont_from,itask_cont_from)
1281 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1282 & jj+1.le.ielend_all(ii-1,iproc)) then
1283 call add_task(iproc,ntask_cont_from,itask_cont_from)
1290 c---------------------------------------------------------------------------
1291 subroutine add_task(iproc,ntask_cont,itask_cont)
1293 include "DIMENSIONS"
1294 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1297 if (itask_cont(ii).eq.iproc) return
1299 ntask_cont=ntask_cont+1
1300 itask_cont(ntask_cont)=iproc
1303 c---------------------------------------------------------------------------
1304 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1305 implicit real*8 (a-h,o-z)
1306 include 'DIMENSIONS'
1308 include 'COMMON.SETUP'
1309 integer total_ints,lower_bound,upper_bound
1310 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1311 nint=total_ints/nfgtasks
1315 nexcess=total_ints-nint*nfgtasks
1317 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1321 lower_bound=lower_bound+int4proc(i)
1323 upper_bound=lower_bound+int4proc(fg_rank)
1324 lower_bound=lower_bound+1
1327 c---------------------------------------------------------------------------
1328 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1329 implicit real*8 (a-h,o-z)
1330 include 'DIMENSIONS'
1332 include 'COMMON.SETUP'
1333 integer total_ints,lower_bound,upper_bound
1334 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1335 nint=total_ints/nfgtasks1
1339 nexcess=total_ints-nint*nfgtasks1
1341 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1345 lower_bound=lower_bound+int4proc(i)
1347 upper_bound=lower_bound+int4proc(fg_rank1)
1348 lower_bound=lower_bound+1
1351 c---------------------------------------------------------------------------
1352 subroutine int_partition(int_index,lower_index,upper_index,atom,
1353 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1354 implicit real*8 (a-h,o-z)
1355 include 'DIMENSIONS'
1356 include 'COMMON.IOUNITS'
1357 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1358 & first_atom,last_atom,int_gr,jat_start,jat_end
1361 if (lprn) write (iout,*) 'int_index=',int_index
1362 int_index_old=int_index
1363 int_index=int_index+last_atom-first_atom+1
1365 & write (iout,*) 'int_index=',int_index,
1366 & ' int_index_old',int_index_old,
1367 & ' lower_index=',lower_index,
1368 & ' upper_index=',upper_index,
1369 & ' atom=',atom,' first_atom=',first_atom,
1370 & ' last_atom=',last_atom
1371 if (int_index.ge.lower_index) then
1373 if (at_start.eq.0) then
1375 jat_start=first_atom-1+lower_index-int_index_old
1377 jat_start=first_atom
1379 if (lprn) write (iout,*) 'jat_start',jat_start
1380 if (int_index.ge.upper_index) then
1382 jat_end=first_atom-1+upper_index-int_index_old
1387 if (lprn) write (iout,*) 'jat_end',jat_end
1392 c------------------------------------------------------------------------------
1393 subroutine hpb_partition
1394 implicit real*8 (a-h,o-z)
1395 include 'DIMENSIONS'
1399 include 'COMMON.SBRIDGE'
1400 include 'COMMON.IOUNITS'
1401 include 'COMMON.SETUP'
1402 include 'COMMON.CONTROL'
1404 call int_bounds(nhpb,link_start,link_end)
1406 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1407 & ' absolute rank',MyRank,
1408 & ' nhpb',nhpb,' link_start=',link_start,
1409 & ' link_end',link_end