Neko-TOP
A portable framework for high-order spectral element flow toplogy optimization.
Loading...
Searching...
No Matches
design_simple.f90
1! Copyright (c) 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! Implements the `simple_design_t` type.
34module simple_design
35 use num_types, only: rp, sp
36 use field, only: field_t
37 use mapping, only: mapping_t
38 use pde_filter, only: pde_filter_t
40 use coefs, only: coef_t
41 use scratch_registry, only: neko_scratch_registry
42 use fld_file_output, only: fld_file_output_t
43 use point_zone_registry, only: neko_point_zone_registry
44 use point_zone, only: point_zone_t
46 use neko_config, only: neko_bcknd_device
47 use device, only: device_memcpy, host_to_device
48 use design, only: design_t
49 use math, only: rzero
50 use simulation_m, only: simulation_t
51 use comm, only: pe_size
52 use json_module, only: json_file
53 use json_utils, only: json_get, json_get_or_default
55 use vector, only: vector_t
56 use math, only: copy
57 use field_registry, only: neko_field_registry
58 use utils, only:neko_error
59 implicit none
60 private
61
63 type, extends(design_t), public :: simple_design_t
64 private
65
66 type(vector_t) :: values
67 type(vector_t) :: x_coord
68 type(vector_t) :: y_coord
69 type(vector_t) :: z_coord
70
71 contains
72
73 ! ----------------------------------------------------------------------- !
74 ! Initializations
75
77 generic, public :: init => init_from_json, init_from_components
79 procedure, pass(this) :: init_from_json => &
80 design_simple_init_from_json
82 procedure, pass(this) :: init_from_components => &
83 design_simple_init_from_components
84
86 procedure, pass(this) :: add_mapping => design_simple_add_mapping
87
89 procedure, pass(this) :: get_values => design_simple_get_values
91 procedure, pass(this) :: design_get_x => design_simple_get_x
93 procedure, pass(this) :: design_get_y => design_simple_get_y
95 procedure, pass(this) :: design_get_z => design_simple_get_z
96
98 procedure, pass(this) :: update_design => design_simple_update_design
99
101 procedure, pass(this) :: map_forward => design_simple_map_forward
102
104 procedure, pass(this) :: map_backward => design_simple_map_backward
105
107 procedure, pass(this) :: write => design_simple_write
108
110 procedure, pass(this) :: free => design_simple_free
111
112 end type simple_design_t
113
114contains
115
117 subroutine design_simple_init_from_json(this, parameters)
118 class(simple_design_t), intent(inout) :: this
119 type(json_file), intent(inout) :: parameters
120 character(len=:), allocatable :: type, name
121 integer :: n, nx, ny, nz, i, j, k
122 real(kind=rp), dimension(:), allocatable :: limits
123 type(vector_t) :: x, y, z
124
125 call json_get(parameters, 'domain.type', type)
126 call json_get_or_default(parameters, 'name', name, 'Simple Design')
127
128 select case (trim(type))
129 case ("box")
130 call json_get(parameters, 'domain.nx', nx)
131 call json_get(parameters, 'domain.ny', ny)
132 call json_get(parameters, 'domain.nz', nz)
133 call json_get(parameters, 'domain.limits', limits)
134 n = nx * ny * nz
135
136 call x%init(n)
137 call y%init(n)
138 call z%init(n)
139
140 do i = 1, nx
141 do j = 1, ny
142 do k = 1, nz
143 x%x(i) = limits(1) + (limits(2) - limits(1)) * &
144 real(i - 1, kind=rp) / real(nx, kind=rp)
145 y%x(i) = limits(3) + (limits(4) - limits(3)) * &
146 real(j - 1, kind=rp) / real(ny, kind=rp)
147 z%x(i) = limits(5) + (limits(6) - limits(5)) * &
148 real(k - 1, kind=rp) / real(nz, kind=rp)
149 end do
150 end do
151 end do
152
153 end select
154
155 call this%init_from_components(name, n, x, y, z)
156
157 end subroutine design_simple_init_from_json
158
159 subroutine design_simple_init_from_components(this, name, n, x, y, z)
160 class(simple_design_t), intent(inout) :: this
161 character(len=*), intent(in) :: name
162 integer, intent(in) :: n
163 type(vector_t), intent(in) :: x, y, z
164
165 if (pe_size .ne. 1) then
166 call neko_error("Simple design can only be used with a single MPI " // &
167 "process.")
168 end if
169
170 call this%init_base(name, n)
171
172 call this%values%init(n)
173 this%x_coord = x
174 this%y_coord = y
175 this%z_coord = z
176
177 end subroutine design_simple_init_from_components
178
180 subroutine design_simple_free(this)
181 class(simple_design_t), intent(inout) :: this
182
183 call this%free_base()
184 call this%values%free()
185 call this%x_coord%free()
186 call this%y_coord%free()
187 call this%z_coord%free()
188
189 end subroutine design_simple_free
190
192 subroutine design_simple_add_mapping(this, parameters, simulation)
193 class(simple_design_t), intent(inout) :: this
194 type(json_file), intent(inout) :: parameters
195 type(simulation_t), intent(inout) :: simulation
196
197 end subroutine design_simple_add_mapping
198
199
200 subroutine design_simple_map_forward(this)
201 class(simple_design_t), intent(inout) :: this
202
203
204 end subroutine design_simple_map_forward
205
206 subroutine design_simple_get_values(this, values)
207 class(simple_design_t), intent(in) :: this
208 type(vector_t), intent(inout) :: values
209
210 values = this%values
211
212 end subroutine design_simple_get_values
213
214 subroutine design_simple_get_x(this, x)
215 class(simple_design_t), intent(in) :: this
216 type(vector_t), intent(inout) :: x
217
218 x = this%x_coord
219
220 end subroutine design_simple_get_x
221
222 subroutine design_simple_get_y(this, y)
223 class(simple_design_t), intent(in) :: this
224 type(vector_t), intent(inout) :: y
225
226 y = this%y_coord
227
228 end subroutine design_simple_get_y
229
230 subroutine design_simple_get_z(this, z)
231 class(simple_design_t), intent(in) :: this
232 type(vector_t), intent(inout) :: z
233
234 z = this%z_coord
235
236 end subroutine design_simple_get_z
237
238 subroutine design_simple_update_design(this, values)
239 class(simple_design_t), intent(inout) :: this
240 type(vector_t), intent(inout) :: values
241
242 this%values = values
243
244 end subroutine design_simple_update_design
245
246 subroutine design_simple_map_backward(this, sensitivity)
247 class(simple_design_t), intent(inout) :: this
248 type(vector_t), intent(in) :: sensitivity
249
250 end subroutine design_simple_map_backward
251
252 subroutine design_simple_write(this, idx)
253 class(simple_design_t), intent(inout) :: this
254 integer, intent(in) :: idx
255
256 end subroutine design_simple_write
257
258end module simple_design
Implements the design_t.
Definition design.f90:34
Mappings to be applied to a scalar field.
Definition mapping.f90:35
Some common Masking operations we may need.
Definition mask_ops.f90:34
A PDE based filter.
A RAMP mapping of coefficients.
Implements the simple_brinkman_source_term_t type.
Implements the steady_problem_t type.
An abstract design type.
Definition design.f90:52
Base abstract class for mapping.
Definition mapping.f90:45
A PDE based filter mapping , see Lazarov & O. Sigmund 2010, by solving an equation of the form .
A RAMP mapping of coefficients This is the standard RAMP described in https://doi....
A topology optimization design variable.