35 use,
intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_associated, &
53 integer :: n_elements = 0
54 integer,
allocatable ::
mask(:)
55 type(c_ptr) :: mask_d = c_null_ptr
56 logical :: is_set_ = .false.
91 class(
mask_t),
intent(inout) :: this
92 integer,
intent(in) :: n_elements
94 this%is_set_ = .false.
95 if (n_elements .eq. this%n_elements)
return
98 allocate(this%mask(n_elements))
101 call device_map(this%mask, this%mask_d, n_elements)
104 this%n_elements = n_elements
109 class(
mask_t),
intent(inout) :: this
111 if (
allocated(this%mask))
then
112 deallocate(this%mask)
115 if (c_associated(this%mask_d))
then
120 this%mask_d = c_null_ptr
121 this%is_set_ = .false.
126 class(
mask_t),
intent(inout) :: this
127 integer,
intent(in) :: n_elements
128 integer,
intent(in) :: mask_array(n_elements)
130 call this%allocate(n_elements)
132 this%mask = mask_array
134 call device_memcpy(this%mask, this%mask_d, this%n_elements, &
139 this%is_set_ = .true.
144 class(
mask_t),
intent(inout) :: this
145 integer,
intent(in) :: n_elements
146 type(c_ptr),
intent(inout):: mask_array_d
147 integer(kind=c_size_t) :: size_c
149 size_c = n_elements * int(4, c_size_t)
151 call this%allocate(n_elements)
156 this%mask = this%mask - 1
158 this%is_set_ = .true.
163 class(
mask_t),
intent(inout) :: this
164 class(
mask_t),
intent(inout) :: other
165 integer(kind=c_size_t) :: size_c
167 call this%allocate(other%n_elements)
169 size_c = other%n_elements * int(4, c_size_t)
171 this%mask = other%mask
177 this%n_elements = other%n_elements
178 this%is_set_ = other%is_set_
183 class(
mask_t),
intent(in) :: this
184 integer :: n_elements
186 n_elements = this%n_elements
191 class(
mask_t),
intent(in) :: this
194 is_set = this%is_set_
199 class(
mask_t),
intent(in),
target :: this
200 integer,
pointer :: mask_array(:)
202 if (.not. this%is_set())
call neko_error(
"Mask is not set.")
204 mask_array => this%mask
209 class(
mask_t),
intent(in),
target :: this
210 integer,
intent(in) :: index
211 integer :: mask_value
213 if (.not. this%is_set())
call neko_error(
"Mask is not set.")
214 if (index < 1 .or. index > this%n_elements)
then
215 call neko_error(
"Index out of bounds in mask_get_i")
218 mask_value = this%mask(index)
223 class(
mask_t),
intent(in) :: this
224 type(c_ptr) :: mask_array_d
226 if (.not. this%is_set())
call neko_error(
"Mask is not set.")
228 mask_array_d = this%mask_d
233 class(
mask_t),
intent(inout) :: this
234 integer,
intent(in) :: n_elements
235 integer,
intent(in) :: mask_array(n_elements)
237 call this%allocate(n_elements)
239 this%mask = mask_array
246 this%is_set_ = .true.
251 class(
mask_t),
intent(inout) :: this
252 integer,
intent(in) :: n_elements
253 type(c_ptr),
intent(inout) :: mask_array_d
254 integer(kind=c_size_t) :: size_c
256 call this%allocate(n_elements)
257 size_c = n_elements * int(4, c_size_t)
263 this%mask = this%mask - 1
265 this%is_set_ = .true.
Map a Fortran array to a device (allocate and associate)
Copy data between host and device (or device and device)
Device abstraction, common interface for various accelerators.
integer, parameter, public device_to_device
integer, parameter, public host_to_device
subroutine, public device_free(x_d)
Deallocate memory on the device.
integer, parameter, public device_to_host
Object for handling masks in Neko.
pure logical function mask_is_set(this)
Check if the mask is set.
integer function, dimension(:), pointer mask_get(this)
Get the mask array.
subroutine init_from_array(this, mask_array, n_elements)
Initialize the mask from a 1-indexed host array.
subroutine init_from_mask(this, other)
Initialize the mask from another mask object.
pure integer function mask_size(this)
Get the size of the mask.
subroutine mask_allocate(this, n_elements)
Allocate the mask object.
integer function mask_get_i(this, index)
Get the mask array.
subroutine mask_set_d(this, mask_array_d, n_elements)
Set the mask from a 0-indexed device array.
subroutine mask_free(this)
Free the mask object.
subroutine mask_set(this, mask_array, n_elements)
Set the mask from a 1-indexed host array.
type(c_ptr) function mask_get_d(this)
Get the device pointer to the mask array.
subroutine init_from_array_device(this, mask_array_d, n_elements)
Initialize the mask from a 0-indexed device array.
integer, parameter neko_bcknd_device
Type for consistently handling masks in Neko. This type encapsulates the mask array and its associate...