Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
field.f90
Go to the documentation of this file.
1! Copyright (c) 2018-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 field
36 use device_math
37 use num_types, only : rp, c_rp
39 use math, only : add2, copy, cadd
40 use mesh, only : mesh_t
41 use space, only : space_t, operator(.ne.)
42 use dofmap, only : dofmap_t
43 use, intrinsic :: iso_c_binding
44 implicit none
45 private
46
47 type, public :: field_t
48 real(kind=rp), allocatable :: x(:,:,:,:)
49
50 type(space_t), pointer :: xh
51 type(mesh_t), pointer :: msh
52 type(dofmap_t), pointer :: dof
53
54 logical :: internal_dofmap = .false.
55 character(len=80) :: name
56 type(c_ptr) :: x_d = c_null_ptr
57 contains
58 procedure, private, pass(this) :: init_common => field_init_common
59 procedure, private, pass(this) :: init_external_dof => &
61 procedure, private, pass(this) :: init_internal_dof => &
63 procedure, private, pass(this) :: assign_field => field_assign_field
64 procedure, private, pass(this) :: assign_scalar => field_assign_scalar
65 procedure, private, pass(this) :: add_field => field_add_field
66 procedure, private, pass(this) :: add_scalar => field_add_scalar
67 procedure, pass(this) :: free => field_free
69 procedure, pass(this) :: size => field_size
71 generic :: init => init_external_dof, init_internal_dof
73 generic :: assignment(=) => assign_field, assign_scalar
77 generic :: add => add_field, add_scalar
78 end type field_t
79
81 type, public :: field_ptr_t
82 type(field_t), pointer :: ptr => null()
83 end type field_ptr_t
84
85contains
86
88 subroutine field_init_internal_dof(this, msh, space, fld_name)
89 class(field_t), intent(inout) :: this
90 type(mesh_t), target, intent(in) :: msh
91 type(space_t), target, intent(in) :: space
92 character(len=*), optional :: fld_name
93
94 call this%free()
95
96 this%Xh => space
97 this%msh => msh
98
99 allocate(this%dof)
100 call this%dof%init(this%msh, this%Xh)
101 this%internal_dofmap = .true.
102
103 if (present(fld_name)) then
104 call this%init_common(fld_name)
105 else
106 call this%init_common()
107 end if
108
109 end subroutine field_init_internal_dof
110
112 subroutine field_init_external_dof(this, dof, fld_name)
113 class(field_t), intent(inout) :: this
114 type(dofmap_t), target, intent(in) :: dof
115 character(len=*), optional :: fld_name
116
117 call this%free()
118
119 this%dof => dof
120 this%Xh => dof%Xh
121 this%msh => dof%msh
122
123 if (present(fld_name)) then
124 call this%init_common(fld_name)
125 else
126 call this%init_common()
127 end if
128
129 end subroutine field_init_external_dof
130
132 subroutine field_init_common(this, fld_name)
133 class(field_t), intent(inout) :: this
134 character(len=*), optional :: fld_name
135 integer :: ierr
136 integer :: n
137
138 associate(lx => this%Xh%lx, ly => this%Xh%ly, &
139 lz => this%Xh%lz, nelv => this%msh%nelv)
140
141 if (.not. allocated(this%x)) then
142 allocate(this%x(lx, ly, lz, nelv), stat = ierr)
143 this%x = 0.0_rp
144 end if
145
146 if (present(fld_name)) then
147 this%name = fld_name
148 else
149 this%name = "Field"
150 end if
151
152 if (neko_bcknd_device .eq. 1) then
153 n = lx * ly * lz * nelv
154 call device_map(this%x, this%x_d, n)
155 block
156 real(c_rp) :: rp_dummy
157 integer(c_size_t) :: s
158 s = c_sizeof(rp_dummy) * n
159 call device_memset(this%x_d, 0, s, sync = .true.)
160 end block
161 end if
162 end associate
163
164 end subroutine field_init_common
165
167 subroutine field_free(this)
168 class(field_t), intent(inout) :: this
169
170 if (allocated(this%x)) then
171 deallocate(this%x)
172 end if
173
174 if (this%internal_dofmap) then
175 deallocate(this%dof)
176 this%internal_dofmap = .false.
177 end if
178
179 nullify(this%msh)
180 nullify(this%Xh)
181 nullify(this%dof)
182
183 if (c_associated(this%x_d)) then
184 call device_free(this%x_d)
185 end if
186
187 end subroutine field_free
188
192 subroutine field_assign_field(this, g)
193 class(field_t), intent(inout) :: this
194 type(field_t), intent(in) :: g
195
196 if (allocated(this%x)) then
197 if (this%Xh .ne. g%Xh) then
198 call this%free()
199 end if
200 end if
201
202 this%Xh => g%Xh
203 this%msh => g%msh
204 this%dof => g%dof
205
206
207 this%Xh%lx = g%Xh%lx
208 this%Xh%ly = g%Xh%ly
209 this%Xh%lz = g%Xh%lz
210
211 if (.not. allocated(this%x)) then
212
213 allocate(this%x(this%Xh%lx, this%Xh%ly, this%Xh%lz, this%msh%nelv))
214
215 if (neko_bcknd_device .eq. 1) then
216 call device_map(this%x, this%x_d, this%size())
217 end if
218
219 end if
220
221 if (neko_bcknd_device .eq. 1) then
222 call device_copy(this%x_d, g%x_d, this%size())
223 else
224 call copy(this%x, g%x, this%dof%size())
225 end if
226
227 end subroutine field_assign_field
228
230 subroutine field_assign_scalar(this, a)
231 class(field_t), intent(inout) :: this
232 real(kind=rp), intent(in) :: a
233 integer :: i, j, k, l
234
235 if (neko_bcknd_device .eq. 1) then
236 call device_cfill(this%x_d, a, this%size())
237 else
238 do i = 1, this%msh%nelv
239 do l = 1, this%Xh%lz
240 do k = 1, this%Xh%ly
241 do j = 1, this%Xh%lx
242 this%x(j, k, l, i) = a
243 end do
244 end do
245 end do
246 end do
247 end if
248
249 end subroutine field_assign_scalar
250
254 subroutine field_add_field(this, g)
255 class(field_t), intent(inout) :: this
256 type(field_t), intent(in) :: g
257
258 if (neko_bcknd_device .eq. 1) then
259 call device_add2(this%x_d, g%x_d, this%size())
260 else
261 call add2(this%x, g%x, this%size())
262 end if
263
264 end subroutine field_add_field
265
266
269 subroutine field_add_scalar(this, a)
270 class(field_t), intent(inout) :: this
271 real(kind=rp), intent(in) :: a
272
273 if (neko_bcknd_device .eq. 1) then
274 call device_cadd(this%x_d, a, this%size())
275 else
276 call cadd(this%x, a, this%size())
277 end if
278
279 end subroutine field_add_scalar
280
282 pure function field_size(this) result(size)
283 class(field_t), intent(in) :: this
284 integer :: size
285
286 size = this%dof%size()
287 end function field_size
288
289end module field
Map a Fortran array to a device (allocate and associate)
Definition device.F90:72
Device abstraction, common interface for various accelerators.
Definition device.F90:34
subroutine, public device_free(x_d)
Deallocate memory on the device.
Definition device.F90:214
subroutine, public device_memset(x_d, v, s, sync, strm)
Set memory on the device to a value.
Definition device.F90:233
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
Defines a field.
Definition field.f90:34
subroutine field_add_field(this, g)
Add .
Definition field.f90:255
pure integer function field_size(this)
Return the size of the field based on the underlying dofmap.
Definition field.f90:283
subroutine field_assign_field(this, g)
Assignment .
Definition field.f90:193
subroutine field_add_scalar(this, a)
Add .
Definition field.f90:270
subroutine field_assign_scalar(this, a)
Assignment .
Definition field.f90:231
subroutine field_init_common(this, fld_name)
Initialize a field this.
Definition field.f90:133
subroutine field_init_external_dof(this, dof, fld_name)
Initialize a field this on the mesh msh using an internal dofmap.
Definition field.f90:113
subroutine field_init_internal_dof(this, msh, space, fld_name)
Initialize a field this on the mesh msh using an internal dofmap.
Definition field.f90:89
subroutine field_free(this)
Deallocate a field f.
Definition field.f90:168
Definition math.f90:60
subroutine, public cadd(a, s, n)
Add a scalar to vector .
Definition math.f90:468
subroutine, public add2(a, b, n)
Vector addition .
Definition math.f90:732
subroutine, public copy(a, b, n)
Copy a vector .
Definition math.f90:255
Defines a mesh.
Definition mesh.f90:34
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public c_rp
Definition num_types.f90:13
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Defines a function space.
Definition space.f90:34
field_ptr_t, To easily obtain a pointer to a field
Definition field.f90:81
The function space for the SEM solution fields.
Definition space.f90:62