Loading [MathJax]/jax/input/TeX/config.js
Neko 0.9.99
A portable framework for high-order spectral element flow simulations
All Classes Namespaces Files Functions Variables Typedefs Enumerator Macros Pages
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 implicit none
40 private
41
43 type, abstract, public :: source_term_t
45 type(field_list_t) :: fields
47 type(coef_t), pointer :: coef => null()
49 real(kind=rp) :: start_time = 0.0_rp
51 real(kind=rp) :: end_time = huge(0.0_rp)
52 contains
54 procedure, pass(this) :: init_base => source_term_init_base
56 procedure, pass(this) :: free_base => source_term_free_base
58 procedure, pass(this) :: compute => source_term_compute_wrapper
60 procedure(source_term_init), pass(this), deferred :: init
62 procedure(source_term_free), pass(this), deferred :: free
64 procedure(source_term_compute), pass(this), deferred :: compute_
65 end type source_term_t
66
67
69 type, public :: source_term_wrapper_t
71 class(source_term_t), allocatable :: source_term
72 contains
74 procedure, pass(this) :: free => source_term_wrapper_free
76
77 abstract interface
78
82 subroutine source_term_init(this, json, fields, coef)
83 import source_term_t, json_file, field_list_t, coef_t
84 class(source_term_t), intent(inout) :: this
85 type(json_file), intent(inout) :: json
86 type(field_list_t), intent(in), target :: fields
87 type(coef_t), intent(in), target :: coef
88 end subroutine source_term_init
89 end interface
90
91 abstract interface
92
93 subroutine source_term_free(this)
94 import source_term_t
95 class(source_term_t), intent(inout) :: this
96 end subroutine source_term_free
97 end interface
98
99 abstract interface
100
103 subroutine source_term_compute(this, t, tstep)
104 import source_term_t, rp
105 class(source_term_t), intent(inout) :: this
106 real(kind=rp), intent(in) :: t
107 integer, intent(in) :: tstep
108 end subroutine source_term_compute
109 end interface
110
111 interface
112
116 module subroutine source_term_factory(object, json, fields, coef)
117 class(source_term_t), allocatable, intent(inout) :: object
118 type(json_file), intent(inout) :: json
119 type(field_list_t), intent(inout) :: fields
120 type(coef_t), intent(inout) :: coef
121 end subroutine source_term_factory
122 end interface
123
124 public :: source_term_factory
125
126contains
127
134 subroutine source_term_init_base(this, fields, coef, start_time, end_time)
135 class(source_term_t), intent(inout) :: this
136 type(field_list_t) :: fields
137 type(coef_t), intent(in), target :: coef
138 real(kind=rp), intent(in) :: start_time
139 real(kind=rp), intent(in) :: end_time
140 integer :: n_fields, i
141
142 this%coef => coef
143 this%start_time = start_time
144 this%end_time = end_time
145 n_fields = fields%size()
146
147 call this%fields%init(n_fields)
148
149 ! A lot of attribute nesting here due to Fortran needing wrapper types
150 ! but this is just pointer assignement for the fields.
151 do i = 1, n_fields
152 call this%fields%assign(i, fields%get(i))
153 end do
154 end subroutine source_term_init_base
155
157 subroutine source_term_free_base(this)
158 class(source_term_t), intent(inout) :: this
159
160 call this%fields%free()
161 nullify(this%coef)
162 end subroutine source_term_free_base
163
165 subroutine source_term_wrapper_free(this)
166 class(source_term_wrapper_t), intent(inout) :: this
167 integer :: n_fields, i
168
169 if (allocated(this%source_term)) then
170 call this%source_term%free()
171 deallocate(this%source_term)
172 end if
173 end subroutine source_term_wrapper_free
174
178 subroutine source_term_compute_wrapper(this, t, tstep)
179 class(source_term_t), intent(inout) :: this
180 real(kind=rp), intent(in) :: t
181 integer, intent(in) :: tstep
182
183 if (t .ge. this%start_time .and. t .le. this%end_time) then
184 call this%compute_(t, tstep)
185 end if
186
187 end subroutine source_term_compute_wrapper
188end 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, t, tstep)
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)
Source term factory. Both constructs and initializes the object.
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.