Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
user_source_term.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!
36 use num_types, only : rp
37 use utils, only : neko_error
38 use source_term, only : source_term_t
39 use json_module, only : json_file
40 use field_list, only : field_list_t
41 use coefs, only : coef_t
42 use device, only : device_map, device_free
43 use device_math, only : device_add2
44 use field_math, only : field_add2
45 use dofmap, only : dofmap_t
47 use time_state, only : time_state_t
48 use, intrinsic :: iso_c_binding
49 implicit none
50 private
51
58 type, public, extends(source_term_t) :: user_source_term_t
60 character(len=:), allocatable :: scheme_name
62 type(dofmap_t), pointer :: dof
65 type(field_list_t) :: user_fields
67 procedure(user_source_term_intf), nopass, pointer :: compute_user_ &
68 => null()
69 contains
71 procedure, pass(this) :: init => user_source_term_init
73 procedure, pass(this) :: init_from_components => &
76 procedure, pass(this) :: free => user_source_term_free
78 procedure, pass(this) :: compute_ => user_source_term_compute
79 end type user_source_term_t
80
81contains
82
87 subroutine user_source_term_init(this, json, fields, coef, &
88 variable_name)
89 class(user_source_term_t), intent(inout) :: this
90 type(json_file), intent(inout) :: json
91 type(field_list_t), intent(in), target :: fields
92 type(coef_t), intent(in), target :: coef
93 character(len=*), intent(in) :: variable_name
94
95 call neko_error("The user fluid source term should be init from components")
96
97 end subroutine user_source_term_init
98
104 subroutine user_source_term_init_from_components(this, fields, coef, &
105 user_proc, scheme_name)
106 class(user_source_term_t), intent(inout) :: this
107 type(field_list_t), intent(in), target :: fields
108 type(coef_t), intent(in), target :: coef
109 procedure(user_source_term_intf) :: user_proc
110 character(len=*), intent(in) :: scheme_name
111 integer :: i
112
113 call this%free()
114 call this%init_base(fields, coef, 0.0_rp, huge(0.0_rp))
115
116 this%scheme_name = scheme_name
117 this%dof => fields%dof(1)
118
119 call this%user_fields%init(3)
120
121 do i = 1, this%fields%size()
122 allocate(this%user_fields%items(i)%ptr)
123 call this%user_fields%items(i)%ptr%init(this%dof)
124 end do
125
126 this%compute_user_ => user_proc
128
130 subroutine user_source_term_free(this)
131 class(user_source_term_t), intent(inout) :: this
132
133 call this%user_fields%free()
134
135 if (allocated(this%scheme_name)) deallocate(this%scheme_name)
136
137 nullify(this%compute_user_)
138 nullify(this%dof)
139
140 call this%free_base()
141 end subroutine user_source_term_free
142
145 subroutine user_source_term_compute(this, time)
146 class(user_source_term_t), intent(inout) :: this
147 type(time_state_t), intent(in) :: time
148 integer :: i
149
150 if (time%t .ge. this%start_time .and. time%t .le. this%end_time) then
151 call this%compute_user_(this%scheme_name, this%fields, time)
152
153 do i = 1, this%fields%size()
154 call this%user_fields%items(i)%ptr%init(this%dof)
155 call field_add2(this%fields%items(i)%ptr, &
156 this%user_fields%items(i)%ptr)
157 end do
158 end if
159 end subroutine user_source_term_compute
160
161end module user_source_term
Map a Fortran array to a device (allocate and associate)
Definition device.F90:72
Abstract interface for user defined source term.
Coefficients.
Definition coef.f90:34
subroutine, public device_add2(a_d, b_d, n, strm)
Vector addition .
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
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
subroutine, public field_add2(a, b, n)
Vector addition .
Build configurations.
integer, parameter neko_bcknd_device
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.
Module with things related to the simulation time.
Interfaces for user interaction with NEKO.
Definition user_intf.f90:34
Implements the user_source_term_t type.
subroutine user_source_term_init(this, json, fields, coef, variable_name)
Costructor from JSON.
subroutine user_source_term_init_from_components(this, fields, coef, user_proc, scheme_name)
Costructor from components.
subroutine user_source_term_free(this)
Destructor.
subroutine user_source_term_compute(this, time)
Computes the source term and adds the result to fields.
Utilities.
Definition utils.f90:35
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 struct that contains all info about the time, expand as needed.
A source term wrapping the user source term routine. Stores fields that are passed to the user routin...