From 138fb56cc965302f43ebfcafa4075b3dcb45a705 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 13 Sep 2021 19:04:42 -0400 Subject: [PATCH] Fixed array indexing bug --- Makefile.Defines | 4 ++-- src/symba/symba_encounter_check.f90 | 7 +++++-- src/symba/symba_kick.f90 | 17 +++++++++-------- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/Makefile.Defines b/Makefile.Defines index 479c57f6b..e44a50f44 100644 --- a/Makefile.Defines +++ b/Makefile.Defines @@ -66,9 +66,9 @@ GMEM = -fsanitize-address-use-after-scope -fstack-check -fsanitize=bounds-stri GWARNINGS = -Wall -Warray-bounds -Wimplicit-interface -Wextra -Warray-temporaries GPRODUCTION = -O2 -ffree-line-length-none $(GPAR) -#FFLAGS = $(IPRODUCTION) $(OPTREPORT) +#FFLAGS = $(IDEBUG) $(SIMDVEC) $(PAR) #FFLAGS = $(IPRODUCTION) $(OPTREPORT) $(ADVIXE_FLAGS) -FFLAGS = -O3 $(PAR) $(OPTREPORT) $(SIMDVEC) -shared-intel -debug inline-debug-info -DTBB_DEBUG -DTBB_USE_THREADING_TOOLS -traceback -g +FFLAGS = -O3 $(PAR) $(OPTREPORT) $(SIMDVEC) # -shared-intel -debug inline-debug-info -DTBB_DEBUG -DTBB_USE_THREADING_TOOLS -traceback -g FORTRAN = ifort #AR = xiar diff --git a/src/symba/symba_encounter_check.f90 b/src/symba/symba_encounter_check.f90 index d8c2af76f..22d884ffd 100644 --- a/src/symba/symba_encounter_check.f90 +++ b/src/symba/symba_encounter_check.f90 @@ -55,8 +55,8 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc ! Result logical :: lany_encounter !! Returns true if there is at least one close encounter ! Internals - integer(I8B) :: k, nplplm - integer(I4B) :: i, j, nenc + integer(I8B) :: k, nplplm, kenc + integer(I4B) :: i, j, nenc, npl logical, dimension(:), allocatable :: lencounter, loc_lvdotr, lvdotr integer(I4B), dimension(:), allocatable :: index1, index2 @@ -64,6 +64,7 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc associate(pl => self) nplplm = pl%nplplm + npl = pl%nbody allocate(lencounter(nplplm)) allocate(loc_lvdotr(nplplm)) @@ -88,6 +89,8 @@ module function symba_encounter_check_pl(self, system, dt, irec) result(lany_enc do k = 1, nenc i = plplenc_list%index1(k) j = plplenc_list%index2(k) + call util_index_eucl_ij_to_k(npl, i, j, kenc) + plplenc_list%kidx(k) = kenc plplenc_list%id1(k) = pl%id(plplenc_list%index1(k)) plplenc_list%id2(k) = pl%id(plplenc_list%index2(k)) plplenc_list%status(k) = ACTIVE diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index 8a70e3c21..325ef5a45 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -46,14 +46,15 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) associate(pl => self, npl => self%nbody, plplenc_list => system%plplenc_list, radius => self%radius) ! Apply kicks to all bodies (including those in the encounter list) call helio_kick_getacch_pl(pl, system, param, t, lbeg) - - ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. - nplplenc = int(plplenc_list%nenc, kind=I8B) - allocate(k_plpl_enc(2,nplplenc)) - k_plpl_enc(:,1:nplplenc) = pl%k_plpl(:,plplenc_list%kidx(1:nplplenc)) - ah_enc(:,:) = 0.0_DP - call kick_getacch_int_all_pl(npl, nplplenc, k_plpl_enc, pl%xh, pl%Gmass, pl%radius, ah_enc) - pl%ah(:,1:npl) = pl%ah(:,1:npl) - ah_enc(:,1:npl) + if (plplenc_list%nenc > 0) then + ! Remove kicks from bodies involved currently in the encounter list, as these are dealt with separately. + nplplenc = int(plplenc_list%nenc, kind=I8B) + allocate(k_plpl_enc(2,nplplenc)) + k_plpl_enc(:,1:nplplenc) = pl%k_plpl(:,plplenc_list%kidx(1:nplplenc)) + ah_enc(:,:) = 0.0_DP + call kick_getacch_int_all_pl(npl, nplplenc, k_plpl_enc, pl%xh, pl%Gmass, pl%radius, ah_enc) + pl%ah(:,1:npl) = pl%ah(:,1:npl) - ah_enc(:,1:npl) + end if end associate end select