Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
mask.f90
Go to the documentation of this file.
1! Copyright (c) 2020-2025, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
34module mask
35 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_associated, &
36 c_size_t
40 use device_math, only: device_cadd
41 use utils, only: neko_error
42
43 implicit none
44 private
45
51 type, public :: mask_t
52 private
53 integer :: n_elements = 0 ! Number of elements in the mask
54 integer, allocatable :: mask(:) ! The mask array
55 type(c_ptr) :: mask_d = c_null_ptr ! Pointer to the device mask array
56 logical :: is_set_ = .false. ! Flag to indicate if the mask is set
57
58 contains
59 ! Public interface for the mask type
60 generic, public :: init => init_from_array, init_from_array_device, &
62 procedure, public, pass(this) :: free => mask_free
63
64 procedure, public, pass(this) :: size => mask_size
65 procedure, public, pass(this) :: is_set => mask_is_set
66 procedure, public, pass(this) :: get_d => mask_get_d
67
68 generic, public :: set => mask_set, mask_set_d
69 generic, public :: get => mask_get, mask_get_i
70
71 ! Private procedures
72 procedure, pass(this) :: allocate => mask_allocate
73 procedure, pass(this) :: init_from_array
74 procedure, pass(this) :: init_from_array_device
75 procedure, pass(this) :: init_from_mask
76
77 ! Setters
78 procedure, pass(this) :: mask_set
79 procedure, pass(this) :: mask_set_d
80
81 ! Getters
82 procedure, pass(this) :: mask_get
83 procedure, pass(this) :: mask_get_i
84
85 end type mask_t
86
87contains
88
90 subroutine mask_allocate(this, n_elements)
91 class(mask_t), intent(inout) :: this
92 integer, intent(in) :: n_elements
93
94 this%is_set_ = .false.
95 if (n_elements .eq. this%n_elements) return
96 call this%free()
97
98 allocate(this%mask(n_elements))
99
100 if (neko_bcknd_device .eq. 1) then
101 call device_map(this%mask, this%mask_d, n_elements)
102 end if
103
104 this%n_elements = n_elements
105 end subroutine mask_allocate
106
108 subroutine mask_free(this)
109 class(mask_t), intent(inout) :: this
110
111 if (allocated(this%mask)) then
112 deallocate(this%mask)
113 end if
114
115 if (c_associated(this%mask_d)) then
116 call device_free(this%mask_d)
117 end if
118
119 this%n_elements = 0
120 this%mask_d = c_null_ptr
121 this%is_set_ = .false.
122 end subroutine mask_free
123
125 subroutine init_from_array(this, mask_array, n_elements)
126 class(mask_t), intent(inout) :: this
127 integer, intent(in) :: n_elements
128 integer, intent(in) :: mask_array(n_elements)
129
130 call this%allocate(n_elements)
131
132 this%mask = mask_array
133 if (neko_bcknd_device .eq. 1) then
134 call device_memcpy(this%mask, this%mask_d, this%n_elements, &
135 host_to_device, sync = .true.)
136 call device_cadd(this%mask_d, -1, this%n_elements)
137 end if
138
139 this%is_set_ = .true.
140 end subroutine init_from_array
141
143 subroutine init_from_array_device(this, mask_array_d, n_elements)
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
148
149 size_c = n_elements * int(4, c_size_t)
150
151 call this%allocate(n_elements)
152 call device_memcpy(this%mask_d, mask_array_d, size_c, &
153 device_to_device, sync = .false.)
154 call device_memcpy(this%mask, mask_array_d, n_elements, &
155 device_to_host, sync = .true.)
156 this%mask = this%mask - 1 ! Adjust for 0-based indexing
157
158 this%is_set_ = .true.
159 end subroutine init_from_array_device
160
162 subroutine init_from_mask(this, other)
163 class(mask_t), intent(inout) :: this
164 class(mask_t), intent(inout) :: other
165 integer(kind=c_size_t) :: size_c
166
167 call this%allocate(other%n_elements)
168
169 size_c = other%n_elements * int(4, c_size_t)
170
171 this%mask = other%mask
172 if (neko_bcknd_device .eq. 1) then
173 call device_memcpy(this%mask_d, other%mask_d, size_c, &
174 device_to_device, sync = .true.)
175 end if
176
177 this%n_elements = other%n_elements
178 this%is_set_ = other%is_set_
179 end subroutine init_from_mask
180
182 pure function mask_size(this) result(n_elements)
183 class(mask_t), intent(in) :: this
184 integer :: n_elements
185
186 n_elements = this%n_elements
187 end function mask_size
188
190 pure function mask_is_set(this) result(is_set)
191 class(mask_t), intent(in) :: this
192 logical :: is_set
193
194 is_set = this%is_set_
195 end function mask_is_set
196
198 function mask_get(this) result(mask_array)
199 class(mask_t), intent(in), target :: this
200 integer, pointer :: mask_array(:)
201
202 if (.not. this%is_set()) call neko_error("Mask is not set.")
203
204 mask_array => this%mask
205 end function mask_get
206
208 function mask_get_i(this, index) result(mask_value)
209 class(mask_t), intent(in), target :: this
210 integer, intent(in) :: index
211 integer :: mask_value
212
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")
216 end if
217
218 mask_value = this%mask(index)
219 end function mask_get_i
220
222 function mask_get_d(this) result(mask_array_d)
223 class(mask_t), intent(in) :: this
224 type(c_ptr) :: mask_array_d
225
226 if (.not. this%is_set()) call neko_error("Mask is not set.")
227
228 mask_array_d = this%mask_d
229 end function mask_get_d
230
232 subroutine mask_set(this, mask_array, n_elements)
233 class(mask_t), intent(inout) :: this
234 integer, intent(in) :: n_elements
235 integer, intent(in) :: mask_array(n_elements)
236
237 call this%allocate(n_elements)
238
239 this%mask = mask_array
240 if (neko_bcknd_device .eq. 1) then
241 call device_memcpy(this%mask, this%mask_d, n_elements, &
242 host_to_device, sync = .true.)
243 call device_cadd(this%mask_d, -1, n_elements)
244 end if
245
246 this%is_set_ = .true.
247 end subroutine mask_set
248
250 subroutine mask_set_d(this, mask_array_d, n_elements)
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
255
256 call this%allocate(n_elements)
257 size_c = n_elements * int(4, c_size_t)
258
259 call device_memcpy(this%mask_d, mask_array_d, size_c, &
260 device_to_device, sync = .false.)
261 call device_memcpy(this%mask, mask_array_d, n_elements, &
262 device_to_host, sync = .true.)
263 this%mask = this%mask - 1 ! Adjust for 0-based indexing
264
265 this%is_set_ = .true.
266 end subroutine mask_set_d
267
268
269end module mask
Map a Fortran array to a device (allocate and associate)
Definition device.F90:72
Copy data between host and device (or device and device)
Definition device.F90:66
Device abstraction, common interface for various accelerators.
Definition device.F90:34
integer, parameter, public device_to_device
Definition device.F90:47
integer, parameter, public host_to_device
Definition device.F90:47
subroutine, public device_free(x_d)
Deallocate memory on the device.
Definition device.F90:214
integer, parameter, public device_to_host
Definition device.F90:47
Object for handling masks in Neko.
Definition mask.f90:34
pure logical function mask_is_set(this)
Check if the mask is set.
Definition mask.f90:191
integer function, dimension(:), pointer mask_get(this)
Get the mask array.
Definition mask.f90:199
subroutine init_from_array(this, mask_array, n_elements)
Initialize the mask from a 1-indexed host array.
Definition mask.f90:126
subroutine init_from_mask(this, other)
Initialize the mask from another mask object.
Definition mask.f90:163
pure integer function mask_size(this)
Get the size of the mask.
Definition mask.f90:183
subroutine mask_allocate(this, n_elements)
Allocate the mask object.
Definition mask.f90:91
integer function mask_get_i(this, index)
Get the mask array.
Definition mask.f90:209
subroutine mask_set_d(this, mask_array_d, n_elements)
Set the mask from a 0-indexed device array.
Definition mask.f90:251
subroutine mask_free(this)
Free the mask object.
Definition mask.f90:109
subroutine mask_set(this, mask_array, n_elements)
Set the mask from a 1-indexed host array.
Definition mask.f90:233
type(c_ptr) function mask_get_d(this)
Get the device pointer to the mask array.
Definition mask.f90:223
subroutine init_from_array_device(this, mask_array_d, n_elements)
Initialize the mask from a 0-indexed device array.
Definition mask.f90:144
Build configurations.
integer, parameter neko_bcknd_device
Utilities.
Definition utils.f90:35
Type for consistently handling masks in Neko. This type encapsulates the mask array and its associate...
Definition mask.f90:51