From efdb2cf2e3b0b25b412e4225cee7c956ed1e8c3f Mon Sep 17 00:00:00 2001 From: Paul Bartholomew Date: Fri, 17 Jan 2025 12:20:30 +0000 Subject: [PATCH] The best approach seems to be resolving the type inside create_block --- src/allocator.f90 | 14 +++++++++++--- src/cuda/allocator.f90 | 6 +++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/src/allocator.f90 b/src/allocator.f90 index 69c3eeed..1ab587d9 100644 --- a/src/allocator.f90 +++ b/src/allocator.f90 @@ -97,15 +97,23 @@ subroutine compute_padded_dims(self, sz) end subroutine - function create_block(self) result(ptr) + function create_block(self, next) result(ptr) !! Allocate memory for a new block and return a pointer to a new !! [[m_allocator(module):field_t(type)]] object. class(allocator_t), intent(inout) :: self + class(field_t), pointer, intent(in) :: next type(field_t), pointer :: newblock class(field_t), pointer :: ptr self%next_id = self%next_id + 1 allocate (newblock) - newblock = field_t(self%ngrid, self%first, id=self%next_id) + associate(p_next => next) + select type (p_next) + type is (field_t) + newblock = field_t(self%ngrid, p_next, id=self%next_id) + class default + error stop "Incorrect overloading for create_block" + end select + end associate ptr => newblock end function create_block @@ -130,7 +138,7 @@ function get_block(self, dir, data_loc) result(handle) if (.not. associated(self%first)) then ! Construct a field_t. This effectively allocates ! storage space. - self%first => self%create_block() + self%first => self%create_block(self%first) end if handle => self%first self%first => self%first%next ! 2nd block becomes head block diff --git a/src/cuda/allocator.f90 b/src/cuda/allocator.f90 index 3d1fbc4d..9bcdf911 100644 --- a/src/cuda/allocator.f90 +++ b/src/cuda/allocator.f90 @@ -79,14 +79,14 @@ function cuda_allocator_init(mesh, sz) result(allocator) allocator%allocator_t = allocator_t(mesh, sz) end function cuda_allocator_init - function create_cuda_block(self) result(ptr) + function create_cuda_block(self, next) result(ptr) class(cuda_allocator_t), intent(inout) :: self - type(cuda_field_t), pointer, intent(in) :: next + type(cuda_field_t), pointer :: next type(cuda_field_t), pointer :: newblock class(field_t), pointer :: ptr allocate (newblock) self%next_id = self%next_id + 1 - newblock = cuda_field_t(self%ngrid, self%first, id=self%next_id) + newblock = cuda_field_t(self%ngrid, next, id=self%next_id) ptr => newblock end function create_cuda_block