Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
field_list.f90
Go to the documentation of this file.
2 use, intrinsic :: iso_fortran_env, only: error_unit
3 use field, only : field_ptr_t, field_t
4 use iso_c_binding, only : c_ptr
5 use num_types, only : rp
6 use space, only : space_t
7 use dofmap, only : dofmap_t
8 use mesh, only : mesh_t
9 use utils, only : neko_error
10 use comm, only : pe_rank
11 implicit none
12 private
13
15 type, public :: field_list_t
16 type(field_ptr_t), allocatable :: items(:)
17 contains
19 procedure, pass(this) :: init => field_list_init
21 procedure, pass(this) :: free => field_list_free
23 procedure, pass(this) :: append => field_list_append
24 generic :: get => get_by_index, get_by_name
26 procedure, pass(this) :: get_by_index => field_list_get_by_index
28 procedure, pass(this) :: get_by_name => field_list_get_by_name
30 generic :: assign => assign_to_ptr, assign_to_field_ptr
31 procedure, pass(this) :: assign_to_ptr => field_list_assign_to_ptr
32 procedure, pass(this) :: assign_to_field_ptr => field_list_assign_to_field_ptr
33 procedure, pass(this) :: assign_to_field => field_list_assign_to_field
34
36 procedure, pass(this) :: x_d => field_list_x_d
38 procedure, pass(this) :: x => field_list_x
40 procedure, pass(this) :: size => field_list_size
42 procedure, pass(this) :: item_size => field_list_item_size
44 procedure, pass(this) :: dof => field_list_dof
46 procedure, pass(this) :: xh => field_list_space
48 procedure, pass(this) :: msh => field_list_msh
50 procedure, pass(this) :: internal_dofmap => field_list_internal_dofmap
52 procedure, pass(this) :: name => field_list_name
53 end type field_list_t
54
55contains
58 subroutine field_list_init(this, size)
59 class(field_list_t), intent(inout) :: this
60 integer, intent(in) :: size
61
62 call this%free()
63
64 allocate(this%items(size))
65 end subroutine field_list_init
66
68 pure function field_list_size(this) result(n)
69 class(field_list_t), intent(in) :: this
70 integer :: n
71 n = size(this%items)
72 end function field_list_size
73
76 function field_list_get_by_index(this, i) result(f)
77 class(field_list_t), intent(inout) :: this
78 type(field_t), pointer :: f
79 integer, intent(in) :: i
80 f => this%items(i)%ptr
81 end function field_list_get_by_index
82
85 function field_list_get_by_name(this, name) result(f)
86 class(field_list_t), intent(inout) :: this
87 type(field_t), pointer :: f
88 character(len=*), intent(in) :: name
89 integer :: i
90
91 nullify(f)
92
93 do i=1, this%size()
94 if (this%name(i) .eq. trim(name)) then
95 f => this%items(i)%ptr
96 return
97 end if
98 end do
99
100 if (pe_rank .eq. 0) then
101 write(error_unit,*) "Current field list contents:"
102
103 do i=1, this%size()
104 write(error_unit,*) "- ", this%name(i)
105 end do
106 end if
107
108 call neko_error("No field with name " // trim(name) // " found in list")
109 end function field_list_get_by_name
110
113 subroutine field_list_append(this, f)
114 class(field_list_t), intent(inout) :: this
115 class(field_t), intent(in), target :: f
116 type(field_ptr_t), allocatable :: tmp(:)
117 integer :: len
118
119 len = size(this%items)
120
121 allocate(tmp(len+1))
122 tmp(1:len) = this%items
123 call move_alloc(tmp, this%items)
124 this%items(len+1)%ptr => f
125
126 end subroutine field_list_append
127
129 subroutine field_list_free(this)
130 class(field_list_t), intent(inout) :: this
131 integer :: i, n_fields
132
133 if (allocated(this%items)) then
134 n_fields = this%size()
135 do i=1, n_fields
136 if (associated(this%items(i)%ptr)) then
137 call this%items(i)%ptr%free()
138 end if
139 nullify(this%items(i)%ptr)
140 end do
141 deallocate(this%items)
142 end if
143
144 end subroutine field_list_free
145
148 function field_list_x_d(this, i) result(ptr)
149 class(field_list_t), intent(in) :: this
150 integer, intent(in) :: i
151 type(c_ptr) :: ptr
152
153 ptr = this%items(i)%ptr%x_d
154 end function field_list_x_d
155
156 function field_list_x(this, i) result(x)
157 class(field_list_t), target, intent(in) :: this
158 real(kind=rp), pointer :: x(:,:,:,:)
159 integer, intent(in) :: i
160 x => this%items(i)%ptr%x
161 end function field_list_x
162
165 function field_list_item_size(this, i) result(size)
166 class(field_list_t), target, intent(in) :: this
167 integer, intent(in) :: i
168 integer :: size
169
170 size = this%items(i)%ptr%size()
171
172 end function field_list_item_size
173
177 subroutine field_list_assign_to_ptr(this, i, ptr)
178 class(field_list_t), intent(inout) :: this
179 integer, intent(in) :: i
180 type(field_t), pointer, intent(in) :: ptr
181
182 this%items(i)%ptr => ptr
183 end subroutine field_list_assign_to_ptr
184
188 subroutine field_list_assign_to_field_ptr(this, i, ptr)
189 class(field_list_t), intent(inout) :: this
190 integer, intent(in) :: i
191 type(field_ptr_t), target, intent(in) :: ptr
192
193 this%items(i)%ptr => ptr%ptr
194 end subroutine field_list_assign_to_field_ptr
195
199 subroutine field_list_assign_to_field(this, i, fld)
200 class(field_list_t), intent(inout) :: this
201 integer, intent(in) :: i
202 type(field_t), target, intent(in) :: fld
203
204 this%items(i)%ptr => fld
205 end subroutine field_list_assign_to_field
206
209 function field_list_dof(this, i) result(result)
210 class(field_list_t), target, intent(in) :: this
211 integer, intent(in) :: i
212 type(dofmap_t), pointer :: result
213
214 result => this%items(i)%ptr%dof
215 end function field_list_dof
216
219 function field_list_space(this, i) result(result)
220 class(field_list_t), target, intent(in) :: this
221 integer, intent(in) :: i
222 type(space_t), pointer :: result
223
224 result => this%items(i)%ptr%Xh
225 end function field_list_space
226
229 function field_list_msh(this, i) result(result)
230 class(field_list_t), target, intent(in) :: this
231 integer, intent(in) :: i
232 type(mesh_t), pointer :: result
233
234 result => this%items(i)%ptr%msh
235 end function field_list_msh
236
239 function field_list_internal_dofmap(this, i) result(result)
240 class(field_list_t), target, intent(in) :: this
241 integer, intent(in) :: i
242 logical :: result
243
244 result = this%items(i)%ptr%internal_dofmap
245 end function field_list_internal_dofmap
246
249 function field_list_name(this, i) result(result)
250 class(field_list_t), target, intent(in) :: this
251 integer, intent(in) :: i
252 character(len=80) :: result
253
254 result = this%items(i)%ptr%name
255 end function field_list_name
256
257
258end module field_list
Definition comm.F90:1
integer, public pe_rank
MPI rank.
Definition comm.F90:55
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
type(dofmap_t) function, pointer field_list_dof(this, i)
Get the the dofmap for item i.
subroutine field_list_init(this, size)
Constructor. Just allocates the array.
type(space_t) function, pointer field_list_space(this, i)
Get the the space for item i.
subroutine field_list_assign_to_ptr(this, i, ptr)
Point item at a given index.
pure integer function field_list_size(this)
Get number of items in the list.
subroutine field_list_assign_to_field_ptr(this, i, ptr)
Point item at a given index.
integer function field_list_item_size(this, i)
Get the size of the dofmap for item i.
character(len=80) function field_list_name(this, i)
Get the name for an item in the list.
logical function field_list_internal_dofmap(this, i)
Whether the dofmap is internal for item i.
real(kind=rp) function, dimension(:,:,:,:), pointer field_list_x(this, i)
type(field_t) function, pointer field_list_get_by_index(this, i)
Get an item pointer by array index.
type(mesh_t) function, pointer field_list_msh(this, i)
Get the the mesh for item i.
subroutine field_list_assign_to_field(this, i, fld)
Point item at a given index.
type(c_ptr) function field_list_x_d(this, i)
Get device pointer for a given index.
subroutine field_list_free(this)
Destructor.
subroutine field_list_append(this, f)
Append a field to the list.
type(field_t) function, pointer field_list_get_by_name(this, name)
Get an item pointer by array index.
Defines a field.
Definition field.f90:34
Defines a mesh.
Definition mesh.f90:34
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Defines a function space.
Definition space.f90:34
Utilities.
Definition utils.f90:35
field_ptr_t, To easily obtain a pointer to a field
Definition field.f90:81
field_list_t, To be able to group fields together
The function space for the SEM solution fields.
Definition space.f90:62