2 implicit real*8 (a-h,o-z)
7 & /'pool','chain regrow','multi-bond','phi','theta','side chain',
9 c Conversion from poises to molecular unit and the gas constant
10 data cPoise /2.9361d0/, Rb /0.001986d0/
12 c--------------------------------------------------------------------------
15 C Define constants and zero out tables.
17 implicit real*8 (a-h,o-z)
25 cMS$ATTRIBUTES C :: proc_proc
28 include 'COMMON.IOUNITS'
29 include 'COMMON.CHAIN'
30 include 'COMMON.INTERACT'
32 include 'COMMON.LOCAL'
33 include 'COMMON.TORSION'
34 include 'COMMON.FFIELD'
35 include 'COMMON.SBRIDGE'
37 include 'COMMON.MINIM'
38 include 'COMMON.DERIV'
39 include 'COMMON.SPLITELE'
40 c Common blocks from the diagonalization routines
41 COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
42 COMMON /MACHSW/ KDIAG,ICORFL,IXDR
44 c real*8 text1 /'initial_i'/
62 C The following is just to define auxiliary variables used in angle conversion
101 crc for write_rmsbank1
103 cdr include secondary structure prediction bias
106 C CSA I/O units (separated from others especially for Jooyoung)
117 icsa_bank_reminimized=38
120 crc for ifc error 118
123 C Lipidic input file for parameters range 60-79
125 C input file for transfer sidechain and peptide group inside the
126 C lipidic environment if lipid is implicite
128 C DNA input files for parameters range 80-99
129 C Suger input files for parameters range 100-119
130 C All-atom input files for parameters range 120-149
132 C Set default weights of the energy terms.
143 c print '(a,$)','Inside initialize'
144 c call memmon_print_usage()
179 athet(j,i,ichir1,ichir2)=0.0D0
180 bthet(j,i,ichir1,ichir2)=0.0D0
200 gaussc(l,k,j,i)=0.0D0
210 cc write (iout,*) "TU DOCHODZE",i,itortyp(i)
214 v1(k,j,i,iblock)=0.0D0
215 v2(k,j,i,iblock)=0.0D0
225 v1c(1,l,i,j,k,iblock)=0.0D0
226 v1s(1,l,i,j,k,iblock)=0.0D0
227 v1c(2,l,i,j,k,iblock)=0.0D0
228 v1s(2,l,i,j,k,iblock)=0.0D0
232 v2c(m,l,i,j,k,iblock)=0.0D0
233 v2s(m,l,i,j,k,iblock)=0.0D0
245 C Initialize the bridge arrays
259 C Initialize correlation arrays
290 C Initialize variables used in minimization.
299 C Initialize the variables responsible for the mode of gradient storage.
304 C Initialize constants used to split the energy into long- and short-range
310 nprint_ene=nprint_ene-1
314 c-------------------------------------------------------------------------
316 implicit real*8 (a-h,o-z)
318 include 'COMMON.NAMES'
319 include 'COMMON.FFIELD'
321 &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
322 & 'DSG','DGN','DSN','DTH',
323 &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
324 &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
325 &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
328 &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
329 &'a','y','w','v','l','i','f','m','c','x',
330 &'C','M','F','I','L','V','W','Y','A','G','T',
331 &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
332 data potname /'LJ','LJK','BP','GB','GBV'/
334 & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
335 & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
336 & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
337 & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR",
338 & "ELIPTRAN", "EAFM", "ETHETCNSTR", " ","ESAXS"/
340 & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
341 & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
342 & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
343 & "WLT", "WAFM", "WTHETCNSR", " ","WSAXS"/
345 data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
346 & 21,0,22,23,24,25,26/
348 c---------------------------------------------------------------------------
349 subroutine init_int_table
350 implicit real*8 (a-h,o-z)
354 integer blocklengths(15),displs(15)
356 include 'COMMON.CONTROL'
357 include 'COMMON.SETUP'
358 include 'COMMON.CHAIN'
359 include 'COMMON.INTERACT'
360 include 'COMMON.LOCAL'
361 include 'COMMON.SBRIDGE'
362 include 'COMMON.TORCNSTR'
363 include 'COMMON.IOUNITS'
364 include 'COMMON.DERIV'
365 include 'COMMON.CONTACTS'
366 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
367 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
368 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
369 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
370 & ielend_all(maxres,0:max_fg_procs-1),
371 & ntask_cont_from_all(0:max_fg_procs-1),
372 & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
373 & ntask_cont_to_all(0:max_fg_procs-1),
374 & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
375 integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
376 logical scheck,lprint,flag
378 integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
379 & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
380 C... Determine the numbers of start and end SC-SC interaction
381 C... to deal with by current processor.
383 itask_cont_from(i)=fg_rank
384 itask_cont_to(i)=fg_rank
388 &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
389 n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
390 call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
392 & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
393 & ' absolute rank',MyRank,
394 & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
395 & ' my_sc_inde',my_sc_inde
415 cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
416 cd & (ihpb(i),jhpb(i),i=1,nss)
421 if (ihpb(ii).eq.i+nres) then
428 cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
432 c write (iout,*) 'jj=i+1'
433 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
434 & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
440 else if (jj.eq.nct) then
442 c write (iout,*) 'jj=nct'
443 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
444 & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
452 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
453 & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
455 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
456 & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
467 call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
468 & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
473 ind_scint=ind_scint+nct-i
477 ind_scint_old=ind_scint
485 if (iatsc_s.eq.0) iatsc_s=1
487 if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
488 & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
491 write (iout,'(a)') 'Interaction array:'
493 write (iout,'(i3,2(2x,2i3))')
494 & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
499 C Now partition the electrostatic-interaction array
501 nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
502 call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
504 & write (*,*) 'Processor',fg_rank,' CG group',kolor,
505 & ' absolute rank',MyRank,
506 & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
507 & ' my_ele_inde',my_ele_inde
514 call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
515 & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
518 if (iatel_s.eq.0) iatel_s=1
519 nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
520 c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
521 call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
522 c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
523 c & " my_ele_inde_vdw",my_ele_inde_vdw
530 call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
532 & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
534 c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
535 c & " ielend_vdw",ielend_vdw(i)
537 if (iatel_s_vdw.eq.0) iatel_s_vdw=1
548 do i=iatel_s_vdw,iatel_e_vdw
554 write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
555 & ' absolute rank',MyRank
556 write (iout,*) 'Electrostatic interaction array:'
558 write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
563 C Partition the SC-p interaction array
565 nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
566 call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
567 if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
568 & ' absolute rank',myrank,
569 & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
570 & ' my_scp_inde',my_scp_inde
576 if (i.lt.nnt+iscp) then
577 cd write (iout,*) 'i.le.nnt+iscp'
578 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
579 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
581 else if (i.gt.nct-iscp) then
582 cd write (iout,*) 'i.gt.nct-iscp'
583 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
584 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
587 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
588 & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
591 call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
592 & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
601 if (i.lt.nnt+iscp) then
603 iscpstart(i,1)=i+iscp
605 elseif (i.gt.nct-iscp) then
613 iscpstart(i,2)=i+iscp
618 if (iatscp_s.eq.0) iatscp_s=1
620 write (iout,'(a)') 'SC-p interaction array:'
621 do i=iatscp_s,iatscp_e
622 write (iout,'(i3,2(2x,2i3))')
623 & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
626 C Partition local interactions
628 call int_bounds(nres-2,loc_start,loc_end)
629 loc_start=loc_start+1
631 call int_bounds(nres-2,ithet_start,ithet_end)
632 call int_bounds(nsaxs,isaxs_start,isaxs_end)
633 write (iout,*) me," isaxs_start",isaxs_start,
634 & " isaxs_end",isaxs_end
635 ithet_start=ithet_start+2
636 ithet_end=ithet_end+2
637 call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
638 iturn3_start=iturn3_start+nnt
639 iphi_start=iturn3_start+2
640 iturn3_end=iturn3_end+nnt
641 iphi_end=iturn3_end+2
642 iturn3_start=iturn3_start-1
643 iturn3_end=iturn3_end-1
644 call int_bounds(nres-3,itau_start,itau_end)
645 itau_start=itau_start+3
647 call int_bounds(nres-3,iphi1_start,iphi1_end)
648 iphi1_start=iphi1_start+3
649 iphi1_end=iphi1_end+3
650 call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
651 iturn4_start=iturn4_start+nnt
652 iphid_start=iturn4_start+2
653 iturn4_end=iturn4_end+nnt
654 iphid_end=iturn4_end+2
655 iturn4_start=iturn4_start-1
656 iturn4_end=iturn4_end-1
657 call int_bounds(nres-2,ibond_start,ibond_end)
658 ibond_start=ibond_start+1
659 ibond_end=ibond_end+1
660 call int_bounds(nct-nnt,ibondp_start,ibondp_end)
661 ibondp_start=ibondp_start+nnt
662 ibondp_end=ibondp_end+nnt
663 call int_bounds(nres,ilip_start,ilip_end)
664 c ilip_start=ilip_start
665 call int_bounds1(nres-1,ivec_start,ivec_end)
666 c print *,"Processor",myrank,fg_rank,fg_rank1,
667 c & " ivec_start",ivec_start," ivec_end",ivec_end
668 iset_start=loc_start+2
670 if (ndih_constr.eq.0) then
674 call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
676 if (ntheta_constr.eq.0) then
681 & (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
683 c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
685 nsumgrad=(nres-nnt)*(nres-nnt+1)/2
687 call int_bounds(nsumgrad,ngrad_start,ngrad_end)
688 igrad_start=((2*nlen+1)
689 & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
690 jgrad_start(igrad_start)=
691 & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
693 jgrad_end(igrad_start)=nres
694 igrad_end=((2*nlen+1)
695 & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
696 if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
697 jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
699 do i=igrad_start+1,igrad_end-1
704 write (*,*) 'Processor:',fg_rank,' CG group',kolor,
705 & ' absolute rank',myrank,
706 & ' loc_start',loc_start,' loc_end',loc_end,
707 & ' ithet_start',ithet_start,' ithet_end',ithet_end,
708 & ' iphi_start',iphi_start,' iphi_end',iphi_end,
709 & ' iphid_start',iphid_start,' iphid_end',iphid_end,
710 & ' ibond_start',ibond_start,' ibond_end',ibond_end,
711 & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
712 & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
713 & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
714 & ' ivec_start',ivec_start,' ivec_end',ivec_end,
715 & ' iset_start',iset_start,' iset_end',iset_end,
716 & ' idihconstr_start',idihconstr_start,' idihconstr_end',
718 & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
721 write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
722 & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
723 & ' ngrad_end',ngrad_end
724 do i=igrad_start,igrad_end
725 write(*,*) 'Processor:',fg_rank,myrank,i,
726 & jgrad_start(i),jgrad_end(i)
729 if (nfgtasks.gt.1) then
730 call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
731 & MPI_INTEGER,FG_COMM1,IERROR)
732 iaux=ivec_end-ivec_start+1
733 call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
734 & MPI_INTEGER,FG_COMM1,IERROR)
735 call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
736 & MPI_INTEGER,FG_COMM,IERROR)
737 iaux=iset_end-iset_start+1
738 call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
739 & MPI_INTEGER,FG_COMM,IERROR)
740 call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
741 & MPI_INTEGER,FG_COMM,IERROR)
742 iaux=ibond_end-ibond_start+1
743 call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
744 & MPI_INTEGER,FG_COMM,IERROR)
745 call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
746 & MPI_INTEGER,FG_COMM,IERROR)
747 iaux=ithet_end-ithet_start+1
748 call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
749 & MPI_INTEGER,FG_COMM,IERROR)
750 call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
751 & MPI_INTEGER,FG_COMM,IERROR)
752 iaux=iphi_end-iphi_start+1
753 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
754 & MPI_INTEGER,FG_COMM,IERROR)
755 call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
756 & MPI_INTEGER,FG_COMM,IERROR)
757 iaux=iphi1_end-iphi1_start+1
758 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
759 & MPI_INTEGER,FG_COMM,IERROR)
760 do i=0,max_fg_procs-1
766 call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
767 & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
768 call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
769 & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
770 call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
771 & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
772 call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
773 & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
774 call MPI_Allgather(iatel_s,1,MPI_INTEGER,
775 & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
776 call MPI_Allgather(iatel_e,1,MPI_INTEGER,
777 & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
778 call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
779 & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
780 call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
781 & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
783 write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
784 write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
785 write (iout,*) "iturn3_start_all",
786 & (iturn3_start_all(i),i=0,nfgtasks-1)
787 write (iout,*) "iturn3_end_all",
788 & (iturn3_end_all(i),i=0,nfgtasks-1)
789 write (iout,*) "iturn4_start_all",
790 & (iturn4_start_all(i),i=0,nfgtasks-1)
791 write (iout,*) "iturn4_end_all",
792 & (iturn4_end_all(i),i=0,nfgtasks-1)
793 write (iout,*) "The ielstart_all array"
795 write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
797 write (iout,*) "The ielend_all array"
799 write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
805 itask_cont_from(0)=fg_rank
806 itask_cont_to(0)=fg_rank
808 do ii=iturn3_start,iturn3_end
809 call add_int(ii,ii+2,iturn3_sent(1,ii),
810 & ntask_cont_to,itask_cont_to,flag)
812 do ii=iturn4_start,iturn4_end
813 call add_int(ii,ii+3,iturn4_sent(1,ii),
814 & ntask_cont_to,itask_cont_to,flag)
816 do ii=iturn3_start,iturn3_end
817 call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
819 do ii=iturn4_start,iturn4_end
820 call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
823 write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
824 & " ntask_cont_to",ntask_cont_to
825 write (iout,*) "itask_cont_from",
826 & (itask_cont_from(i),i=1,ntask_cont_from)
827 write (iout,*) "itask_cont_to",
828 & (itask_cont_to(i),i=1,ntask_cont_to)
831 c write (iout,*) "Loop forward"
834 c write (iout,*) "from loop i=",i
836 do j=ielstart(i),ielend(i)
837 call add_int_from(i,j,ntask_cont_from,itask_cont_from)
840 c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
841 c & " iatel_e",iatel_e
845 c write (iout,*) "i",i," ielstart",ielstart(i),
846 c & " ielend",ielend(i)
849 do j=ielstart(i),ielend(i)
850 call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
851 & itask_cont_to,flag)
859 write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
860 & " ntask_cont_to",ntask_cont_to
861 write (iout,*) "itask_cont_from",
862 & (itask_cont_from(i),i=1,ntask_cont_from)
863 write (iout,*) "itask_cont_to",
864 & (itask_cont_to(i),i=1,ntask_cont_to)
866 write (iout,*) "iint_sent"
869 write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
870 & j=ielstart(ii),ielend(ii))
872 write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
873 & " iturn3_end",iturn3_end
874 write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
875 & i=iturn3_start,iturn3_end)
876 write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
877 & " iturn4_end",iturn4_end
878 write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
879 & i=iturn4_start,iturn4_end)
882 call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
883 & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
884 c write (iout,*) "Gather ntask_cont_from ended"
886 call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
887 & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
889 c write (iout,*) "Gather itask_cont_from ended"
891 call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
892 & 1,MPI_INTEGER,king,FG_COMM,IERR)
893 c write (iout,*) "Gather ntask_cont_to ended"
895 call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
896 & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
897 c write (iout,*) "Gather itask_cont_to ended"
899 if (fg_rank.eq.king) then
900 write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
902 write (iout,'(20i4)') i,ntask_cont_from_all(i),
903 & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
907 write (iout,*) "Contact send task map (proc, #tasks, tasks)"
909 write (iout,'(20i4)') i,ntask_cont_to_all(i),
910 & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
914 C Check if every send will have a matching receive
918 ncheck_to=ncheck_to+ntask_cont_to_all(i)
919 ncheck_from=ncheck_from+ntask_cont_from_all(i)
921 write (iout,*) "Control sums",ncheck_from,ncheck_to
922 if (ncheck_from.ne.ncheck_to) then
923 write (iout,*) "Error: #receive differs from #send."
924 write (iout,*) "Terminating program...!"
930 do j=1,ntask_cont_to_all(i)
931 ii=itask_cont_to_all(j,i)
932 do k=1,ntask_cont_from_all(ii)
933 if (itask_cont_from_all(k,ii).eq.i) then
934 if(lprint)write(iout,*)"Matching send/receive",i,ii
938 if (k.eq.ntask_cont_from_all(ii)+1) then
940 write (iout,*) "Error: send by",j," to",ii,
941 & " would have no matching receive"
947 write (iout,*) "Unmatched sends; terminating program"
951 call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
952 c write (iout,*) "flag broadcast ended flag=",flag
955 call MPI_Finalize(IERROR)
956 stop "Error in INIT_INT_TABLE: unmatched send/receive."
958 call MPI_Comm_group(FG_COMM,fg_group,IERR)
959 c write (iout,*) "MPI_Comm_group ended"
961 call MPI_Group_incl(fg_group,ntask_cont_from+1,
962 & itask_cont_from(0),CONT_FROM_GROUP,IERR)
963 call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
964 & CONT_TO_GROUP,IERR)
967 iaux=4*(ielend(ii)-ielstart(ii)+1)
968 call MPI_Group_translate_ranks(fg_group,iaux,
969 & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
970 & iint_sent_local(1,ielstart(ii),i),IERR )
971 c write (iout,*) "Ranks translated i=",i
974 iaux=4*(iturn3_end-iturn3_start+1)
975 call MPI_Group_translate_ranks(fg_group,iaux,
976 & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
977 & iturn3_sent_local(1,iturn3_start),IERR)
978 iaux=4*(iturn4_end-iturn4_start+1)
979 call MPI_Group_translate_ranks(fg_group,iaux,
980 & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
981 & iturn4_sent_local(1,iturn4_start),IERR)
983 write (iout,*) "iint_sent_local"
986 write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
987 & j=ielstart(ii),ielend(ii))
990 write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
991 & " iturn3_end",iturn3_end
992 write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
993 & i=iturn3_start,iturn3_end)
994 write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
995 & " iturn4_end",iturn4_end
996 write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
997 & i=iturn4_start,iturn4_end)
1000 call MPI_Group_free(fg_group,ierr)
1001 call MPI_Group_free(cont_from_group,ierr)
1002 call MPI_Group_free(cont_to_group,ierr)
1003 call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1004 call MPI_Type_commit(MPI_UYZ,IERROR)
1005 call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1007 call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1008 call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1009 call MPI_Type_commit(MPI_MU,IERROR)
1010 call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1011 call MPI_Type_commit(MPI_MAT1,IERROR)
1012 call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1013 call MPI_Type_commit(MPI_MAT2,IERROR)
1014 call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1015 call MPI_Type_commit(MPI_THET,IERROR)
1016 call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1017 call MPI_Type_commit(MPI_GAM,IERROR)
1019 c 9/22/08 Derived types to send matrices which appear in correlation terms
1021 if (ivec_count(i).eq.ivec_count(0)) then
1027 do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1028 if (ind_typ.eq.0) then
1029 ichunk=ivec_count(0)
1031 ichunk=ivec_count(1)
1038 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1041 c blocklengths(i)=blocklengths(i)*ichunk
1043 c write (iout,*) "blocklengths and displs"
1045 c write (iout,*) i,blocklengths(i),displs(i)
1048 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1049 c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1050 c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1051 c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1057 c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1060 c blocklengths(i)=blocklengths(i)*ichunk
1062 c write (iout,*) "blocklengths and displs"
1064 c write (iout,*) i,blocklengths(i),displs(i)
1067 c call MPI_Type_indexed(4,blocklengths(1),displs(1),
1068 c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1069 c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1070 c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1076 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1079 blocklengths(i)=blocklengths(i)*ichunk
1081 call MPI_Type_indexed(8,blocklengths,displs,
1082 & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1083 call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1089 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1092 blocklengths(i)=blocklengths(i)*ichunk
1094 call MPI_Type_indexed(8,blocklengths,displs,
1095 & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1096 call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1102 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1105 blocklengths(i)=blocklengths(i)*ichunk
1107 call MPI_Type_indexed(6,blocklengths,displs,
1108 & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1109 call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1115 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1118 blocklengths(i)=blocklengths(i)*ichunk
1120 call MPI_Type_indexed(2,blocklengths,displs,
1121 & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1122 call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1128 displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1131 blocklengths(i)=blocklengths(i)*ichunk
1133 call MPI_Type_indexed(4,blocklengths,displs,
1134 & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1135 call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1139 iint_start=ivec_start+1
1142 iint_count(i)=ivec_count(i)
1143 iint_displ(i)=ivec_displ(i)
1144 ivec_displ(i)=ivec_displ(i)-1
1145 iset_displ(i)=iset_displ(i)-1
1146 ithet_displ(i)=ithet_displ(i)-1
1147 iphi_displ(i)=iphi_displ(i)-1
1148 iphi1_displ(i)=iphi1_displ(i)-1
1149 ibond_displ(i)=ibond_displ(i)-1
1151 if (nfgtasks.gt.1 .and. fg_rank.eq.king
1152 & .and. (me.eq.0 .or. .not. out1file)) then
1153 write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1155 write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1158 write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1159 & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1160 write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1162 write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1165 write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1166 & nele_int_tot,' electrostatic and ',nscp_int_tot,
1167 & ' SC-p interactions','were distributed among',nfgtasks,
1168 & ' fine-grain processors.'
1184 idihconstr_end=ndih_constr
1185 ithetaconstr_start=1
1186 ithetaconstr_end=ntheta_constr
1187 iphid_start=iphi_start
1188 iphid_end=iphi_end-1
1210 c---------------------------------------------------------------------------
1211 subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1213 include "DIMENSIONS"
1214 include "COMMON.INTERACT"
1215 include "COMMON.SETUP"
1216 include "COMMON.IOUNITS"
1217 integer ii,jj,itask(4),ntask_cont_to,
1218 &itask_cont_to(0:max_fg_procs-1)
1220 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1221 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1222 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1223 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1224 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1225 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1226 & ielend_all(maxres,0:max_fg_procs-1)
1227 integer iproc,isent,k,l
1228 c Determines whether to send interaction ii,jj to other processors; a given
1229 c interaction can be sent to at most 2 processors.
1230 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1231 c one processor, otherwise flag is unchanged from the input value.
1237 c write (iout,*) "ii",ii," jj",jj
1238 c Loop over processors to check if anybody could need interaction ii,jj
1239 do iproc=0,fg_rank-1
1240 c Check if the interaction matches any turn3 at iproc
1241 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1243 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1244 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1246 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1249 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1250 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1253 call add_task(iproc,ntask_cont_to,itask_cont_to)
1257 C Check if the interaction matches any turn4 at iproc
1258 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1260 if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1261 & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1263 c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1266 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1267 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1270 call add_task(iproc,ntask_cont_to,itask_cont_to)
1274 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1275 & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1276 if (ielstart_all(ii-1,iproc).le.jj-1.and.
1277 & ielend_all(ii-1,iproc).ge.jj-1) then
1279 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1280 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1283 call add_task(iproc,ntask_cont_to,itask_cont_to)
1286 if (ielstart_all(ii-1,iproc).le.jj+1.and.
1287 & ielend_all(ii-1,iproc).ge.jj+1) then
1289 if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1290 & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1293 call add_task(iproc,ntask_cont_to,itask_cont_to)
1300 c---------------------------------------------------------------------------
1301 subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1303 include "DIMENSIONS"
1304 include "COMMON.INTERACT"
1305 include "COMMON.SETUP"
1306 include "COMMON.IOUNITS"
1307 integer ii,jj,itask(2),ntask_cont_from,
1308 & itask_cont_from(0:max_fg_procs-1)
1310 integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1311 & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1312 common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1313 & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1314 & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1315 &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1316 & ielend_all(maxres,0:max_fg_procs-1)
1318 do iproc=fg_rank+1,nfgtasks-1
1319 do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1321 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1322 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1324 c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1325 call add_task(iproc,ntask_cont_from,itask_cont_from)
1328 do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1330 if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1331 & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1333 c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1334 call add_task(iproc,ntask_cont_from,itask_cont_from)
1337 if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1338 if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1340 if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1341 & jj+1.le.ielend_all(ii+1,iproc)) then
1342 call add_task(iproc,ntask_cont_from,itask_cont_from)
1344 if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1345 & jj-1.le.ielend_all(ii+1,iproc)) then
1346 call add_task(iproc,ntask_cont_from,itask_cont_from)
1349 if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1351 if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1352 & jj-1.le.ielend_all(ii-1,iproc)) then
1353 call add_task(iproc,ntask_cont_from,itask_cont_from)
1355 if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1356 & jj+1.le.ielend_all(ii-1,iproc)) then
1357 call add_task(iproc,ntask_cont_from,itask_cont_from)
1364 c---------------------------------------------------------------------------
1365 subroutine add_task(iproc,ntask_cont,itask_cont)
1367 include "DIMENSIONS"
1368 integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1371 if (itask_cont(ii).eq.iproc) return
1373 ntask_cont=ntask_cont+1
1374 itask_cont(ntask_cont)=iproc
1377 c---------------------------------------------------------------------------
1378 subroutine int_bounds(total_ints,lower_bound,upper_bound)
1379 implicit real*8 (a-h,o-z)
1380 include 'DIMENSIONS'
1382 include 'COMMON.SETUP'
1383 integer total_ints,lower_bound,upper_bound
1384 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1385 nint=total_ints/nfgtasks
1389 nexcess=total_ints-nint*nfgtasks
1391 int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1395 lower_bound=lower_bound+int4proc(i)
1397 upper_bound=lower_bound+int4proc(fg_rank)
1398 lower_bound=lower_bound+1
1401 c---------------------------------------------------------------------------
1402 subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1406 include 'COMMON.SETUP'
1407 integer total_ints,lower_bound,upper_bound
1408 integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1409 nint=total_ints/nfgtasks1
1413 nexcess=total_ints-nint*nfgtasks1
1415 int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1419 lower_bound=lower_bound+int4proc(i)
1421 upper_bound=lower_bound+int4proc(fg_rank1)
1422 lower_bound=lower_bound+1
1425 c---------------------------------------------------------------------------
1426 subroutine int_partition(int_index,lower_index,upper_index,atom,
1427 & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1428 implicit real*8 (a-h,o-z)
1429 include 'DIMENSIONS'
1430 include 'COMMON.IOUNITS'
1431 integer int_index,lower_index,upper_index,atom,at_start,at_end,
1432 & first_atom,last_atom,int_gr,jat_start,jat_end
1435 if (lprn) write (iout,*) 'int_index=',int_index
1436 int_index_old=int_index
1437 int_index=int_index+last_atom-first_atom+1
1439 & write (iout,*) 'int_index=',int_index,
1440 & ' int_index_old',int_index_old,
1441 & ' lower_index=',lower_index,
1442 & ' upper_index=',upper_index,
1443 & ' atom=',atom,' first_atom=',first_atom,
1444 & ' last_atom=',last_atom
1445 if (int_index.ge.lower_index) then
1447 if (at_start.eq.0) then
1449 jat_start=first_atom-1+lower_index-int_index_old
1451 jat_start=first_atom
1453 if (lprn) write (iout,*) 'jat_start',jat_start
1454 if (int_index.ge.upper_index) then
1456 jat_end=first_atom-1+upper_index-int_index_old
1461 if (lprn) write (iout,*) 'jat_end',jat_end
1466 c------------------------------------------------------------------------------
1467 subroutine hpb_partition
1468 implicit real*8 (a-h,o-z)
1469 include 'DIMENSIONS'
1473 include 'COMMON.SBRIDGE'
1474 include 'COMMON.IOUNITS'
1475 include 'COMMON.SETUP'
1477 call int_bounds(nhpb,link_start,link_end)
1478 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1479 & ' absolute rank',MyRank,
1480 & ' nhpb',nhpb,' link_start=',link_start,
1481 & ' link_end',link_end
1488 c------------------------------------------------------------------------------
1489 subroutine NMRpeak_partition
1490 implicit real*8 (a-h,o-z)
1491 include 'DIMENSIONS'
1495 include 'COMMON.SBRIDGE'
1496 include 'COMMON.IOUNITS'
1497 include 'COMMON.SETUP'
1499 call int_bounds(npeak,link_start_peak,link_end_peak)
1500 write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1501 & ' absolute rank',MyRank,
1502 & ' npeak',npeak,' link_start_peak=',link_start_peak,
1503 & ' link_end_peak',link_end_peak