diff --git a/src/misc/solver_module.f90 b/src/misc/solver_module.f90 index 410116b2a..504e9215e 100644 --- a/src/misc/solver_module.f90 +++ b/src/misc/solver_module.f90 @@ -16,7 +16,7 @@ module solver use lambda_function use, intrinsic :: ieee_exceptions private - public :: solve_linear_system, solve_rkf45, solve_roots + public :: solve_linear_system, solve_roots interface solve_linear_system module procedure solve_linear_system_dp diff --git a/src/rmvs/rmvs_module.f90 b/src/rmvs/rmvs_module.f90 index 733a81e60..3a950bc8d 100644 --- a/src/rmvs/rmvs_module.f90 +++ b/src/rmvs/rmvs_module.f90 @@ -98,7 +98,7 @@ module rmvs integer(I4B), dimension(:), allocatable :: plind !! Connects the planetocentric indices back to the heliocentric planet list type(rmvs_interp), dimension(:), allocatable :: outer !! interpolated heliocentric central body position for outer encounters type(rmvs_interp), dimension(:), allocatable :: inner !! interpolated heliocentric central body position for inner encounters - class(rmvs_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body) + class(swiftest_nbody_system), dimension(:), allocatable :: planetocentric !! Planetocentric version of the massive body objects (one for each massive body) logical :: lplanetocentric = .false. !! Flag that indicates that the object is a planetocentric set of masive bodies used for close encounter calculations contains procedure :: setup => rmvs_util_setup_pl !! Constructor method - Allocates space for the input number of bodiess diff --git a/src/rmvs/rmvs_util.f90 b/src/rmvs/rmvs_util.f90 index b9462840b..d4d486da7 100644 --- a/src/rmvs/rmvs_util.f90 +++ b/src/rmvs/rmvs_util.f90 @@ -356,39 +356,42 @@ module subroutine rmvs_util_setup_initialize_system(self, param) tp%lplanetocentric = .false. cb%lplanetocentric = .false. associate(npl => pl%nbody) - allocate(pl%planetocentric(npl)) - pl%planetocentric(:)%lplanetocentric = .true. - do i = 1, npl - allocate(pl%planetocentric(i)%cb, source=cb) - allocate(rmvs_pl :: pl%planetocentric(i)%pl) - select type(cbenci => pl%planetocentric(i)%cb) - class is (rmvs_cb) - select type(plenci => pl%planetocentric(i)%pl) - class is (rmvs_pl) - cbenci%lplanetocentric = .true. - plenci%lplanetocentric = .true. - call plenci%setup(npl, param) - plenci%status(:) = ACTIVE - plenci%lmask(:) = .true. - ! plind stores the heliocentric index value of a planetocentric planet - ! e.g. Consider an encounter with planet 3. - ! Then the following will be the values of plind: - ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) - ! pl%planetocentric(3)%pl%plind(2) = 1 - ! pl%planetocentric(3)%pl%plind(3) = 2 - ! pl%planetocentric(3)%pl%plind(4) = 4 - ! pl%planetocentric(3)%pl%plind(5) = 5 - ! etc. - allocate(plenci%plind(npl)) - plenci%plind(1:npl) = [(j,j=1,npl)] - plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) - plenci%plind(1) = 0 - plenci%Gmass(1) = cb%Gmass - plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) - cbenci%Gmass = pl%Gmass(i) + allocate(rmvs_nbody_system :: pl%planetocentric(npl)) + select type(planetocentric => pl%planetocentric) + class is (rmvs_nbody_system) + planetocentric(:)%lplanetocentric = .true. + do i = 1, npl + allocate(planetocentric(i)%cb, source=cb) + allocate(rmvs_pl :: planetocentric(i)%pl) + select type(cbenci => planetocentric(i)%cb) + class is (rmvs_cb) + select type(plenci => planetocentric(i)%pl) + class is (rmvs_pl) + cbenci%lplanetocentric = .true. + plenci%lplanetocentric = .true. + call plenci%setup(npl, param) + plenci%status(:) = ACTIVE + plenci%lmask(:) = .true. + ! plind stores the heliocentric index value of a planetocentric planet + ! e.g. Consider an encounter with planet 3. + ! Then the following will be the values of plind: + ! pl%planetocentric(3)%pl%plind(1) = 0 (central body - never used) + ! pl%planetocentric(3)%pl%plind(2) = 1 + ! pl%planetocentric(3)%pl%plind(3) = 2 + ! pl%planetocentric(3)%pl%plind(4) = 4 + ! pl%planetocentric(3)%pl%plind(5) = 5 + ! etc. + allocate(plenci%plind(npl)) + plenci%plind(1:npl) = [(j,j=1,npl)] + plenci%plind(2:npl) = pack(plenci%plind(1:npl), plenci%plind(1:npl) /= i) + plenci%plind(1) = 0 + plenci%Gmass(1) = cb%Gmass + plenci%Gmass(2:npl) = pl%Gmass(plenci%plind(2:npl)) + cbenci%Gmass = pl%Gmass(i) + end select end select - end select - end do + end do + end select end associate end select end select diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index 270247e28..a033e6618 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -311,8 +311,6 @@ module swiftest class(swiftest_cb), allocatable :: cb !! Central body data structure class(swiftest_pl), allocatable :: pl !! Massive body data structure class(swiftest_tp), allocatable :: tp !! Test particle data structure - class(swiftest_tp), dimension(:),codimension[:], allocatable :: cotp !! Co-array test particle data structure - class(swiftest_tp), allocatable :: tp_discards !! Discarded test particle data structure class(swiftest_pl), allocatable :: pl_discards !! Discarded massive body particle data structure class(swiftest_pl), allocatable :: pl_adds !! List of added bodies in mergers or collisions diff --git a/src/whm/whm_module.f90 b/src/whm/whm_module.f90 index d2d10f971..fc97eee3b 100644 --- a/src/whm/whm_module.f90 +++ b/src/whm/whm_module.f90 @@ -70,6 +70,7 @@ module whm !> An abstract class for the WHM integrator nbody system type, extends(swiftest_nbody_system) :: whm_nbody_system + class(whm_tp), dimension(:),codimension[:], allocatable :: cotp !! Co-array test particle data structure contains !> Replace the abstract procedures with concrete ones procedure :: initialize => whm_util_setup_initialize_system !! Performs WHM-specific initilization steps, like calculating the Jacobi masses