Neko-TOP
A portable framework for high-order spectral element flow toplogy optimization.
Loading...
Searching...
No Matches
adjoint_lube_source_term.f90
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!
34!
35!
36! I know this is a stupid naming convention...
37! The `lube` aspect came from a paper that attributed this term to out of plane
38! stresses based on lubrication theory.
39!
40! I preffer to think of it as a constraint that penalizes non-binary designs
41!
42! The term is $K \int_\Omega \frac{1}{2}\chi|\mathbf{u}|^2$
43!
44! the corresponding adjoint forcing is $K \chi \mathbf{u}$
46 use num_types, only: rp
47 use field_list, only: field_list_t
48 use json_module, only: json_file
49 use source_term, only: source_term_t
50 use coefs, only: coef_t
51 use field, only: field_t
52 use time_state, only: time_state_t
53 use design, only: design_t
54 use brinkman_design, only: brinkman_design_t
55 use field_math, only: field_addcol3, field_copy, field_cmult
56 use scratch_registry, only: neko_scratch_registry
58 use point_zone, only: point_zone_t
59 use utils, only: neko_error
60 use field_registry, only: neko_field_registry
61 implicit none
62 private
63
65 ! $K \int_\Omega \frac{1}{2}\chi|\mathbf{u}|^2$.
66 type, public, extends(source_term_t) :: adjoint_lube_source_term_t
67
69 type(field_t), pointer :: u => null()
71 type(field_t), pointer :: v => null()
73 type(field_t), pointer :: w => null()
75 type(field_t), pointer :: chi => null()
77 real(kind=rp) :: k
79 class(point_zone_t), pointer :: mask => null()
81 logical :: if_mask
82
83 contains
85 procedure, pass(this) :: init => adjoint_lube_source_term_init_from_json
87 procedure, pass(this) :: init_from_components => &
88 adjoint_lube_source_term_init_from_components
90 procedure, pass(this) :: free => adjoint_lube_source_term_free
92 procedure, pass(this) :: compute_ => adjoint_lube_source_term_compute
94
95contains
102 subroutine adjoint_lube_source_term_init_from_json(this, json, fields, coef, &
103 variable_name)
104 class(adjoint_lube_source_term_t), intent(inout) :: this
105 type(json_file), intent(inout) :: json
106 type(field_list_t), intent(in), target :: fields
107 type(coef_t), intent(in), target :: coef
108 character(len=*), intent(in) :: variable_name
109 ! real(kind=rp), allocatable :: values(:)
110 ! real(kind=rp) :: start_time, end_time
111
112
113 ! we shouldn't be initializing this from JSON
114 ! maybe throw an error?
115
116
117 end subroutine adjoint_lube_source_term_init_from_json
118
128 subroutine adjoint_lube_source_term_init_from_components(this, &
129 f_x, f_y, f_z, design, K, &
130 u, v, w, &
131 mask, if_mask, &
132 coef)
133 class(adjoint_lube_source_term_t), intent(inout) :: this
134 type(field_t), pointer, intent(in) :: f_x, f_y, f_z
135 class(design_t), intent(in), target :: design
136 class(point_zone_t), intent(in), target :: mask
137 type(coef_t), intent(in) :: coef
138 real(kind=rp) :: start_time
139 real(kind=rp) :: end_time
140 type(field_list_t) :: fields
141 logical :: if_mask
142 real(kind=rp) :: k
143 type(field_t), intent(in), target :: u, v, w
144
145 ! I wish you didn't need a start time and end time...
146 ! but I'm just going to set a super big number...
147 start_time = 0.0_rp
148 end_time = 100000000.0_rp
149
150 call this%free()
151
152 ! this is copying the fluid source term init
153 ! We package the fields for the source term to operate on in a field list.
154 call fields%init(3)
155 call fields%assign(1, f_x)
156 call fields%assign(2, f_y)
157 call fields%assign(3, f_z)
158
159 call this%init_base(fields, coef, start_time, end_time)
160
161 ! point everything in the correct places
162 ! NOTE!!!
163 ! this is the primal!
164 this%u => u
165 this%v => v
166 this%w => w
167
168 select type (design)
169 type is (brinkman_design_t)
170 this%chi => neko_field_registry%get_field("brinkman_amplitude")
171 class default
172 call neko_error('Unknown design type')
173 end select
174
175 this%K = k
176 this%if_mask = if_mask
177 if (this%if_mask) then
178 this%mask => mask
179 end if
180
181 end subroutine adjoint_lube_source_term_init_from_components
182
184 subroutine adjoint_lube_source_term_free(this)
185 class(adjoint_lube_source_term_t), intent(inout) :: this
186
187 call this%free_base()
188 end subroutine adjoint_lube_source_term_free
189
193 subroutine adjoint_lube_source_term_compute(this, time)
194 class(adjoint_lube_source_term_t), intent(inout) :: this
195 type(time_state_t), intent(in) :: time
196 type(field_t), pointer :: fu, fv, fw
197 type(field_t), pointer :: work
198 integer :: temp_indices(1)
199
200 fu => this%fields%get_by_index(1)
201 fv => this%fields%get_by_index(2)
202 fw => this%fields%get_by_index(3)
203
204 ! BE SO CAREFUL HERE
205 ! It make look the same as the Brinkman term, but it's assumed that
206 ! this source term acts on the adjoint, and the u,v,w here come from
207 ! the primal
208 call neko_scratch_registry%request_field(work, temp_indices(1))
209 call field_copy(work, this%chi)
210
211 ! scale by K
212 call field_cmult(work, this%K)
213
214 ! mask
215 if (this%if_mask) then
216 call mask_exterior_const(work, this%mask, 0.0_rp)
217 end if
218
219 ! multiple and add the RHS
220 call field_addcol3(fu, this%u, work)
221 call field_addcol3(fv, this%v, work)
222 call field_addcol3(fw, this%w, work)
223 call neko_scratch_registry%relinquish_field(temp_indices)
224
225 end subroutine adjoint_lube_source_term_compute
226
Implements the adjoint_lube_source_term_t type.
Implements the design_t.
Definition design.f90:34
Some common Masking operations we may need.
Definition mask_ops.f90:34
A adjoint source term corresponding to an objective of.
A topology optimization design variable.
An abstract design type.
Definition design.f90:52