Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
source_term.f90
Go to the documentation of this file.
1! Copyright (c) 2023, 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!
35 use num_types, only : rp
36 use coefs, only : coef_t
37 use field_list, only : field_list_t
38 use json_module, only : json_file
39 use time_state, only : time_state_t
40 implicit none
41 private
42
44 type, abstract, public :: source_term_t
46 type(field_list_t) :: fields
48 type(coef_t), pointer :: coef => null()
50 real(kind=rp) :: start_time = 0.0_rp
52 real(kind=rp) :: end_time = huge(0.0_rp)
53 contains
55 procedure, pass(this) :: init_base => source_term_init_base
57 procedure, pass(this) :: free_base => source_term_free_base
59 procedure, pass(this) :: compute => source_term_compute_wrapper
61 procedure(source_term_init), pass(this), deferred :: init
63 procedure(source_term_free), pass(this), deferred :: free
65 procedure(source_term_compute), pass(this), deferred :: compute_
66 end type source_term_t
67
68
70 type, public :: source_term_wrapper_t
72 class(source_term_t), allocatable :: source_term
73 contains
75 procedure, pass(this) :: free => source_term_wrapper_free
77
78 abstract interface
79
85 subroutine source_term_init(this, json, fields, coef, variable_name)
86 import source_term_t, json_file, field_list_t, coef_t
87 class(source_term_t), intent(inout) :: this
88 type(json_file), intent(inout) :: json
89 type(field_list_t), intent(in), target :: fields
90 type(coef_t), intent(in), target :: coef
91 character(len=*), intent(in) :: variable_name
92 end subroutine source_term_init
93 end interface
94
95 abstract interface
96
97 subroutine source_term_free(this)
98 import source_term_t
99 class(source_term_t), intent(inout) :: this
100 end subroutine source_term_free
101 end interface
102
103 abstract interface
104
107 subroutine source_term_compute(this, time)
109 class(source_term_t), intent(inout) :: this
110 type(time_state_t), intent(in) :: time
111 end subroutine source_term_compute
112 end interface
113
114 interface
115
122 module subroutine source_term_factory(object, json, fields, coef, &
123 variable_name)
124 class(source_term_t), allocatable, intent(inout) :: object
125 type(json_file), intent(inout) :: json
126 type(field_list_t), intent(inout) :: fields
127 type(coef_t), intent(inout) :: coef
128 character(len=*), intent(in) :: variable_name
129 end subroutine source_term_factory
130 end interface
131
132 interface
133
136 module subroutine source_term_allocator(object, type_name)
137 class(source_term_t), allocatable, intent(inout) :: object
138 character(len=:), allocatable, intent(in) :: type_name
139 end subroutine source_term_allocator
140 end interface
141
142 !
143 ! Machinery for injecting user-defined types
144 !
145
149 abstract interface
150 subroutine source_term_allocate(obj)
151 import source_term_t
152 class(source_term_t), allocatable, intent(inout) :: obj
153 end subroutine source_term_allocate
154 end interface
155
156 interface
157
158 module subroutine register_source_term(type_name, allocator)
159 character(len=*), intent(in) :: type_name
160 procedure(source_term_allocate), pointer, intent(in) :: allocator
161 end subroutine register_source_term
162 end interface
163
164 ! A name-allocator pair for user-defined types. A helper type to define a
165 ! registry of custom allocators.
166 type allocator_entry
167 character(len=20) :: type_name
168 procedure(source_term_allocate), pointer, nopass :: allocator
169 end type allocator_entry
170
172 type(allocator_entry), allocatable :: source_term_registry(:)
173
175 integer :: source_term_registry_size = 0
176
177 public :: source_term_factory, source_term_allocator, register_source_term, &
178 source_term_allocate
179
180contains
181
188 subroutine source_term_init_base(this, fields, coef, start_time, end_time)
189 class(source_term_t), intent(inout) :: this
190 type(field_list_t) :: fields
191 type(coef_t), intent(in), target :: coef
192 real(kind=rp), intent(in) :: start_time
193 real(kind=rp), intent(in) :: end_time
194 integer :: n_fields, i
195
196 this%coef => coef
197 this%start_time = start_time
198 this%end_time = end_time
199 n_fields = fields%size()
200
201 call this%fields%init(n_fields)
202
203 ! A lot of attribute nesting here due to Fortran needing wrapper types
204 ! but this is just pointer assignement for the fields.
205 do i = 1, n_fields
206 call this%fields%assign(i, fields%get(i))
207 end do
208 end subroutine source_term_init_base
209
211 subroutine source_term_free_base(this)
212 class(source_term_t), intent(inout) :: this
213
214 call this%fields%free()
215 nullify(this%coef)
216 end subroutine source_term_free_base
217
219 subroutine source_term_wrapper_free(this)
220 class(source_term_wrapper_t), intent(inout) :: this
221 integer :: n_fields, i
222
223 if (allocated(this%source_term)) then
224 call this%source_term%free()
225 deallocate(this%source_term)
226 end if
227 end subroutine source_term_wrapper_free
228
231 subroutine source_term_compute_wrapper(this, time)
232 class(source_term_t), intent(inout) :: this
233 type(time_state_t), intent(in) :: time
234
235 if (time%t .ge. this%start_time .and. time%t .le. this%end_time) then
236 call this%compute_(time)
237 end if
238
239 end subroutine source_term_compute_wrapper
240end module source_term
Computes the source term and adds the result to fields.
The common constructor using a JSON object.
Coefficients.
Definition coef.f90:34
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Implements the source_term_t type and a wrapper source_term_wrapper_t.
subroutine source_term_wrapper_free(this)
Destructor for the source_term_wrapper_t type.
subroutine source_term_compute_wrapper(this, time)
Executes compute_ based on time conditions.
subroutine source_term_free_base(this)
Destructor for the source_term_t (base) type.
subroutine source_term_init_base(this, fields, coef, start_time, end_time)
Constructor for the source_term_t (base) type.
Module with things related to the simulation time.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:55
field_list_t, To be able to group fields together
Base abstract type for source terms.
A helper type that is needed to have an array of polymorphic objects.
A struct that contains all info about the time, expand as needed.