Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
source_term_fctry.f90
Go to the documentation of this file.
1! Copyright (c) 2023-2024, 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!
33!
35submodule(source_term) source_term_fctry
41 use json_utils, only : json_get
43 implicit none
44
45 ! List of all possible types created by the factory routine
46 character(len=20) :: SOURCE_KNOWN_TYPES(5) = [character(len=20) :: &
47 "constant", &
48 "boussinesq", &
49 "coriolis", &
50 "gradient_jump_penalty", &
51 "brinkman"]
52
53contains
54
59 module subroutine source_term_factory(object, json, fields, coef, &
60 variable_name)
61 class(source_term_t), allocatable, intent(inout) :: object
62 type(json_file), intent(inout) :: json
63 type(field_list_t), intent(inout) :: fields
64 type(coef_t), intent(inout) :: coef
65 character(len=*), intent(in) :: variable_name
66 character(len=:), allocatable :: type_name
67 character(len=:), allocatable :: type_string
68
69 call json_get(json, "type", type_name)
70
71 ! Allocate
72 call source_term_allocator(object, type_name)
73
74 ! Initialize
75 call object%init(json, fields, coef, variable_name)
76
77 end subroutine source_term_factory
78
82 module subroutine source_term_allocator(object, type_name)
83 class(source_term_t), allocatable, intent(inout) :: object
84 character(len=:), allocatable, intent(in) :: type_name
85 integer :: i
86
87 select case (trim(type_name))
88 case ("constant")
89 allocate(const_source_term_t::object)
90 case ("boussinesq")
91 allocate(boussinesq_source_term_t::object)
92 case ("coriolis")
93 allocate(coriolis_source_term_t::object)
94 case ("brinkman")
95 allocate(brinkman_source_term_t::object)
96 case ("gradient_jump_penalty")
97 allocate(gradient_jump_penalty_t::object)
98 case default
99 do i = 1, source_term_registry_size
100 if (trim(type_name) .eq. trim(source_term_registry(i)%type_name)) then
101 call source_term_registry(i)%allocator(object)
102 return
103 end if
104 end do
105
106 call neko_type_error("source term", type_name, source_known_types)
107 end select
108 end subroutine source_term_allocator
109
115 module subroutine register_source_term(type_name, allocator)
116 character(len=*), intent(in) :: type_name
117 procedure(source_term_allocate), pointer, intent(in) :: allocator
118 type(allocator_entry), allocatable :: temp(:)
119 integer :: i
120
121 do i = 1, size(source_known_types)
122 if (trim(type_name) .eq. trim(source_known_types(i))) then
123 call neko_type_registration_error("source term", type_name, .true.)
124 end if
125 end do
126
127 do i = 1, source_term_registry_size
128 if (trim(type_name) .eq. trim(source_term_registry(i)%type_name)) then
129 call neko_type_registration_error("source term", type_name, .false.)
130 end if
131 end do
132
133 ! Expand registry
134 if (source_term_registry_size .eq. 0) then
135 allocate(source_term_registry(1))
136 else
137 allocate(temp(source_term_registry_size + 1))
138 temp(1:source_term_registry_size) = source_term_registry
139 call move_alloc(temp, source_term_registry)
140 end if
141
142 source_term_registry_size = source_term_registry_size + 1
143 source_term_registry(source_term_registry_size)%type_name = type_name
144 source_term_registry(source_term_registry_size)%allocator => allocator
145 end subroutine register_source_term
146
147end submodule source_term_fctry
Retrieves a parameter by name or throws an error.
Implements the boussinesq_source_term_t type.
Implements the brinkman_source_term_t type.
Implements the const_source_term_t type.
Implements the coriolis_source_term_t type. Maintainer: Timofey Mukha.
Implements gradient_jump_penalty_t.
Utilities for retrieving parameters from the case files.
Implements the source_term_t type and a wrapper source_term_wrapper_t.
Utilities.
Definition utils.f90:35
subroutine, public neko_type_registration_error(base_type, wrong_type, known)
Definition utils.f90:266
subroutine, public neko_type_error(base_type, wrong_type, known_types)
Reports an error allocating a type for a particular base pointer class.
Definition utils.f90:251
Bouyancy source term accroding to the Boussinesq approximation.
A Brinkman source term. The region and strength are controlled by assigning regions types and brinkma...
A constant source term. The strength is specified with the values keyword, which should be an array,...
This source term adds the Coriolis force.