From ce8eaf23372700d78b47f1546a558ca903378c1a Mon Sep 17 00:00:00 2001 From: David A Minton Date: Thu, 12 Jan 2023 18:00:16 -0500 Subject: [PATCH] Changed collision_fragments type from parameterized derived-type to type with allocatable arrays inside --- examples/Fragmentation/Fragmentation_Movie.py | 2 +- src/base/base_module.f90 | 23 ++- src/collision/collision_module.f90 | 95 +++++++----- src/collision/collision_util.f90 | 137 ++++++++++++++---- src/fraggle/fraggle_module.f90 | 8 - src/fraggle/fraggle_util.f90 | 19 +-- src/swiftest/swiftest_module.f90 | 4 +- src/swiftest/swiftest_util.f90 | 4 +- 8 files changed, 193 insertions(+), 99 deletions(-) mode change 100644 => 100755 examples/Fragmentation/Fragmentation_Movie.py diff --git a/examples/Fragmentation/Fragmentation_Movie.py b/examples/Fragmentation/Fragmentation_Movie.py old mode 100644 new mode 100755 index 7ed83247b..90199fd4b --- a/examples/Fragmentation/Fragmentation_Movie.py +++ b/examples/Fragmentation/Fragmentation_Movie.py @@ -1,3 +1,4 @@ +#!/usr/bin/env python3 """ Copyright 2022 - David Minton, Carlisle Wishard, Jennifer Pouplin, Jake Elliott, & Dana Singh This file is part of Swiftest. @@ -9,7 +10,6 @@ If not, see: https://www.gnu.org/licenses. """ -#!/usr/bin/env python3 """ Generates a movie of a fragmentation event from set of Swiftest output files. diff --git a/src/base/base_module.f90 b/src/base/base_module.f90 index 3eb073135..d98672f4f 100644 --- a/src/base/base_module.f90 +++ b/src/base/base_module.f90 @@ -205,9 +205,11 @@ end subroutine abstract_util_dealloc_object end interface - type, abstract :: base_multibody(nbody) - integer(I4B), len :: nbody - integer(I4B), dimension(nbody) :: id + type, abstract, extends(base_object) :: base_multibody + integer(I4B) :: nbody = 0 !! Number of bodies + integer(I4B), dimension(:), allocatable :: id !! Identifier + contains + procedure :: dealloc => base_util_dealloc_multibody end type base_multibody @@ -237,6 +239,21 @@ subroutine base_util_copy_store(self, source) end subroutine base_util_copy_store + subroutine base_util_dealloc_multibody(self) + !! author: David A. Minton + !! + !! Finalize the multibody body object - deallocates all allocatables + implicit none + ! Argument + class(base_multibody), intent(inout) :: self + + self%nbody = 0 + if (allocated(self%id)) deallocate(self%id) + + return + end subroutine base_util_dealloc_multibody + + subroutine base_util_dealloc_param(self) !! author: David A. Minton !! diff --git a/src/collision/collision_module.f90 b/src/collision/collision_module.f90 index 91a4f538c..4c1f78971 100644 --- a/src/collision/collision_module.f90 +++ b/src/collision/collision_module.f90 @@ -99,41 +99,43 @@ module collision type, extends(base_multibody) :: collision_fragments real(DP) :: mtot !! Total mass of fragments class(base_particle_info), dimension(:), allocatable :: info !! Particle metadata information - integer(I4B), dimension(nbody) :: status !! An integrator-specific status indicator - real(DP), dimension(NDIM,nbody) :: rh !! Heliocentric position - real(DP), dimension(NDIM,nbody) :: vh !! Heliocentric velocity - real(DP), dimension(NDIM,nbody) :: rb !! Barycentric position - real(DP), dimension(NDIM,nbody) :: vb !! Barycentric velocity - real(DP), dimension(NDIM,nbody) :: rot !! rotation vectors of fragments - real(DP), dimension(NDIM,nbody) :: Ip !! Principal axes moment of inertia for fragments - real(DP), dimension(nbody) :: Gmass !! G*mass of fragments - real(DP), dimension(nbody) :: mass !! masses of fragments - real(DP), dimension(nbody) :: radius !! Radii of fragments - real(DP), dimension(nbody) :: density !! Radii of fragments - real(DP), dimension(NDIM,nbody) :: rc !! Position vectors in the collision coordinate frame - real(DP), dimension(NDIM,nbody) :: vc !! Velocity vectors in the collision coordinate frame - real(DP), dimension(nbody) :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame - real(DP), dimension(nbody) :: rotmag !! Array of rotation magnitudes of individual fragments - real(DP), dimension(NDIM,nbody) :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame - real(DP), dimension(NDIM,nbody) :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame - integer(I1B), dimension(nbody) :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from - real(DP), dimension(NDIM) :: L_orbit_tot !! Orbital angular momentum vector of all fragments - real(DP), dimension(NDIM) :: L_spin_tot !! Spin angular momentum vector of all fragments - real(DP), dimension(NDIM,nbody) :: L_orbit !! Orbital angular momentum vector of each individual fragment - real(DP), dimension(NDIM,nbody) :: L_spin !! Spin angular momentum vector of each individual fragment + integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator + real(DP), dimension(:,:), allocatable :: rh !! Heliocentric position + real(DP), dimension(:,:), allocatable :: vh !! Heliocentric velocity + real(DP), dimension(:,:), allocatable :: rb !! Barycentric position + real(DP), dimension(:,:), allocatable :: vb !! Barycentric velocity + real(DP), dimension(:,:), allocatable :: rc !! Position vectors in the collision coordinate frame + real(DP), dimension(:,:), allocatable :: vc !! Velocity vectors in the collision coordinate frame + real(DP), dimension(:,:), allocatable :: r_unit !! Array of radial direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: v_unit !! Array of velocity direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: t_unit !! Array of tangential direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: n_unit !! Array of normal direction unit vectors of individual fragments in the collisional coordinate frame + real(DP), dimension(:,:), allocatable :: rot !! rotation vectors of fragments + real(DP), dimension(:,:), allocatable :: Ip !! Principal axes moment of inertia for fragments + real(DP), dimension(:), allocatable :: Gmass !! G*mass of fragments + real(DP), dimension(:), allocatable :: mass !! masses of fragments + real(DP), dimension(:), allocatable :: radius !! Radii of fragments + real(DP), dimension(:), allocatable :: density !! Radii of fragments + real(DP), dimension(:), allocatable :: rmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(:), allocatable :: vmag !! Array of radial distance magnitudes of individual fragments in the collisional coordinate frame + real(DP), dimension(:), allocatable :: rotmag !! Array of rotation magnitudes of individual fragments + integer(I1B), dimension(:), allocatable :: origin_body !! Array of indices indicating which impactor body (1 or 2) the fragment originates from + real(DP), dimension(NDIM) :: L_orbit_tot !! Orbital angular momentum vector of all fragments + real(DP), dimension(NDIM) :: L_spin_tot !! Spin angular momentum vector of all fragments + real(DP), dimension(:,:), allocatable :: L_orbit !! Orbital angular momentum vector of each individual fragment + real(DP), dimension(:,:), allocatable :: L_spin !! Spin angular momentum vector of each individual fragment real(DP) :: ke_orbit_tot !! Orbital kinetic energy of all fragments real(DP) :: ke_spin_tot !! Spin kinetic energy of all fragments real(DP) :: pe !! Potential energy of all fragments real(DP) :: be !! Binding energy of all fragments - real(DP), dimension(nbody) :: ke_orbit !! Orbital kinetic energy of each individual fragment - real(DP), dimension(nbody) :: ke_spin !! Spin kinetic energy of each individual fragment + real(DP), dimension(:), allocatable :: ke_orbit !! Orbital kinetic energy of each individual fragment + real(DP), dimension(:), allocatable :: ke_spin !! Spin kinetic energy of each individual fragment contains procedure :: dealloc => collision_util_dealloc_fragments !! Deallocates all allocatable arrays and sets everything else to 0 + procedure :: setup => collision_util_setup_fragments !! Allocates all allocatables procedure :: reset => collision_util_reset_fragments !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) procedure :: set_coordinate_system => collision_util_set_coordinate_fragments !! Sets the coordinate system of the fragments + final :: collision_final_fragments !! Finalizer deallocates all allocatables end type collision_fragments @@ -142,13 +144,13 @@ module collision !! to resolve collision by defining extended types of encounters_impactors and/or encounetr_fragments !! !! The generate method for this class is the merge model. This allows any extended type to have access to the merge procedure by selecting the collision_basic parent class - class(collision_fragments(:)), allocatable :: fragments !! Object containing information on the pre-collision system - class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system - class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision - class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the nbody_system containing products of the collision - integer(I4B) :: status !! Status flag to pass to the collision list once the collision has been resolved - integer(I4B) :: collision_id !! ID number of this collision event - integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number + class(collision_fragments), allocatable :: fragments !! Object containing information on the pre-collision system + class(collision_impactors), allocatable :: impactors !! Object containing information on the post-collision system + class(base_nbody_system), allocatable :: before !! A snapshot of the subset of the nbody_system involved in the collision + class(base_nbody_system), allocatable :: after !! A snapshot of the subset of the nbody_system containing products of the collision + integer(I4B) :: status !! Status flag to pass to the collision list once the collision has been resolved + integer(I4B) :: collision_id !! ID number of this collision event + integer(I4B) :: maxid_collision = 0 !! The current maximum collision id number ! Scale factors used to scale dimensioned quantities to a more "natural" system where important quantities (like kinetic energy, momentum) are of order ~1 real(DP) :: dscale = 1.0_DP !! Distance dimension scale factor @@ -403,7 +405,7 @@ end subroutine collision_util_construct_constraint_system module subroutine collision_util_dealloc_fragments(self) implicit none - class(collision_fragments(*)), intent(inout) :: self + class(collision_fragments), intent(inout) :: self end subroutine collision_util_dealloc_fragments module subroutine collision_util_dealloc_snapshot(self) @@ -413,7 +415,7 @@ end subroutine collision_util_dealloc_snapshot module subroutine collision_util_reset_fragments(self) implicit none - class(collision_fragments(*)), intent(inout) :: self + class(collision_fragments), intent(inout) :: self end subroutine collision_util_reset_fragments module subroutine collision_util_set_coordinate_collider(self) @@ -423,7 +425,7 @@ end subroutine collision_util_set_coordinate_collider module subroutine collision_util_set_coordinate_fragments(self) implicit none - class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + class(collision_fragments), intent(inout) :: self !! Collisional nbody_system end subroutine collision_util_set_coordinate_fragments module subroutine collision_util_set_coordinate_impactors(self) @@ -503,10 +505,29 @@ module subroutine collision_util_set_original_scale_factors(self) class(collision_basic), intent(inout) :: self !! collision system object end subroutine collision_util_set_original_scale_factors + module subroutine collision_util_setup_fragments(self, n) + implicit none + class(collision_fragments), intent(inout) :: self !! Swiftest generic body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + end subroutine collision_util_setup_fragments + end interface contains + subroutine collision_final_fragments(self) + !! author: David A. Minton + !! + !! Finalizer will deallocate all allocatables + implicit none + ! Arguments + type(collision_fragments), intent(inout) :: self !! Collision impactors storage object + + call self%dealloc() + + return + end subroutine collision_final_fragments + subroutine collision_final_impactors(self) !! author: David A. Minton !! diff --git a/src/collision/collision_util.f90 b/src/collision/collision_util.f90 index d33df2cfb..cb2b922a9 100644 --- a/src/collision/collision_util.f90 +++ b/src/collision/collision_util.f90 @@ -348,7 +348,7 @@ module subroutine collision_util_dealloc_fragments(self) !! Deallocates all allocatables implicit none ! Arguments - class(collision_fragments(*)), intent(inout) :: self + class(collision_fragments), intent(inout) :: self if (allocated(self%info)) deallocate(self%info) self%mtot = 0.0_DP @@ -434,7 +434,7 @@ module subroutine collision_util_reset_fragments(self) !! Resets all position and velocity-dependent fragment quantities in order to do a fresh calculation (does not reset mass, radius, or other values that get set prior to the call to fraggle_generate) implicit none ! Arguments - class(collision_fragments(*)), intent(inout) :: self + class(collision_fragments), intent(inout) :: self self%rc(:,:) = 0.0_DP self%vc(:,:) = 0.0_DP @@ -465,6 +465,111 @@ module subroutine collision_util_reset_fragments(self) return end subroutine collision_util_reset_fragments + + module subroutine collision_util_setup_fragments(self, n) + !! author: David A. Minton + !! + !! Constructor for fragment class. Allocates space for all particles and + implicit none + ! Arguments + class(collision_fragments), intent(inout) :: self !! Swiftest generic body object + integer(I4B), intent(in) :: n !! Number of particles to allocate space for + ! Internals + integer(I4B) :: i + + if (n < 0) return + + call self%dealloc() + + self%nbody = n + if (n == 0) return + + allocate(swiftest_particle_info :: self%info(n)) + allocate(self%id(n)) + allocate(self%status(n)) + allocate(self%rh(NDIM, n)) + allocate(self%vh(NDIM, n)) + allocate(self%rb(NDIM, n)) + allocate(self%vb(NDIM, n)) + allocate(self%rc(NDIM, n)) + allocate(self%vc(NDIM, n)) + allocate(self%r_unit(NDIM, n)) + allocate(self%v_unit(NDIM, n)) + allocate(self%t_unit(NDIM, n)) + allocate(self%n_unit(NDIM, n)) + allocate(self%rot(NDIM, n)) + allocate(self%Ip(NDIM, n)) + allocate(self%Gmass(n)) + allocate(self%mass(n)) + allocate(self%radius(n)) + allocate(self%density(n)) + allocate(self%rmag(n)) + allocate(self%vmag(n)) + allocate(self%rotmag(n)) + allocate(self%origin_body(n)) + allocate(self%L_orbit(NDIM, n)) + allocate(self%L_spin(NDIM, n)) + allocate(self%ke_orbit(n)) + allocate(self%ke_spin(n)) + + self%id(:) = 0 + select type(info => self%info) + class is (swiftest_particle_info) + do i = 1, n + call info(i)%set_value(& + name = "UNNAMED", & + particle_type = "UNKNOWN", & + status = "INACTIVE", & + origin_type = "UNKNOWN", & + collision_id = 0, & + origin_time = -huge(1.0_DP), & + origin_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + origin_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_time = huge(1.0_DP), & + discard_rh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_vh = [0.0_DP, 0.0_DP, 0.0_DP], & + discard_body_id = -1 & + ) + end do + end select + + self%mtot = 0.0_DP + self%status(:) = ACTIVE + self%rh(:,:) = 0.0_DP + self%vh(:,:) = 0.0_DP + self%rb(:,:) = 0.0_DP + self%vb(:,:) = 0.0_DP + self%rc(:,:) = 0.0_DP + self%vc(:,:) = 0.0_DP + self%r_unit(:,:) = 0.0_DP + self%v_unit(:,:) = 0.0_DP + self%t_unit(:,:) = 0.0_DP + self%n_unit(:,:) = 0.0_DP + self%rot(:,:) = 0.0_DP + self%Ip(:,:) = 0.0_DP + self%Gmass(:) = 0.0_DP + self%mass(:) = 0.0_DP + self%radius(:) = 0.0_DP + self%density(:) = 0.0_DP + self%rmag(:) = 0.0_DP + self%vmag(:) = 0.0_DP + self%rotmag(:) = 0.0_DP + self%origin_body(:) = 0 + self%L_orbit_tot(:) = 0.0_DP + self%L_spin_tot(:) = 0.0_DP + self%L_orbit(:,:) = 0.0_DP + self%L_spin(:,:) = 0.0_DP + self%ke_orbit_tot = 0.0_DP + self%ke_spin_tot = 0.0_DP + self%pe = 0.0_DP + self%be = 0.0_DP + self%ke_orbit(:) = 0.0_DP + self%ke_spin(:) = 0.0_DP + + return + end subroutine collision_util_setup_fragments + + module subroutine collision_util_set_coordinate_collider(self) !! @@ -492,7 +597,7 @@ module subroutine collision_util_set_coordinate_fragments(self) !! Defines the collisional coordinate nbody_system, including the unit vectors of both the nbody_system and individual fragments. implicit none ! Arguments - class(collision_fragments(*)), intent(inout) :: self !! Collisional nbody_system + class(collision_fragments), intent(inout) :: self !! Collisional nbody_system associate(fragments => self, nfrag => self%nbody) if ((nfrag == 0) .or. (.not.any(fragments%rc(:,:) > 0.0_DP))) return @@ -619,30 +724,8 @@ module subroutine collision_util_setup_fragments_collider(self, nfrag) integer(I4B), intent(in) :: nfrag !! Number of fragments to create if (allocated(self%fragments)) deallocate(self%fragments) - allocate(collision_fragments(nfrag) :: self%fragments) - self%fragments%nbody = nfrag - self%fragments%nbody = nfrag - self%fragments%status(:) = ACTIVE - self%fragments%rh(:,:) = 0.0_DP - self%fragments%vh(:,:) = 0.0_DP - self%fragments%rb(:,:) = 0.0_DP - self%fragments%vb(:,:) = 0.0_DP - self%fragments%rc(:,:) = 0.0_DP - self%fragments%vc(:,:) = 0.0_DP - self%fragments%rot(:,:) = 0.0_DP - self%fragments%Ip(:,:) = 0.0_DP - self%fragments%r_unit(:,:) = 0.0_DP - self%fragments%t_unit(:,:) = 0.0_DP - self%fragments%n_unit(:,:) = 0.0_DP - self%fragments%mass(:) = 0.0_DP - self%fragments%radius(:) = 0.0_DP - self%fragments%density(:) = 0.0_DP - self%fragments%rmag(:) = 0.0_DP - self%fragments%vmag(:) = 0.0_DP - self%fragments%L_orbit_tot(:) = 0.0_DP - self%fragments%L_spin_tot(:) = 0.0_DP - self%fragments%ke_orbit_tot = 0.0_DP - self%fragments%ke_spin_tot = 0.0_DP + allocate(collision_fragments :: self%fragments) + call self%fragments%setup(nfrag) return end subroutine collision_util_setup_fragments_collider diff --git a/src/fraggle/fraggle_module.f90 b/src/fraggle/fraggle_module.f90 index 84c88ba6b..a6c9e7c5c 100644 --- a/src/fraggle/fraggle_module.f90 +++ b/src/fraggle/fraggle_module.f90 @@ -22,8 +22,6 @@ module fraggle procedure :: generate => fraggle_generate !! A simple disruption models that does not constrain energy loss in collisions procedure :: hitandrun => fraggle_generate_hitandrun !! Generates either a pure hit and run, or one in which the runner is disrupted procedure :: set_mass_dist => fraggle_util_set_mass_dist !! Sets the distribution of mass among the fragments depending on the regime type - procedure :: setup_fragments => fraggle_util_setup_fragments_system !! Initializer for the fragments of the collision system. - !procedure :: reset => fraggle_util_dealloc_system !! Deallocates all allocatables end type collision_fraggle interface @@ -72,12 +70,6 @@ module subroutine fraggle_generate_vel_vec(collider, nbody_system, param, lfailu logical, intent(out) :: lfailure !! Did the velocity computation fail? end subroutine fraggle_generate_vel_vec - module subroutine fraggle_util_setup_fragments_system(self, nfrag) - implicit none - class(collision_fraggle), intent(inout) :: self !! Encounter collision system object - integer(I4B), intent(in) :: nfrag !! Number of fragments to create - end subroutine fraggle_util_setup_fragments_system - module subroutine fraggle_util_set_mass_dist(self, param) implicit none class(collision_fraggle), intent(inout) :: self !! Fraggle collision object diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index e9e2dc9bf..61d58e0c6 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -87,7 +87,7 @@ module subroutine fraggle_util_set_mass_dist(self, param) call self%setup_fragments(1) select type(fragments => self%fragments) - class is (collision_fragments(*)) + class is (collision_fragments) fragments%mass(1) = impactors%mass_dist(1) fragments%Gmass(1) = G * impactors%mass_dist(1) fragments%radius(1) = impactors%radius(jtarg) @@ -184,21 +184,4 @@ module subroutine fraggle_util_set_mass_dist(self, param) end subroutine fraggle_util_set_mass_dist - module subroutine fraggle_util_setup_fragments_system(self, nfrag) - !! author: David A. Minton - !! - !! Initializer for the fragments of the collision system. - implicit none - ! Arguments - class(collision_fraggle), intent(inout) :: self !! Encounter collision system object - integer(I4B), intent(in) :: nfrag !! Number of fragments to create - - if (allocated(self%fragments)) deallocate(self%fragments) - allocate(collision_fragments(nbody=nfrag) :: self%fragments) - self%fragments%nbody = nfrag - - return - end subroutine fraggle_util_setup_fragments_system - - end submodule s_fraggle_util diff --git a/src/swiftest/swiftest_module.f90 b/src/swiftest/swiftest_module.f90 index e63f8c05b..382aa107f 100644 --- a/src/swiftest/swiftest_module.f90 +++ b/src/swiftest/swiftest_module.f90 @@ -91,11 +91,9 @@ module swiftest !> An abstract class for a generic collection of Swiftest bodies - type, abstract, extends(base_object) :: swiftest_body + type, abstract, extends(base_multibody) :: swiftest_body !! Superclass that defines the generic elements of a Swiftest particle - integer(I4B) :: nbody = 0 !! Number of bodies logical :: lfirst = .true. !! Run the current step as a first - integer(I4B), dimension(:), allocatable :: id !! External identifier (unique) type(swiftest_particle_info), dimension(:), allocatable :: info !! Particle metadata information logical, dimension(:), allocatable :: lmask !! Logical mask used to select a subset of bodies when performing certain operations (drift, kick, accel, etc.) integer(I4B), dimension(:), allocatable :: status !! An integrator-specific status indicator diff --git a/src/swiftest/swiftest_util.f90 b/src/swiftest/swiftest_util.f90 index 4796906ec..48c325b46 100644 --- a/src/swiftest/swiftest_util.f90 +++ b/src/swiftest/swiftest_util.f90 @@ -712,10 +712,8 @@ module subroutine swiftest_util_dealloc_body(self) ! Argument class(swiftest_body), intent(inout) :: self - self%nbody = 0 self%lfirst = .true. - if (allocated(self%id)) deallocate(self%id) if (allocated(self%info)) deallocate(self%info) if (allocated(self%status)) deallocate(self%status) if (allocated(self%lmask)) deallocate(self%lmask) @@ -742,6 +740,8 @@ module subroutine swiftest_util_dealloc_body(self) if (allocated(self%omega)) deallocate(self%omega) if (allocated(self%capm)) deallocate(self%capm) + call base_util_dealloc_multibody(self) + return end subroutine swiftest_util_dealloc_body