2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
99 crc for write_rmsbank1
101 cdr include secondary structure prediction bias
104 C CSA I/O units (separated from others especially for Jooyoung)
115 icsa_bank_reminimized=38
118 crc for ifc error 118
121 C Set default weights of the energy terms.
132 c print '(a,$)','Inside initialize'
133 c call memmon_print_usage()
166 athet(j,i,ichir1,ichir2)=0.0D0
167 bthet(j,i,ichir1,ichir2)=0.0D0
187 gaussc(l,k,j,i)=0.0D0
197 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
201 v1(k,j,i,iblock)=0.0D0
202 v2(k,j,i,iblock)=0.0D0
212 v1c(1,l,i,j,k,iblock)=0.0D0
213 v1s(1,l,i,j,k,iblock)=0.0D0
214 v1c(2,l,i,j,k,iblock)=0.0D0
215 v1s(2,l,i,j,k,iblock)=0.0D0
219 v2c(m,l,i,j,k,iblock)=0.0D0
220 v2s(m,l,i,j,k,iblock)=0.0D0
232 C Initialize the bridge arrays
251 C Initialize variables used in minimization.
260 C Initialize the variables responsible for the mode of gradient storage.
265 C Initialize constants used to split the energy into long- and short-range
271 nprint_ene=nprint_ene-1
275 c-------------------------------------------------------------------------
277 implicit real*8 (a-h,o-z)
279 include 'COMMON.NAMES'
280 include 'COMMON.FFIELD'
282 &'DD' ,'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"/
298 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
299 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
300 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/
302 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
305 c---------------------------------------------------------------------------
306 subroutine init_int_table
307 implicit real*8 (a-h,o-z)
311 integer blocklengths(15),displs(15)
313 include 'COMMON.CONTROL'
314 include 'COMMON.SETUP'
315 include 'COMMON.CHAIN'
316 include 'COMMON.INTERACT'
317 include 'COMMON.LOCAL'
318 include 'COMMON.SBRIDGE'
319 include 'COMMON.TORCNSTR'
320 include 'COMMON.IOUNITS'
321 include 'COMMON.DERIV'
322 include 'COMMON.CONTACTS'
323 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
324 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
325 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
326 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
327 & ielend_all(maxres,0:MaxProcs-1),
328 & ntask_cont_from_all(0:max_fg_procs-1),
329 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
330 & ntask_cont_to_all(0:max_fg_procs-1),
331 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
332 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
333 logical scheck,lprint,flag
335 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
336 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
337 C... Determine the numbers of start and end SC-SC interaction
338 C... to deal with by current processor.
340 itask_cont_from(i)=fg_rank
341 itask_cont_to(i)=fg_rank
345 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
346 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
347 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
349 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
350 & ' absolute rank',MyRank,
351 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
352 & ' my_sc_inde',my_sc_inde
372 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
373 cd & (ihpb(i),jhpb(i),i=1,nss)
377 if (ihpb(ii).eq.i+nres) then
384 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
388 c write (iout,*) 'jj=i+1'
389 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
390 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
396 else if (jj.eq.nct) then
398 c write (iout,*) 'jj=nct'
399 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
400 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
408 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
409 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
411 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
412 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
423 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
424 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
429 ind_scint=ind_scint+nct-i
433 ind_scint_old=ind_scint
442 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
443 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
446 write (iout,'(a)') 'Interaction array:'
448 write (iout,'(i3,2(2x,2i3))')
449 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
454 C Now partition the electrostatic-interaction array
456 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
457 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
459 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
460 & ' absolute rank',MyRank,
461 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
462 & ' my_ele_inde',my_ele_inde
469 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
470 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
473 if (iatel_s.eq.0) iatel_s=1
474 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
475 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
476 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
477 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
478 c & " my_ele_inde_vdw",my_ele_inde_vdw
485 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
487 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
489 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
490 c & " ielend_vdw",ielend_vdw(i)
492 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
503 do i=iatel_s_vdw,iatel_e_vdw
509 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
510 & ' absolute rank',MyRank
511 write (iout,*) 'Electrostatic interaction array:'
513 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
518 C Partition the SC-p interaction array
520 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
521 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
522 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
523 & ' absolute rank',myrank,
524 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
525 & ' my_scp_inde',my_scp_inde
531 if (i.lt.nnt+iscp) then
532 cd write (iout,*) 'i.le.nnt+iscp'
533 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
534 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
536 else if (i.gt.nct-iscp) then
537 cd write (iout,*) 'i.gt.nct-iscp'
538 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
539 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
542 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
543 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
546 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
547 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
556 if (i.lt.nnt+iscp) then
558 iscpstart(i,1)=i+iscp
560 elseif (i.gt.nct-iscp) then
568 iscpstart(i,2)=i+iscp
574 write (iout,'(a)') 'SC-p interaction array:'
575 do i=iatscp_s,iatscp_e
576 write (iout,'(i3,2(2x,2i3))')
577 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
580 C Partition local interactions
582 call int_bounds(nres-2,loc_start,loc_end)
583 loc_start=loc_start+1
585 call int_bounds(nres-2,ithet_start,ithet_end)
586 ithet_start=ithet_start+2
587 ithet_end=ithet_end+2
588 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
589 iturn3_start=iturn3_start+nnt
590 iphi_start=iturn3_start+2
591 iturn3_end=iturn3_end+nnt
592 iphi_end=iturn3_end+2
593 iturn3_start=iturn3_start-1
594 iturn3_end=iturn3_end-1
595 call int_bounds(nres-3,itau_start,itau_end)
596 itau_start=itau_start+3
598 call int_bounds(nres-3,iphi1_start,iphi1_end)
599 iphi1_start=iphi1_start+3
600 iphi1_end=iphi1_end+3
601 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
602 iturn4_start=iturn4_start+nnt
603 iphid_start=iturn4_start+2
604 iturn4_end=iturn4_end+nnt
605 iphid_end=iturn4_end+2
606 iturn4_start=iturn4_start-1
607 iturn4_end=iturn4_end-1
608 call int_bounds(nres-2,ibond_start,ibond_end)
609 ibond_start=ibond_start+1
610 ibond_end=ibond_end+1
611 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
612 ibondp_start=ibondp_start+nnt
613 ibondp_end=ibondp_end+nnt
614 call int_bounds1(nres-1,ivec_start,ivec_end)
615 c print *,"Processor",myrank,fg_rank,fg_rank1,
616 c & " ivec_start",ivec_start," ivec_end",ivec_end
617 iset_start=loc_start+2
619 if (ndih_constr.eq.0) then
623 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
625 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
627 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
629 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
630 igrad_start=((2*nlen+1)
631 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
632 jgrad_start(igrad_start)=
633 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
635 jgrad_end(igrad_start)=nres
636 igrad_end=((2*nlen+1)
637 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
638 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
639 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
641 do i=igrad_start+1,igrad_end-1
646 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
647 & ' absolute rank',myrank,
648 & ' loc_start',loc_start,' loc_end',loc_end,
649 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
650 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
651 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
652 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
653 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
654 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
655 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
656 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
657 & ' iset_start',iset_start,' iset_end',iset_end,
658 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
660 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
661 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
662 & ' ngrad_end',ngrad_end
663 do i=igrad_start,igrad_end
664 write(*,*) 'Processor:',fg_rank,myrank,i,
665 & jgrad_start(i),jgrad_end(i)
668 if (nfgtasks.gt.1) then
669 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
670 & MPI_INTEGER,FG_COMM1,IERROR)
671 iaux=ivec_end-ivec_start+1
672 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
673 & MPI_INTEGER,FG_COMM1,IERROR)
674 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
675 & MPI_INTEGER,FG_COMM,IERROR)
676 iaux=iset_end-iset_start+1
677 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
678 & MPI_INTEGER,FG_COMM,IERROR)
679 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
680 & MPI_INTEGER,FG_COMM,IERROR)
681 iaux=ibond_end-ibond_start+1
682 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
683 & MPI_INTEGER,FG_COMM,IERROR)
684 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
685 & MPI_INTEGER,FG_COMM,IERROR)
686 iaux=ithet_end-ithet_start+1
687 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
688 & MPI_INTEGER,FG_COMM,IERROR)
689 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
690 & MPI_INTEGER,FG_COMM,IERROR)
691 iaux=iphi_end-iphi_start+1
692 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
693 & MPI_INTEGER,FG_COMM,IERROR)
694 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
695 & MPI_INTEGER,FG_COMM,IERROR)
696 iaux=iphi1_end-iphi1_start+1
697 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
698 & MPI_INTEGER,FG_COMM,IERROR)
705 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
706 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
707 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
708 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
709 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
710 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
711 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
712 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
713 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
714 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
715 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
716 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
717 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
718 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
719 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
720 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
722 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
723 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
724 write (iout,*) "iturn3_start_all",
725 & (iturn3_start_all(i),i=0,nfgtasks-1)
726 write (iout,*) "iturn3_end_all",
727 & (iturn3_end_all(i),i=0,nfgtasks-1)
728 write (iout,*) "iturn4_start_all",
729 & (iturn4_start_all(i),i=0,nfgtasks-1)
730 write (iout,*) "iturn4_end_all",
731 & (iturn4_end_all(i),i=0,nfgtasks-1)
732 write (iout,*) "The ielstart_all array"
734 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
736 write (iout,*) "The ielend_all array"
738 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
744 itask_cont_from(0)=fg_rank
745 itask_cont_to(0)=fg_rank
747 do ii=iturn3_start,iturn3_end
748 call add_int(ii,ii+2,iturn3_sent(1,ii),
749 & ntask_cont_to,itask_cont_to,flag)
751 do ii=iturn4_start,iturn4_end
752 call add_int(ii,ii+3,iturn4_sent(1,ii),
753 & ntask_cont_to,itask_cont_to,flag)
755 do ii=iturn3_start,iturn3_end
756 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
758 do ii=iturn4_start,iturn4_end
759 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
762 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
763 & " ntask_cont_to",ntask_cont_to
764 write (iout,*) "itask_cont_from",
765 & (itask_cont_from(i),i=1,ntask_cont_from)
766 write (iout,*) "itask_cont_to",
767 & (itask_cont_to(i),i=1,ntask_cont_to)
770 c write (iout,*) "Loop forward"
773 c write (iout,*) "from loop i=",i
775 do j=ielstart(i),ielend(i)
776 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
779 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
780 c & " iatel_e",iatel_e
784 c write (iout,*) "i",i," ielstart",ielstart(i),
785 c & " ielend",ielend(i)
788 do j=ielstart(i),ielend(i)
789 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
790 & itask_cont_to,flag)
798 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
799 & " ntask_cont_to",ntask_cont_to
800 write (iout,*) "itask_cont_from",
801 & (itask_cont_from(i),i=1,ntask_cont_from)
802 write (iout,*) "itask_cont_to",
803 & (itask_cont_to(i),i=1,ntask_cont_to)
805 write (iout,*) "iint_sent"
808 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
809 & j=ielstart(ii),ielend(ii))
811 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
812 & " iturn3_end",iturn3_end
813 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
814 & i=iturn3_start,iturn3_end)
815 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
816 & " iturn4_end",iturn4_end
817 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
818 & i=iturn4_start,iturn4_end)
821 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
822 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
823 c write (iout,*) "Gather ntask_cont_from ended"
825 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
826 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
828 c write (iout,*) "Gather itask_cont_from ended"
830 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
831 & 1,MPI_INTEGER,king,FG_COMM,IERR)
832 c write (iout,*) "Gather ntask_cont_to ended"
834 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
835 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
836 c write (iout,*) "Gather itask_cont_to ended"
838 if (fg_rank.eq.king) then
839 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
841 write (iout,'(20i4)') i,ntask_cont_from_all(i),
842 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
846 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
848 write (iout,'(20i4)') i,ntask_cont_to_all(i),
849 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
853 C Check if every send will have a matching receive
857 ncheck_to=ncheck_to+ntask_cont_to_all(i)
858 ncheck_from=ncheck_from+ntask_cont_from_all(i)
860 write (iout,*) "Control sums",ncheck_from,ncheck_to
861 if (ncheck_from.ne.ncheck_to) then
862 write (iout,*) "Error: #receive differs from #send."
863 write (iout,*) "Terminating program...!"
869 do j=1,ntask_cont_to_all(i)
870 ii=itask_cont_to_all(j,i)
871 do k=1,ntask_cont_from_all(ii)
872 if (itask_cont_from_all(k,ii).eq.i) then
873 if(lprint)write(iout,*)"Matching send/receive",i,ii
877 if (k.eq.ntask_cont_from_all(ii)+1) then
879 write (iout,*) "Error: send by",j," to",ii,
880 & " would have no matching receive"
886 write (iout,*) "Unmatched sends; terminating program"
890 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
891 c write (iout,*) "flag broadcast ended flag=",flag
894 call MPI_Finalize(IERROR)
895 stop "Error in INIT_INT_TABLE: unmatched send/receive."
897 call MPI_Comm_group(FG_COMM,fg_group,IERR)
898 c write (iout,*) "MPI_Comm_group ended"
900 call MPI_Group_incl(fg_group,ntask_cont_from+1,
901 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
902 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
903 & CONT_TO_GROUP,IERR)
906 iaux=4*(ielend(ii)-ielstart(ii)+1)
907 call MPI_Group_translate_ranks(fg_group,iaux,
908 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
909 & iint_sent_local(1,ielstart(ii),i),IERR )
910 c write (iout,*) "Ranks translated i=",i
913 iaux=4*(iturn3_end-iturn3_start+1)
914 call MPI_Group_translate_ranks(fg_group,iaux,
915 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
916 & iturn3_sent_local(1,iturn3_start),IERR)
917 iaux=4*(iturn4_end-iturn4_start+1)
918 call MPI_Group_translate_ranks(fg_group,iaux,
919 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
920 & iturn4_sent_local(1,iturn4_start),IERR)
922 write (iout,*) "iint_sent_local"
925 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
926 & j=ielstart(ii),ielend(ii))
929 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
930 & " iturn3_end",iturn3_end
931 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
932 & i=iturn3_start,iturn3_end)
933 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
934 & " iturn4_end",iturn4_end
935 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
936 & i=iturn4_start,iturn4_end)
939 call MPI_Group_free(fg_group,ierr)
940 call MPI_Group_free(cont_from_group,ierr)
941 call MPI_Group_free(cont_to_group,ierr)
942 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
943 call MPI_Type_commit(MPI_UYZ,IERROR)
944 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
946 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
947 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
948 call MPI_Type_commit(MPI_MU,IERROR)
949 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
950 call MPI_Type_commit(MPI_MAT1,IERROR)
951 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
952 call MPI_Type_commit(MPI_MAT2,IERROR)
953 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
954 call MPI_Type_commit(MPI_THET,IERROR)
955 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
956 call MPI_Type_commit(MPI_GAM,IERROR)
958 c 9/22/08 Derived types to send matrices which appear in correlation terms
960 if (ivec_count(i).eq.ivec_count(0)) then
966 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
967 if (ind_typ.eq.0) then
977 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
980 c blocklengths(i)=blocklengths(i)*ichunk
982 c write (iout,*) "blocklengths and displs"
984 c write (iout,*) i,blocklengths(i),displs(i)
987 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
988 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
989 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
990 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
996 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
999 c blocklengths(i)=blocklengths(i)*ichunk
1001 c write (iout,*) "blocklengths and displs"
1003 c write (iout,*) i,blocklengths(i),displs(i)
1006 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1007 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1008 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1009 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1015 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1018 blocklengths(i)=blocklengths(i)*ichunk
1020 call MPI_Type_indexed(8,blocklengths,displs,
1021 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1022 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1028 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1031 blocklengths(i)=blocklengths(i)*ichunk
1033 call MPI_Type_indexed(8,blocklengths,displs,
1034 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1035 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1041 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1044 blocklengths(i)=blocklengths(i)*ichunk
1046 call MPI_Type_indexed(6,blocklengths,displs,
1047 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1048 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1054 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1057 blocklengths(i)=blocklengths(i)*ichunk
1059 call MPI_Type_indexed(2,blocklengths,displs,
1060 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1061 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1067 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1070 blocklengths(i)=blocklengths(i)*ichunk
1072 call MPI_Type_indexed(4,blocklengths,displs,
1073 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1074 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1078 iint_start=ivec_start+1
1081 iint_count(i)=ivec_count(i)
1082 iint_displ(i)=ivec_displ(i)
1083 ivec_displ(i)=ivec_displ(i)-1
1084 iset_displ(i)=iset_displ(i)-1
1085 ithet_displ(i)=ithet_displ(i)-1
1086 iphi_displ(i)=iphi_displ(i)-1
1087 iphi1_displ(i)=iphi1_displ(i)-1
1088 ibond_displ(i)=ibond_displ(i)-1
1090 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1091 & .and. (me.eq.0 .or. .not. out1file)) then
1092 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1094 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1097 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1098 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1099 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1101 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1104 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1105 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1106 & ' SC-p interactions','were distributed among',nfgtasks,
1107 & ' fine-grain processors.'
1123 idihconstr_end=ndih_constr
1124 iphid_start=iphi_start
1125 iphid_end=iphi_end-1
1142 c---------------------------------------------------------------------------
1143 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1145 include "DIMENSIONS"
1146 include "COMMON.INTERACT"
1147 include "COMMON.SETUP"
1148 include "COMMON.IOUNITS"
1149 integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1)
1151 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1152 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1153 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1154 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1155 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1156 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1157 & ielend_all(maxres,0:MaxProcs-1)
1158 integer iproc,isent,k,l
1159 c Determines whether to send interaction ii,jj to other processors; a given
1160 c interaction can be sent to at most 2 processors.
1161 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1162 c one processor, otherwise flag is unchanged from the input value.
1168 c write (iout,*) "ii",ii," jj",jj
1169 c Loop over processors to check if anybody could need interaction ii,jj
1170 do iproc=0,fg_rank-1
1171 c Check if the interaction matches any turn3 at iproc
1172 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1174 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1175 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1177 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1180 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1181 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1184 call add_task(iproc,ntask_cont_to,itask_cont_to)
1188 C Check if the interaction matches any turn4 at iproc
1189 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1191 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1192 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1194 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1197 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1198 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1201 call add_task(iproc,ntask_cont_to,itask_cont_to)
1205 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1206 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1207 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1208 & ielend_all(ii-1,iproc).ge.jj-1) then
1210 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1211 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1214 call add_task(iproc,ntask_cont_to,itask_cont_to)
1217 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1218 & ielend_all(ii-1,iproc).ge.jj+1) then
1220 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1221 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1224 call add_task(iproc,ntask_cont_to,itask_cont_to)
1231 c---------------------------------------------------------------------------
1232 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1234 include "DIMENSIONS"
1235 include "COMMON.INTERACT"
1236 include "COMMON.SETUP"
1237 include "COMMON.IOUNITS"
1238 integer ii,jj,itask(2),ntask_cont_from,
1239 & itask_cont_from(0:MaxProcs-1)
1241 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1242 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1243 common /przechowalnia/ iturn3_start_all(0:MaxProcs),
1244 & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs),
1245 & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs),
1246 & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1),
1247 & ielend_all(maxres,0:MaxProcs-1)
1249 do iproc=fg_rank+1,nfgtasks-1
1250 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1252 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1253 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1255 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1256 call add_task(iproc,ntask_cont_from,itask_cont_from)
1259 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1261 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1262 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1264 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1265 call add_task(iproc,ntask_cont_from,itask_cont_from)
1268 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1269 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1271 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1272 & jj+1.le.ielend_all(ii+1,iproc)) then
1273 call add_task(iproc,ntask_cont_from,itask_cont_from)
1275 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1276 & jj-1.le.ielend_all(ii+1,iproc)) then
1277 call add_task(iproc,ntask_cont_from,itask_cont_from)
1280 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
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)
1286 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1287 & jj+1.le.ielend_all(ii-1,iproc)) then
1288 call add_task(iproc,ntask_cont_from,itask_cont_from)
1295 c---------------------------------------------------------------------------
1296 subroutine add_task(iproc,ntask_cont,itask_cont)
1298 include "DIMENSIONS"
1299 integer iproc,ntask_cont,itask_cont(0:MaxProcs-1)
1302 if (itask_cont(ii).eq.iproc) return
1304 ntask_cont=ntask_cont+1
1305 itask_cont(ntask_cont)=iproc
1308 c---------------------------------------------------------------------------
1309 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1310 implicit real*8 (a-h,o-z)
1311 include 'DIMENSIONS'
1313 include 'COMMON.SETUP'
1314 integer total_ints,lower_bound,upper_bound
1315 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1316 nint=total_ints/nfgtasks
1320 nexcess=total_ints-nint*nfgtasks
1322 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1326 lower_bound=lower_bound+int4proc(i)
1328 upper_bound=lower_bound+int4proc(fg_rank)
1329 lower_bound=lower_bound+1
1332 c---------------------------------------------------------------------------
1333 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1334 implicit real*8 (a-h,o-z)
1335 include 'DIMENSIONS'
1337 include 'COMMON.SETUP'
1338 integer total_ints,lower_bound,upper_bound
1339 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1340 nint=total_ints/nfgtasks1
1344 nexcess=total_ints-nint*nfgtasks1
1346 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1350 lower_bound=lower_bound+int4proc(i)
1352 upper_bound=lower_bound+int4proc(fg_rank1)
1353 lower_bound=lower_bound+1
1356 c---------------------------------------------------------------------------
1357 subroutine int_partition(int_index,lower_index,upper_index,atom,
1358 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1359 implicit real*8 (a-h,o-z)
1360 include 'DIMENSIONS'
1361 include 'COMMON.IOUNITS'
1362 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1363 & first_atom,last_atom,int_gr,jat_start,jat_end
1366 if (lprn) write (iout,*) 'int_index=',int_index
1367 int_index_old=int_index
1368 int_index=int_index+last_atom-first_atom+1
1370 & write (iout,*) 'int_index=',int_index,
1371 & ' int_index_old',int_index_old,
1372 & ' lower_index=',lower_index,
1373 & ' upper_index=',upper_index,
1374 & ' atom=',atom,' first_atom=',first_atom,
1375 & ' last_atom=',last_atom
1376 if (int_index.ge.lower_index) then
1378 if (at_start.eq.0) then
1380 jat_start=first_atom-1+lower_index-int_index_old
1382 jat_start=first_atom
1384 if (lprn) write (iout,*) 'jat_start',jat_start
1385 if (int_index.ge.upper_index) then
1387 jat_end=first_atom-1+upper_index-int_index_old
1392 if (lprn) write (iout,*) 'jat_end',jat_end
1397 c------------------------------------------------------------------------------
1398 subroutine hpb_partition
1399 implicit real*8 (a-h,o-z)
1400 include 'DIMENSIONS'
1404 include 'COMMON.SBRIDGE'
1405 include 'COMMON.IOUNITS'
1406 include 'COMMON.SETUP'
1408 call int_bounds(nhpb,link_start,link_end)
1409 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1410 & ' absolute rank',MyRank,
1411 & ' nhpb',nhpb,' link_start=',link_start,
1412 & ' link_end',link_end