Merge lp:~fluidity-core/fluidity/shallow-water-dev into lp:fluidity
- shallow-water-dev
- Merge into dev-trunk
Status: | Work in progress |
---|---|
Proposed branch: | lp:~fluidity-core/fluidity/shallow-water-dev |
Merge into: | lp:fluidity |
Diff against target: |
68993 lines (has conflicts)
Text conflict in femtools/Makefile.dependencies Text conflict in femtools/Makefile.in Text conflict in femtools/doc/femtools_manual.pdf Text conflict in main/Shallow_Water.F90 Text conflict in tests/Helmholtz-anisotropic-vector-mms-p1p1cg/MMS_A.flml Text conflict in tests/Helmholtz-anisotropic-vector-mms-p1p1cg/MMS_B.flml Text conflict in tests/Helmholtz-anisotropic-vector-mms-p1p1cg/MMS_C.flml Text conflict in tests/Helmholtz-anisotropic-vector-mms-p1p1cg/MMS_D.flml Text conflict in tests/Helmholtz-anisotropic-vector-mms-p1p1cg/MMS_E.flml Text conflict in tests/data/cg_interpolation_A.flml Text conflict in tests/optimality/dummy.swml Contents conflict in tests/shallow_water_adjoint_default_controls_2d/adjoint_B.swml Contents conflict in tests/shallow_water_adjoint_default_controls_2d/adjoint_C.swml Contents conflict in tests/shallow_water_adjoint_default_controls_2d/adjoint_D.swml Contents conflict in tests/shallow_water_adjoint_default_controls_2d/adjoint_E.swml Text conflict in tests/shallow_water_adjoint_func_eval_2d/adjoint_template.swml Contents conflict in tests/shallow_water_optimisation/adjoint_B.swml Contents conflict in tests/shallow_water_optimisation/adjoint_C.swml Contents conflict in tests/shallow_water_optimisation/adjoint_D.swml Contents conflict in tests/shallow_water_optimisation/adjoint_E.swml Text conflict in tests/shallow_water_optimisation/adjoint_template.swml Text conflict in tests/shallow_water_optimisation_check_gradient_2d/adjoint_A.swml |
To merge this branch: | bzr merge lp:~fluidity-core/fluidity/shallow-water-dev |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Cian Wilson | Needs Information | ||
David Ham | Pending | ||
Review via email: mp+81751@code.launchpad.net |
Commit message
Description of the change
This shallow-water code includes the changes necessary to correctly interpolate vector fields from the sphere for BDFM1 elements, plus a suite of test cases.
Dr Colin J Cotter (colin-cotter) wrote : | # |
Hi Cian,
These options are read in populate_state and make things happen in
Elements.F90 and various other places.
--cjc
On 09/11/11 16:17, Cian Wilson wrote:
> Review: Needs Information
>
> Hi Colin,
>
> Only had a quick glance but can I check if these changes provide any new functionality to fluidity itself? I ask because you've changed mesh_options.rn[cg] and these options are now appearing in the fluidity schema too but I can't see how they're applicable to fluidity as I can only trace them back to the hybridized helmholtz solver. If they're not used in fluidity then I don't think they should appear in a piece of the schema that is visible within an flml but I may be missing something.
>
> Unrelated to this merge but the parent option (geometry/
>
> Cheers,
> Cian
- 3579. By Dr Colin J Cotter
-
A few fixes for adjoint, plus tweaking some swmls.
Cian Wilson (cwilson) wrote : | # |
Hi Colin,
Could you give me line numbers in fluidity code where this happens please?
When I open up diamond to set up a new flml I get option of setting:
/geometry/
and
/geometry/
However, when I grep for where these options are used I get:
cwilson@
assemble/
schemas/
schemas/
tests/bdfm1_
None of which appear to be fluidity related to me so shouldn't be available in an flml.
Cheers,
Cian
> Hi Cian,
> These options are read in populate_state and make things happen in
> Elements.F90 and various other places.
>
> --cjc
>
> On 09/11/11 16:17, Cian Wilson wrote:
> > Review: Needs Information
> >
> > Hi Colin,
> >
> > Only had a quick glance but can I check if these changes provide any new
> functionality to fluidity itself? I ask because you've changed
> mesh_options.rn[cg] and these options are now appearing in the fluidity schema
> too but I can't see how they're applicable to fluidity as I can only trace
> them back to the hybridized helmholtz solver. If they're not used in fluidity
> then I don't think they should appear in a piece of the schema that is visible
> within an flml but I may be missing something.
> >
> > Unrelated to this merge but the parent option
> (geometry/
> in the schema.
> >
> > Cheers,
> > Cian
Cian Wilson (cwilson) wrote : | # |
I can see where the already existing parent option /geometry/
The parent option does need some documentation in the schema however.
- 3580. By Patrick Farrell
-
Some XML fixes for Colin.
- 3581. By Patrick Farrell
-
Let's not put in a NonlinearVelocity in the adjoint run, for now.
- 3582. By Dr Colin J Cotter
-
Change place where option theta is looked for.
- 3583. By Dr Colin J Cotter
-
theta set.
- 3584. By Dr Colin J Cotter
-
Removing some dead tests and fixing some swmls.
Dr Colin J Cotter (colin-cotter) wrote : | # |
Oh I see, fair point. I'll fix that.
all the best
--cjc
On 09/11/11 19:01, Cian Wilson wrote:
> I can see where the already existing parent option /geometry/
>
> The parent option does need some documentation in the schema however.
- 3585. By Dr Colin J Cotter
-
Move continuity debugging options to shallow_
water_options. rnc as
requested by Cian. - 3586. By Dr Colin J Cotter
-
Merge from trunk.
- 3587. By Dr Colin J Cotter
-
Merged from the trunk.
- 3588. By Dr Colin J Cotter
-
Forgot that this file has been renamed.
David Ham (david-ham) wrote : | # |
I think this looks OK. Make sure it is current with trunk and check that all the major functionality is tested.
- 3589. By Dr Colin J Cotter
-
Merged from trunk.
- 3590. By Dr Colin J Cotter
-
Uncommented code that I previously forgot to uncomment.
- 3591. By Dr Colin J Cotter
-
Get theta from correct place in adjoint callbacks.
- 3592. By Dr Colin J Cotter
-
Get theta from correct place in adjoint control callbacks too.
- 3593. By Dr Colin J Cotter
-
Some dead tests.
- 3594. By Dr Colin J Cotter
-
Remove pointer status from scalar field.
- 3595. By Dr Colin J Cotter
-
Don't output to the statfile twice at the end of the simulation.
This fixes shallow_
water_adjoint_ func_eval. - 3596. By Dr Colin J Cotter
-
Merge from trunk.
- 3597. By Dr Colin J Cotter
-
Increased timesteps to 2 in test. This is not the solution, but I
can't work out why it doesn't work otherwise. - 3598. By Dr Colin J Cotter
-
Need to calculate functional values before writing diagnostics.
- 3599. By Dr Colin J Cotter
-
Made makefiles and got a merge from the trunk.
- 3600. By Dr Colin J Cotter
-
Merge from trunk.
- 3601. By Dr Colin J Cotter
-
Error in merging makefiles.
- 3602. By Jemma Shipton
-
merging changes from Colin's bdfm1-nonlinear-sw branch
- 3603. By Jemma Shipton
-
get global numbering fix for quads from trunk
Unmerged revisions
- 3603. By Jemma Shipton
-
get global numbering fix for quads from trunk
- 3602. By Jemma Shipton
-
merging changes from Colin's bdfm1-nonlinear-sw branch
- 3601. By Dr Colin J Cotter
-
Error in merging makefiles.
- 3600. By Dr Colin J Cotter
-
Merge from trunk.
- 3599. By Dr Colin J Cotter
-
Made makefiles and got a merge from the trunk.
- 3598. By Dr Colin J Cotter
-
Need to calculate functional values before writing diagnostics.
- 3597. By Dr Colin J Cotter
-
Increased timesteps to 2 in test. This is not the solution, but I
can't work out why it doesn't work otherwise. - 3596. By Dr Colin J Cotter
-
Merge from trunk.
- 3595. By Dr Colin J Cotter
-
Don't output to the statfile twice at the end of the simulation.
This fixes shallow_
water_adjoint_ func_eval. - 3594. By Dr Colin J Cotter
-
Remove pointer status from scalar field.
Preview Diff
1 | === modified file 'Makefile.in' |
2 | --- Makefile.in 2012-09-19 11:09:17 +0000 |
3 | +++ Makefile.in 2012-10-23 15:04:25 +0000 |
4 | @@ -186,7 +186,9 @@ |
5 | @echo " LD $(PROGRAM)" |
6 | @$(EVAL) $(LINKER) -o $(PROGRAM) main.o $(LIBS) |
7 | |
8 | -sw: bin/shallow_water |
9 | +sw: bin/shallow_water |
10 | +swm: bin/shallow_water_mimetic |
11 | +test_sw: bin/test_sw_advection |
12 | be: bin/burgers_equation |
13 | hh: bin/hybridized_helmholtz_solver |
14 | |
15 | @@ -199,6 +201,22 @@ |
16 | @$(EVAL) $(FLLINKER) -o bin/hybridized_helmholtz_solver main/Hybridized_Helmholtz_Solver.o $(LIBS) |
17 | @$(EVAL) $(FLLINKER) -o bin/shallow_water main/Shallow_Water.o $(LIBS) |
18 | |
19 | +bin/shallow_water_mimetic: fluidity_library main/Shallow_Water_Mimetic.F90 |
20 | + @cd main; $(MAKE) Shallow_Water_Mimetic.o |
21 | + @echo "BUILD shallow_water_mimetic" |
22 | + @echo " MKDIR bin" |
23 | + @mkdir -p bin |
24 | + @echo " LD shallow_water_mimetic" |
25 | + @$(EVAL) $(FLLINKER) -o bin/shallow_water_mimetic main/Shallow_Water_Mimetic.o $(LIBS) |
26 | + |
27 | +bin/test_sw_advection: fluidity_library main/test_sw_advection.F90 |
28 | + @cd main; $(MAKE) test_sw_advection.o |
29 | + @echo "BUILD test_sw_advection" |
30 | + @echo " MKDIR bin" |
31 | + @mkdir -p bin |
32 | + @echo " LD test_sw_advection" |
33 | + @$(EVAL) $(LINKER) -o bin/test_sw_advection main/test_sw_advection.o $(LIBS) |
34 | + |
35 | bin/hybridized_helmholtz_solver: fluidity_library main/Hybridized_Helmholtz_Solver.F90 |
36 | @cd main; $(MAKE) Hybridized_Helmholtz_Solver.o |
37 | @echo "BUILD hybridized_helmholtz_solver" |
38 | |
39 | === modified file 'adjoint/Burgers_Control_Callbacks.F90' |
40 | --- adjoint/Burgers_Control_Callbacks.F90 2011-07-07 16:30:31 +0000 |
41 | +++ adjoint/Burgers_Control_Callbacks.F90 2012-10-23 15:04:25 +0000 |
42 | @@ -34,7 +34,7 @@ |
43 | use state_module |
44 | use python_state |
45 | use sparse_matrices_fields |
46 | - use manifold_projections |
47 | + use manifold_tools |
48 | use mangle_dirichlet_rows_module |
49 | |
50 | implicit none |
51 | |
52 | === modified file 'adjoint/Makefile.dependencies' |
53 | --- adjoint/Makefile.dependencies 2011-07-19 16:55:03 +0000 |
54 | +++ adjoint/Makefile.dependencies 2012-10-23 15:04:25 +0000 |
55 | @@ -70,10 +70,9 @@ |
56 | Burgers_Control_Callbacks.o ../include/burgers_adjoint_controls.mod: \ |
57 | Burgers_Control_Callbacks.F90 ../include/fdebug.h ../include/fields.mod \ |
58 | ../include/global_parameters.mod \ |
59 | - ../include/mangle_dirichlet_rows_module.mod \ |
60 | - ../include/manifold_projections.mod ../include/python_state.mod \ |
61 | - ../include/sparse_matrices_fields.mod ../include/spud.mod \ |
62 | - ../include/state_module.mod |
63 | + ../include/mangle_dirichlet_rows_module.mod ../include/manifold_tools.mod \ |
64 | + ../include/python_state.mod ../include/sparse_matrices_fields.mod \ |
65 | + ../include/spud.mod ../include/state_module.mod |
66 | |
67 | ../include/forward_main_loop.mod: Forward_Main_Loop.o |
68 | @true |
69 | @@ -128,7 +127,7 @@ |
70 | Shallow_Water_Adjoint_Callbacks.F90 ../include/adjoint_global_variables.mod \ |
71 | ../include/fdebug.h ../include/fields.mod ../include/global_parameters.mod \ |
72 | ../include/libadjoint_data_callbacks.mod ../include/mangle_options_tree.mod \ |
73 | - ../include/manifold_projections.mod ../include/populate_state_module.mod \ |
74 | + ../include/manifold_tools.mod ../include/populate_state_module.mod \ |
75 | ../include/sparse_matrices_fields.mod ../include/spud.mod \ |
76 | ../include/state_module.mod |
77 | |
78 | @@ -140,7 +139,7 @@ |
79 | ../include/shallow_water_adjoint_controls.mod: \ |
80 | Shallow_Water_Control_Callbacks.F90 ../include/fdebug.h \ |
81 | ../include/fields.mod ../include/global_parameters.mod \ |
82 | - ../include/manifold_projections.mod ../include/python_state.mod \ |
83 | + ../include/manifold_tools.mod ../include/python_state.mod \ |
84 | ../include/sparse_matrices_fields.mod ../include/spud.mod \ |
85 | ../include/state_module.mod |
86 | |
87 | |
88 | === modified file 'adjoint/Shallow_Water_Adjoint_Callbacks.F90' |
89 | --- adjoint/Shallow_Water_Adjoint_Callbacks.F90 2011-06-09 09:43:33 +0000 |
90 | +++ adjoint/Shallow_Water_Adjoint_Callbacks.F90 2012-10-23 15:04:25 +0000 |
91 | @@ -39,7 +39,7 @@ |
92 | use spud, only: get_option |
93 | use adjoint_global_variables, only: adj_path_lookup |
94 | use mangle_options_tree, only: adjoint_field_path |
95 | - use manifold_projections |
96 | + use manifold_tools |
97 | use global_parameters, only: running_adjoint |
98 | use populate_state_module |
99 | implicit none |
100 | @@ -488,7 +488,7 @@ |
101 | path = adjoint_field_path(path) |
102 | end if |
103 | |
104 | - call get_option(trim(path) // "/prognostic/temporal_discretisation/theta", theta) |
105 | + call get_option("/timestepping/theta", theta) |
106 | call get_option(trim(path) // "/prognostic/mean_layer_thickness", d0) |
107 | |
108 | if (hermitian==ADJ_FALSE) then |
109 | @@ -858,7 +858,7 @@ |
110 | |
111 | ierr = adj_dict_find(adj_path_lookup, "Fluid::LayerThickness", path) |
112 | call adj_chkierr(ierr) |
113 | - call get_option(trim(path) // "/prognostic/temporal_discretisation/theta", theta) |
114 | + call get_option("/timestepping/theta",theta) |
115 | call get_option(trim(path) // "/prognostic/mean_layer_thickness", d0) |
116 | |
117 | eta_mesh => extract_mesh(matrices, "LayerThicknessMesh") |
118 | |
119 | === modified file 'adjoint/Shallow_Water_Control_Callbacks.F90' |
120 | --- adjoint/Shallow_Water_Control_Callbacks.F90 2011-06-11 13:26:55 +0000 |
121 | +++ adjoint/Shallow_Water_Control_Callbacks.F90 2012-10-23 15:04:25 +0000 |
122 | @@ -34,7 +34,7 @@ |
123 | use state_module |
124 | use python_state |
125 | use sparse_matrices_fields |
126 | - use manifold_projections |
127 | + use manifold_tools |
128 | |
129 | implicit none |
130 | |
131 | @@ -154,7 +154,7 @@ |
132 | adj_vfield => extract_vector_field(states(state_id), "AdjointLocalVelocityDelta") |
133 | ! We need the AdjointVelocity for the option path only |
134 | adj_sfield2 => extract_scalar_field(states(state_id), "AdjointLayerThickness") |
135 | - call get_option(trim(adj_sfield2%option_path) // "/prognostic/temporal_discretisation/theta", theta) |
136 | + call get_option("/timestepping/theta", theta) |
137 | call get_option(trim(adj_sfield2%option_path) // "/prognostic/mean_layer_thickness", d0) |
138 | |
139 | big_mat => extract_block_csr_matrix(matrices, "InverseBigMatrix") |
140 | |
141 | === modified file 'assemble/Advection_Diffusion_DG.F90' |
142 | --- assemble/Advection_Diffusion_DG.F90 2012-10-11 17:52:01 +0000 |
143 | +++ assemble/Advection_Diffusion_DG.F90 2012-10-23 15:04:25 +0000 |
144 | @@ -1547,7 +1547,7 @@ |
145 | end if |
146 | end if |
147 | end if |
148 | - |
149 | + |
150 | ! Add stabilisation to the advection term if requested by the user. |
151 | if (stabilisation_scheme==UPWIND) then |
152 | ! NOTE: U_nl_q may (or may not) have been modified by the grid velocity |
153 | @@ -2603,7 +2603,6 @@ |
154 | nnAdvection_in=shape_shape(T_shape, T_shape_2, & |
155 | & outer_advection_integral * detwei) |
156 | |
157 | - |
158 | end if |
159 | if (include_diffusion.or.have_buoyancy_adjustment_by_vertical_diffusion) then |
160 | |
161 | |
162 | === added file 'assemble/Advection_Local_DG.F90' |
163 | --- assemble/Advection_Local_DG.F90 1970-01-01 00:00:00 +0000 |
164 | +++ assemble/Advection_Local_DG.F90 2012-10-23 15:04:25 +0000 |
165 | @@ -0,0 +1,2538 @@ |
166 | +! Copyright (C) 2006 Imperial College London and others. |
167 | +! |
168 | +! Please see the AUTHORS file in the main source directory for a full list |
169 | +! of copyright holders. |
170 | +! |
171 | +! Prof. C Pain |
172 | +! Applied Modelling and Computation Group |
173 | +! Department of Earth Science and Engineering |
174 | +! Imperial College London |
175 | +! |
176 | +! amcgsoftware@imperial.ac.uk |
177 | +! |
178 | +! This library is free software; you can redistribute it and/or |
179 | +! modify it under the terms of the GNU Lesser General Public |
180 | +! License as published by the Free Software Foundation, |
181 | +! version 2.1 of the License. |
182 | +! |
183 | +! This library is distributed in the hope that it will be useful, |
184 | +! but WITHOUT ANY WARRANTY; without even the implied warranty of |
185 | +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
186 | +! Lesser General Public License for more details. |
187 | +! |
188 | +! You should have received a copy of the GNU Lesser General Public |
189 | +! License along with this library; if not, write to the Free Software |
190 | +! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 |
191 | +! USA |
192 | +#include "fdebug.h" |
193 | + |
194 | +module advection_local_DG |
195 | + !!< This module contains the Discontinuous Galerkin form of the advection |
196 | + !!< equation when vector fields are represented in the local coordinates |
197 | + !!< from the Piola transformation. |
198 | + use elements |
199 | + use global_parameters, only:current_debug_level, OPTION_PATH_LEN |
200 | + use sparse_tools |
201 | + use fetools |
202 | + use dgtools |
203 | + use fields |
204 | + use fefields |
205 | + use state_module |
206 | + use shape_functions |
207 | + use global_numbering |
208 | + use transform_elements |
209 | + use vector_tools |
210 | + use fldebug |
211 | + use vtk_interfaces |
212 | + use Coordinates |
213 | + use Tensors |
214 | + use petsc_solve_state_module |
215 | + use spud |
216 | + use slope_limiters_dg |
217 | + use sparsity_patterns |
218 | + use sparse_matrices_fields |
219 | + use sparsity_patterns_meshes |
220 | + use Vector_Tools |
221 | + use manifold_tools |
222 | + use bubble_tools |
223 | + use diagnostic_fields, only: calculate_diagnostic_variable |
224 | + use global_parameters, only : FIELD_NAME_LEN |
225 | + |
226 | + implicit none |
227 | + |
228 | + ! Buffer for output messages. |
229 | + character(len=255), private :: message |
230 | + |
231 | + private |
232 | + public solve_advection_dg_subcycle, solve_vector_advection_dg_subcycle,& |
233 | + & solve_advection_cg_tracer, compute_U_residual, get_pv |
234 | + |
235 | + !parameters specifying vector upwind options |
236 | + integer, parameter :: VECTOR_UPWIND_EDGE=1, VECTOR_UPWIND_SPHERE=2 |
237 | + |
238 | + ! Local private control parameters. These are module-global parameters |
239 | + ! because it would be expensive and/or inconvenient to re-evaluate them |
240 | + ! on a per-element or per-face basis |
241 | + real :: dt |
242 | + |
243 | + ! Whether to include various terms |
244 | + logical :: include_advection |
245 | + contains |
246 | + |
247 | + subroutine solve_advection_dg_subcycle(field_name, state, velocity_name,& |
248 | + &continuity, flux) |
249 | + !!< Construct and solve the advection equation for the given |
250 | + !!< field using discontinuous elements. |
251 | + |
252 | + !! Name of the field to be solved for. |
253 | + character(len=*), intent(in) :: field_name |
254 | + !! Collection of fields defining system state. |
255 | + type(state_type), intent(inout) :: state |
256 | + !! Optional velocity name |
257 | + character(len = *), intent(in) :: velocity_name |
258 | + !! Solve continuity equation as opposed to advection equation |
259 | + logical, intent(in), optional :: continuity |
260 | + !! Return a flux variable such that T-T_old=div(Flux) |
261 | + type(vector_field), intent(inout), optional :: Flux |
262 | + |
263 | + !! Tracer to be solved for. |
264 | + type(scalar_field), pointer :: T, T_old, s_field |
265 | + |
266 | + !! Coordinate and velocity fields |
267 | + type(vector_field), pointer :: X, U_nl |
268 | + |
269 | + !! Velocity field in Cartesian coordinates for slope limiter |
270 | + type(vector_field) :: U_nl_cartesian |
271 | + |
272 | + !! Change in T over one timestep. |
273 | + type(scalar_field) :: delta_T, delta_T_total |
274 | + |
275 | + !! Sparsity of advection matrix. |
276 | + type(csr_sparsity), pointer :: sparsity |
277 | + |
278 | + !! System matrix. |
279 | + type(csr_matrix) :: matrix, mass, inv_mass |
280 | + |
281 | + !! Sparsity of mass matrix. |
282 | + type(csr_sparsity) :: mass_sparsity |
283 | + |
284 | + !! Right hand side vector. |
285 | + type(scalar_field) :: rhs |
286 | + |
287 | + !! Whether to invoke the slope limiter |
288 | + logical :: limit_slope |
289 | + !! Which limiter to use |
290 | + integer :: limiter |
291 | + |
292 | + !! Number of advection subcycles. |
293 | + integer :: subcycles |
294 | + real :: max_courant_number |
295 | + |
296 | + !! Flux reconstruction stuff: |
297 | + !! Upwind fluxes trace variable |
298 | + type(scalar_field) :: UpwindFlux |
299 | + !! Mesh where UpwindFlux lives |
300 | + type(mesh_type), pointer :: lambda_mesh |
301 | + !! Upwind Flux matrix |
302 | + type(csr_matrix) :: UpwindFluxMatrix |
303 | + |
304 | + character(len=FIELD_NAME_LEN) :: limiter_name |
305 | + integer :: i, ele |
306 | + real :: meancheck |
307 | + ewrite(1,*) 'subroutine solve_advection_dg_subcycle' |
308 | + |
309 | + |
310 | + T=>extract_scalar_field(state, field_name) |
311 | + T_old=>extract_scalar_field(state, "Old"//field_name) |
312 | + X=>extract_vector_field(state, "Coordinate") |
313 | + U_nl=>extract_vector_field(state, velocity_name) |
314 | + |
315 | + ewrite(2,*) 'UVALS in dg', maxval(abs(U_nl%val)) |
316 | + |
317 | + ! Reset T to value at the beginning of the timestep. |
318 | + call set(T, T_old) |
319 | + if(present(Flux)) then |
320 | + call zero(Flux) |
321 | + end if |
322 | + |
323 | + sparsity => get_csr_sparsity_firstorder(state, T%mesh, T%mesh) |
324 | + call allocate(matrix, sparsity) ! Add data space to the sparsity |
325 | + ! pattern. |
326 | + call zero(matrix) |
327 | + |
328 | + !Flux reconstruction allocations |
329 | + if(present(Flux)) then |
330 | + !Allocate trace variable for upwind fluxes |
331 | + lambda_mesh=>extract_mesh(state, "VelocityMeshTrace") |
332 | + call allocate(UpwindFlux,lambda_mesh, "UpwindFlux") |
333 | + call zero(UpwindFlux) |
334 | + !Allocate matrix that maps T values to upwind fluxes |
335 | + sparsity => get_csr_sparsity_firstorder(state,lambda_mesh,T%mesh) |
336 | + call allocate(UpwindFluxMatrix,sparsity) |
337 | + call zero(UpwindFluxMatrix) |
338 | + end if |
339 | + |
340 | + mass_sparsity=make_sparsity_dg_mass(T%mesh) |
341 | + call allocate(mass, mass_sparsity) |
342 | + call zero(mass) |
343 | + call allocate(inv_mass, mass_sparsity) |
344 | + call zero(inv_mass) |
345 | + |
346 | + ! Ensure delta_T inherits options from T. |
347 | + call allocate(delta_T, T%mesh, "delta_T") |
348 | + call zero(delta_T) |
349 | + delta_T%option_path = T%option_path |
350 | + if(present(Flux)) then |
351 | + call allocate(delta_T_total, T%mesh, "deltaT_total") |
352 | + call zero(delta_T_total) |
353 | + end if |
354 | + call allocate(rhs, T%mesh, trim(field_name)//" RHS") |
355 | + call zero(rhs) |
356 | + |
357 | + if(present(Flux)) then |
358 | + call construct_advection_dg(matrix, rhs, field_name, state, & |
359 | + mass, velocity_name=velocity_name,continuity=continuity, & |
360 | + UpwindFlux=upwindflux, UpwindFluxMatrix=UpwindFluxMatrix) |
361 | + else |
362 | + call construct_advection_dg(matrix, rhs, field_name, state, & |
363 | + mass, velocity_name=velocity_name,continuity=continuity) |
364 | + end if |
365 | + |
366 | + call get_dg_inverse_mass_matrix(inv_mass, mass) |
367 | + |
368 | + ! Note that since dt is module global, these lines have to |
369 | + ! come after construct_advection_diffusion_dg. |
370 | + call get_option("/timestepping/timestep", dt) |
371 | + |
372 | + if(have_option(trim(T%option_path)//& |
373 | + &"/prognostic/temporal_discretisation/discontinuous_galerkin/& |
374 | + &/number_advection_subcycles")) then |
375 | + call get_option(trim(T%option_path)//& |
376 | + &"/prognostic/temporal_discretisation/discontinuous_galerkin/& |
377 | + &/number_advection_subcycles", subcycles) |
378 | + else |
379 | + call get_option(trim(T%option_path)//& |
380 | + &"/prognostic/temporal_discretisation/discontinuous_galerkin/& |
381 | + &maximum_courant_number_per_subcycle", Max_Courant_number) |
382 | + |
383 | + s_field => extract_scalar_field(state, "DG_CourantNumber") |
384 | + call calculate_diagnostic_variable(state, "DG_CourantNumber_Local", & |
385 | + & s_field) |
386 | + ewrite_minmax(s_field) |
387 | + subcycles = ceiling( maxval(s_field%val)/Max_Courant_number) |
388 | + call allmax(subcycles) |
389 | + ewrite(2,*) 'Number of subcycles for tracer eqn: ', subcycles |
390 | + end if |
391 | + |
392 | + limit_slope=.false. |
393 | + if (have_option(trim(T%option_path)//"/prognostic/spatial_discretisation/& |
394 | + &discontinuous_galerkin/slope_limiter")) then |
395 | + limit_slope=.true. |
396 | + |
397 | + call get_option(trim(T%option_path)//"/prognostic/spatial_discretisation/discontinuous_galerkin/slope_limiter/name",limiter_name) |
398 | + |
399 | + select case(trim(limiter_name)) |
400 | + case("Vertex_Based") |
401 | + limiter=LIMITER_VB |
402 | + case default |
403 | + FLAbort('No such limiter') |
404 | + end select |
405 | + |
406 | + ! Note unsafe for mixed element meshes |
407 | + if (element_degree(T,1)==0) then |
408 | + FLExit("Slope limiters make no sense for degree 0 fields") |
409 | + end if |
410 | + |
411 | + end if |
412 | + |
413 | + if (limit_slope) then |
414 | + ! Filter wiggles from T |
415 | + call limit_vb_manifold(state,T,delta_T) |
416 | + if(present(flux)) then |
417 | + call zero(upwindflux) |
418 | + call mult(delta_T_total, mass, delta_T) |
419 | + call update_flux(Flux, Delta_T_total, UpwindFlux, Mass) |
420 | + end if |
421 | + end if |
422 | + |
423 | + do i=1, subcycles |
424 | + ewrite(1,*) 'SUBCYCLE', i |
425 | + |
426 | + ! dT = Advection * T |
427 | + call mult(delta_T, matrix, T) |
428 | + ! dT = dT + RHS |
429 | + call addto(delta_T, RHS, -1.0) |
430 | + if(present(Flux)) then |
431 | + if(maxval(abs(RHS%val))>1.0e-8) then |
432 | + FLAbort('Flux reconstruction doesn''t work if diffusion/bcs present at the moment') |
433 | + end if |
434 | + end if |
435 | + call scale(delta_T, -dt/subcycles) |
436 | + ! dT = M^(-1) dT |
437 | + if(present(flux)) then |
438 | + call mult(UpwindFlux, upwindfluxmatrix, T) |
439 | + call scale(UpwindFlux,-dt/subcycles) |
440 | + call update_flux(Flux, Delta_T, UpwindFlux, Mass) |
441 | + end if |
442 | + ! T = T + dt/s * dT |
443 | + call dg_apply_mass(inv_mass, delta_T) |
444 | + ewrite(2,*) 'Delta_T', maxval(abs(delta_T%val)) |
445 | + call addto(T, delta_T) |
446 | + !Probably need to halo_update(Flux) as well |
447 | + call halo_update(T) |
448 | + |
449 | + if (limit_slope) then |
450 | + ! Filter wiggles from T |
451 | + call limit_vb_manifold(state,T,delta_T) |
452 | + if(present(flux)) then |
453 | + call mult(delta_t_total, mass, delta_t) |
454 | + call zero(UpwindFlux) |
455 | + call update_flux(Flux, Delta_T_total, UpwindFlux, Mass) |
456 | + end if |
457 | + end if |
458 | + end do |
459 | + |
460 | + if(present(Flux)) then |
461 | + if(have_option('/material_phase::Fluid/scalar_field::LayerThickness/p& |
462 | + &rognostic/spatial_discretisation/debug')) then |
463 | + do ele = 1, ele_count(Flux) |
464 | + call check_flux(Flux,T,T_old,X,mass,ele) |
465 | + end do |
466 | + end if |
467 | + call deallocate(UpwindFlux) |
468 | + call deallocate(UpwindFluxMatrix) |
469 | + call deallocate(delta_T_total) |
470 | + end if |
471 | + |
472 | + call deallocate(delta_T) |
473 | + call deallocate(matrix) |
474 | + call deallocate(mass) |
475 | + call deallocate(inv_mass) |
476 | + call deallocate(mass_sparsity) |
477 | + call deallocate(rhs) |
478 | + |
479 | + end subroutine solve_advection_dg_subcycle |
480 | + |
481 | + subroutine check_flux(Flux,T,T_old,X,mass,ele) |
482 | + type(vector_field), intent(in) :: Flux, X |
483 | + type(scalar_field), intent(in) :: T,T_old |
484 | + integer, intent(in) :: ele |
485 | + type(csr_matrix), intent(in) :: mass |
486 | + ! |
487 | + real, dimension(Flux%dim,ele_loc(Flux,ele)) :: Flux_vals |
488 | + real, dimension(ele_ngi(T,ele)) :: Div_Flux_gi |
489 | + real, dimension(ele_ngi(T,ele)) :: Delta_T_gi, T_gi |
490 | + real, dimension(ele_loc(T,ele)) :: Delta_T_rhs, Div_Flux_rhs,T_rhs |
491 | + integer :: dim1, loc |
492 | + real, dimension(ele_ngi(X,ele)) :: detwei |
493 | + real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J_mat |
494 | + real :: residual |
495 | + Delta_T_gi = ele_val_at_quad(T,ele)-ele_val_at_quad(T_old,ele) |
496 | + T_gi = ele_val_at_quad(T,ele) |
497 | + Flux_vals = ele_val(Flux,ele) |
498 | + |
499 | + Div_Flux_gi = 0. |
500 | + !dn is loc x ngi x dim |
501 | + do dim1 = 1, Flux%dim |
502 | + do loc = 1, ele_loc(Flux,ele) |
503 | + Div_Flux_gi = Div_Flux_gi + Flux%mesh%shape%dn(loc,:,dim1)*& |
504 | + &Flux_vals(dim1,loc) |
505 | + end do |
506 | + end do |
507 | + |
508 | + call compute_jacobian(ele_val(X,ele), ele_shape(X,ele),& |
509 | + detwei=detwei,J=J_mat) |
510 | + |
511 | + Delta_T_rhs = shape_rhs(ele_shape(T,ele),Delta_T_gi*detwei) |
512 | + T_rhs = shape_rhs(ele_shape(T,ele),T_gi*detwei) |
513 | + Div_Flux_rhs = shape_rhs(ele_shape(T,ele),Div_Flux_gi*& |
514 | + Flux%mesh%shape%quadrature%weight) |
515 | + |
516 | + residual = & |
517 | + maxval(abs(Delta_T_rhs-Div_Flux_rhs))/max(1.0& |
518 | + &,maxval(abs(T_rhs))) |
519 | + if(residual>1.0e-6) then |
520 | + ewrite(2,*) residual, maxval(abs(T_rhs)) |
521 | + FLExit('Flux residual error.') |
522 | + end if |
523 | + |
524 | + end subroutine check_flux |
525 | + |
526 | + subroutine update_flux(Flux, Delta_T, UpwindFlux, Mass) |
527 | + !! Subroutine to compute div-conforming Flux such that |
528 | + !! div Flux = Delta_T |
529 | + !! with Flux.n = UpwindFlux on element boundaries |
530 | + !! and then to add to Flux |
531 | + type(vector_field), intent(inout) :: Flux |
532 | + type(scalar_field), intent(in) :: Delta_T |
533 | + type(scalar_field), intent(in) :: UpwindFlux |
534 | + type(csr_matrix), intent(in) :: Mass |
535 | + ! |
536 | + integer :: ele, i |
537 | + real :: Area |
538 | + integer, dimension(:), pointer :: T_ele |
539 | + |
540 | + !Checking the Flux is in local representation |
541 | + assert(Flux%dim==mesh_dim(Flux)) |
542 | + |
543 | + do ele = 1, ele_count(Flux) |
544 | + T_ele => ele_nodes(delta_T,ele) |
545 | + area = 0. |
546 | + do i = 1, size(T_ele) |
547 | + area = area + & |
548 | + sum(row_val(Mass,t_ele(i))) |
549 | + end do |
550 | + call update_flux_ele(Flux, Delta_T, UpwindFlux,ele,area) |
551 | + end do |
552 | + |
553 | + end subroutine update_flux |
554 | + |
555 | + subroutine update_flux_ele(Flux, Delta_T, UpwindFlux,ele,area) |
556 | + !! Subroutine to compute div-conforming Flux such that |
557 | + !! div Flux = Delta_T |
558 | + !! with Flux.n = UpwindFlux on element boundaries |
559 | + type(vector_field), intent(inout) :: Flux |
560 | + type(scalar_field), intent(in) :: Delta_T |
561 | + type(scalar_field), intent(in) :: UpwindFlux |
562 | + integer, intent(in) :: ele |
563 | + real, intent(in) :: area |
564 | + ! |
565 | + real, dimension(Flux%dim,ele_loc(Flux,ele)) :: Flux_vals |
566 | + real, dimension(ele_loc(Delta_T,ele)) :: Delta_T_vals |
567 | + real, dimension(Flux%dim*ele_loc(Flux,ele),& |
568 | + Flux%dim*ele_loc(Flux,ele)) :: Flux_mat |
569 | + real, dimension(Flux%dim*ele_loc(Flux,ele)) :: Flux_rhs |
570 | + integer :: row, ni, ele2, face, face2,floc, i, dim1, dim2 |
571 | + integer, dimension(:), pointer :: neigh |
572 | + type(constraints_type), pointer :: flux_constraint |
573 | + type(element_type), pointer :: flux_shape, T_shape |
574 | + real, dimension(Flux%dim,ele_loc(Delta_T,ele),& |
575 | + &ele_loc(Flux,ele)) :: grad_mat |
576 | + real, dimension(ele_loc(Delta_t,ele)) :: delta_t_val |
577 | + real, dimension(ele_loc(flux,ele),ele_loc(flux,ele)) & |
578 | + &:: flux_mass_mat |
579 | + real, dimension(ele_loc(Delta_t,ele)) :: div_flux_val |
580 | + real, dimension(ele_ngi(Delta_t,ele)) :: div_flux_gi |
581 | + real :: total_flux, residual |
582 | + !! Need to set up and solve equation for flux DOFs |
583 | + !! Rows are as follows: |
584 | + !! All of the normal fluxes through edges, numbered according to |
585 | + !! UpwindFlux numbering |
586 | + !! Inner product of Flux with grad basis equaling gradient of delta_T |
587 | + !! plus boundary conditions |
588 | + !! Inner product of solution with curl basis equals zero |
589 | + !! inner product of solution with constraint basis equals zero |
590 | + |
591 | + !! Debugging check: |
592 | + !! \int \Delta T dV = \int div Flux dV = \int Flux.n dS |
593 | + !! = \int \hat{Flux}.\hat{n dS} |
594 | + neigh => ele_neigh(Flux,ele) |
595 | + total_flux = 0. |
596 | + do ni = 1, size(neigh) |
597 | + ele2 = neigh(ni) |
598 | + face = ele_face(Flux,ele,ele2) |
599 | + if(ele2>0) then |
600 | + face2 = ele_face(Flux,ele2,ele) |
601 | + else |
602 | + face2 = face |
603 | + end if |
604 | + if(face>face2) then |
605 | + total_flux=total_flux+sum(face_val(UpwindFlux,face)) |
606 | + else |
607 | + total_flux=total_flux-sum(face_val(UpwindFlux,face)) |
608 | + end if |
609 | + end do |
610 | + residual = abs(total_flux-sum(ele_val(Delta_T,ele)))& |
611 | + &/max(1.0,maxval(ele_val(Delta_T,ele)))/area |
612 | + if(residual>1.0e-10) then |
613 | + ewrite(0,*) 'Residual = ', residual |
614 | + FLExit('Bad residual') |
615 | + end if |
616 | + |
617 | + Flux_rhs = 0. |
618 | + Flux_mat = 0. |
619 | + flux_shape => ele_shape(flux,ele) |
620 | + T_shape => ele_shape(delta_t,ele) |
621 | + flux_constraint => flux%mesh%shape%constraints |
622 | + |
623 | + row = 1 |
624 | + !first do the face DOFs |
625 | + neigh => ele_neigh(Flux,ele) |
626 | + do ni = 1, size(neigh) |
627 | + ele2 = neigh(ni) |
628 | + face = ele_face(Flux,ele,ele2) |
629 | + if(ele2>0) then |
630 | + face2 = ele_face(Flux,ele2,ele) |
631 | + else |
632 | + face2 = face |
633 | + end if |
634 | + floc = face_loc(upwindflux,face) |
635 | + |
636 | + call update_flux_face(& |
637 | + Flux,UpwindFlux,face,face2,& |
638 | + ele,ele2,Flux_mat(row:row+floc-1,:),& |
639 | + Flux_rhs(row:row+floc-1)) |
640 | + row = row + floc |
641 | + end do |
642 | + |
643 | + !Next the gradient basis |
644 | + !Start with \nabla\cdot F = \Delta T |
645 | + !Integrate with test function over element |
646 | + ! <\phi,Div F>_E = <\phi, \Delta T>_E |
647 | + |
648 | + grad_mat = shape_dshape(T_shape, flux_shape%dn,& |
649 | + & T_shape%quadrature%weight) |
650 | + delta_t_val = ele_val(delta_t,ele) |
651 | + do i = 1, ele_loc(Delta_T,ele)-1 |
652 | + do dim1 = 1, flux%dim |
653 | + Flux_mat(row,(dim1-1)*ele_loc(flux,ele)+1:dim1*ele_loc(flux,ele))& |
654 | + &=grad_mat(dim1,i,:) |
655 | + end do |
656 | + flux_rhs(row) = delta_t_val(i) |
657 | + row = row + 1 |
658 | + end do |
659 | + |
660 | + !Then the curl basis |
661 | + !Adding in the curl terms |
662 | + flux_mass_mat = shape_shape(flux_shape,flux_shape,T_shape%quadrature%weight) |
663 | + do i = 1, flux_constraint%n_curl_basis |
664 | + flux_mat(row,:) = 0. |
665 | + flux_rhs(row) = 0. |
666 | + do dim1 = 1, mesh_dim(flux) |
667 | + do dim2 = 1, mesh_dim(flux) |
668 | + flux_mat(& |
669 | + row,(dim2-1)*ele_loc(flux,ele)+1:dim2*ele_loc(flux,ele)) =& |
670 | + flux_mat(& |
671 | + row,(dim2-1)*ele_loc(flux,ele)+1:dim2*ele_loc(flux,ele)) +& |
672 | + matmul(flux_constraint%curl_basis(i,:,dim1),& |
673 | + flux_mass_mat) |
674 | + end do |
675 | + end do |
676 | + row = row + 1 |
677 | + end do |
678 | + |
679 | + !Then the constraints |
680 | + do i = 1, flux_constraint%n_constraints |
681 | + do dim1 = 1, mesh_dim(flux) |
682 | + flux_mat(& |
683 | + row,(dim1-1)*ele_loc(flux,ele)+1:& |
684 | + dim1*ele_loc(flux,ele)) =& |
685 | + flux_constraint%orthogonal(i,:,dim1) |
686 | + end do |
687 | + row = row + 1 |
688 | + end do |
689 | + |
690 | + call solve(flux_mat,flux_rhs) |
691 | + |
692 | + do dim1 = 1, mesh_dim(flux) |
693 | + flux_vals(dim1,:) = & |
694 | + flux_rhs((dim1-1)*ele_loc(flux,ele)+1:dim1*ele_loc(flux,ele)) |
695 | + end do |
696 | + |
697 | + !A debugging check. |
698 | + !Computing < \phi, div F> in local coordinates |
699 | + !and comparing with <\phi, delta_T> in global coordinates |
700 | + !(works because of pullback formula) |
701 | + |
702 | + !dn is loc x ngi x dim |
703 | + !Flux is dim x loc |
704 | + div_flux_gi = 0. |
705 | + do dim1 =1, size(flux_vals,1) |
706 | + do i=1,size(flux_vals,2) |
707 | + div_flux_gi = div_flux_gi + flux_vals(dim1,i)*& |
708 | + &flux_shape%dn(i,:,dim1) |
709 | + end do |
710 | + end do |
711 | + div_flux_val = shape_rhs(T_shape,div_flux_gi*T_shape%quadrature%weight) |
712 | + residual = maxval(abs(div_flux_val-delta_T_val))/max(1.0& |
713 | + &,maxval(abs(delta_T_val)))/area |
714 | + assert(residual<1.0e-10) |
715 | + |
716 | + !Add the flux in |
717 | + call addto(flux,ele_nodes(flux,ele),flux_vals) |
718 | + end subroutine update_flux_ele |
719 | + |
720 | + subroutine update_flux_face(& |
721 | + Flux,UpwindFlux,face,face2,& |
722 | + ele,ele2,Flux_mat_rows,Flux_rhs_rows) |
723 | + type(vector_field), intent(in) :: Flux |
724 | + type(scalar_Field), intent(in) :: UpwindFlux |
725 | + integer, intent(in) :: face,face2,ele,ele2 |
726 | + real, dimension(face_loc(upwindflux,ele),& |
727 | + &mesh_dim(flux)*ele_loc(flux,ele)), & |
728 | + &intent(inout) :: flux_mat_rows |
729 | + real, dimension(flux%mesh%shape%constraints%n_face_basis), intent(inout)& |
730 | + &:: flux_rhs_rows |
731 | + ! |
732 | + integer :: dim1, row, flux_dim1 |
733 | + real, dimension(mesh_dim(flux), face_ngi(flux, face)) :: n_local |
734 | + real, dimension(face_ngi(flux,face)) :: detwei_f |
735 | + real :: weight |
736 | + type(element_type), pointer :: flux_face_shape, upwindflux_face_shape |
737 | + integer, dimension(face_loc(flux,face)) :: flux_face_nodes |
738 | + real, dimension(mesh_dim(flux),face_loc(upwindflux,face),& |
739 | + face_loc(flux,face)) :: face_mat |
740 | + ! |
741 | + flux_face_shape=>face_shape(flux, face) |
742 | + upwindflux_face_shape=>face_shape(upwindflux, face) |
743 | + flux_face_nodes=face_local_nodes(flux, face) |
744 | + |
745 | + !Get normal in local coordinates |
746 | + call get_local_normal(n_local,weight,flux,& |
747 | + &local_face_number(flux%mesh,face)) |
748 | + |
749 | + detwei_f = weight*flux_face_shape%quadrature%weight |
750 | + face_mat = shape_shape_vector(& |
751 | + upwindflux_face_shape,flux_face_shape,detwei_f,n_local) |
752 | + !Equation is: |
753 | + ! <\phi,Flux.n> = <\phi,UpwindFlux> for all trace test functions \phi. |
754 | + |
755 | + do row = 1, size(flux_mat_rows,1) |
756 | + flux_mat_rows(row,:) = 0. |
757 | + do dim1 = 1,mesh_dim(flux) |
758 | + flux_dim1 = (dim1-1)*ele_loc(flux,ele) |
759 | + flux_mat_rows(row,flux_dim1+flux_face_nodes)& |
760 | + &=face_mat(dim1,row,:) |
761 | + end do |
762 | + end do |
763 | + !Need to adopt a sign convention: |
764 | + !If face>face_2 |
765 | + !We store flux with normal pointing from face into face_2 |
766 | + !Otherwise |
767 | + !We store flux with normal pointing from face_2 into face |
768 | + ! Outflow boundary integral. |
769 | + if(face>face2) then |
770 | + flux_rhs_rows = face_val(UpwindFlux,face) |
771 | + else |
772 | + flux_rhs_rows = -face_val(UpwindFlux,face) |
773 | + end if |
774 | + end subroutine update_flux_face |
775 | + |
776 | + subroutine construct_advection_dg(big_m, rhs, field_name,& |
777 | + & state, mass, velocity_name, continuity,& |
778 | + & UpwindFlux, UpwindFluxMatrix) |
779 | + !!< Construct the advection equation for discontinuous elements in |
780 | + !!< acceleration form. |
781 | + !!< |
782 | + !!< If mass is provided then the mass matrix is not added into big_m or |
783 | + !!< rhs. It is instead returned as mass. This may be useful for testing |
784 | + !!< or for solving equations otherwise than in acceleration form. |
785 | + |
786 | + !! Main advection matrix. |
787 | + type(csr_matrix), intent(inout) :: big_m |
788 | + !! Right hand side vector. |
789 | + type(scalar_field), intent(inout) :: rhs |
790 | + |
791 | + !! Name of the field to be advected. |
792 | + character(len=*), intent(in) :: field_name |
793 | + !! Collection of fields defining system state. |
794 | + type(state_type), intent(inout) :: state |
795 | + !! Optional separate mass matrix. |
796 | + type(csr_matrix), intent(inout), optional :: mass |
797 | + !! Optional velocity name |
798 | + character(len = *), intent(in), optional :: velocity_name |
799 | + !! solve the continuity equation |
800 | + logical, intent(in), optional :: continuity |
801 | + !! Upwind flux field |
802 | + type(scalar_field), intent(in), optional :: UpwindFlux |
803 | + !! Upwind flux matrix |
804 | + type(csr_matrix), intent(inout), optional :: UpwindFluxMatrix |
805 | + |
806 | + !! Position, and velocity fields. |
807 | + type(vector_field) :: X, U, U_nl |
808 | + !! Tracer to be solved for. |
809 | + type(scalar_field) :: T |
810 | + |
811 | + !! Local velocity name |
812 | + character(len = FIELD_NAME_LEN) :: lvelocity_name |
813 | + |
814 | + !! Element index |
815 | + integer :: ele |
816 | + |
817 | + !! Status variable for field extraction. |
818 | + integer :: stat |
819 | + |
820 | + ewrite(1,*) "Writing advection equation for "& |
821 | + &//trim(field_name) |
822 | + |
823 | + ! These names are based on the CGNS SIDS. |
824 | + T=extract_scalar_field(state, field_name) |
825 | + X=extract_vector_field(state, "Coordinate") |
826 | + |
827 | + if(present(velocity_name)) then |
828 | + lvelocity_name = velocity_name |
829 | + else |
830 | + lvelocity_name = "NonlinearVelocity" |
831 | + end if |
832 | + |
833 | + if (.not.have_option(trim(T%option_path)//"/prognostic& |
834 | + &/spatial_discretisation/discontinuous_galerkin& |
835 | + &/advection_scheme/none")) then |
836 | + U_nl=extract_vector_field(state, lvelocity_name) |
837 | + call incref(U_nl) |
838 | + include_advection=.true. |
839 | + else |
840 | + ! Forcing a zero NonlinearVelocity will disable advection. |
841 | + U=extract_vector_field(state, "Velocity", stat) |
842 | + if (stat/=0) then |
843 | + FLExit("Oh dear, no velocity field. A velocity field is required for advection!") |
844 | + end if |
845 | + call allocate(U_nl, U%dim, U%mesh, "LocalNonlinearVelocity") |
846 | + call zero(U_nl) |
847 | + include_advection=.false. |
848 | + end if |
849 | + |
850 | + assert(has_faces(X%mesh)) |
851 | + assert(has_faces(T%mesh)) |
852 | + |
853 | + call zero(big_m) |
854 | + call zero(RHS) |
855 | + call zero(mass) |
856 | + |
857 | + element_loop: do ele=1,element_count(T) |
858 | + |
859 | + call construct_adv_element_dg(ele, big_m, rhs,& |
860 | + & X, T, U_nl, mass, continuity=continuity,& |
861 | + & upwindflux=upwindflux, upwindfluxmatrix=upwindfluxmatrix) |
862 | + |
863 | + end do element_loop |
864 | + |
865 | + ! Drop any extra field references. |
866 | + |
867 | + call deallocate(U_nl) |
868 | + |
869 | + end subroutine construct_advection_dg |
870 | + |
871 | + subroutine construct_adv_element_dg(ele, big_m, rhs,& |
872 | + & X, T, U_nl, mass, continuity, upwindflux, upwindfluxmatrix) |
873 | + !!< Construct the advection_diffusion equation for discontinuous elements in |
874 | + !!< acceleration form. |
875 | + implicit none |
876 | + !! Index of current element |
877 | + integer :: ele |
878 | + !! Main advection matrix. |
879 | + type(csr_matrix), intent(inout) :: big_m |
880 | + !! Right hand side vector. |
881 | + type(scalar_field), intent(inout) :: rhs |
882 | + !! Optional separate mass matrix. |
883 | + type(csr_matrix), intent(inout) :: mass |
884 | + |
885 | + !! Position and velocity. |
886 | + type(vector_field), intent(in) :: X, U_nl |
887 | + |
888 | + type(scalar_field), intent(in) :: T |
889 | + |
890 | + !! Upwind flux field |
891 | + type(scalar_field), intent(in), optional :: UpwindFlux |
892 | + !! Upwind flux matrix |
893 | + type(csr_matrix), intent(inout), optional :: UpwindFluxMatrix |
894 | + |
895 | + |
896 | + !! Solve the continuity equation rather than advection |
897 | + logical, intent(in), optional :: continuity |
898 | + |
899 | + ! Bilinear forms. |
900 | + real, dimension(ele_loc(T,ele), ele_loc(T,ele)) :: & |
901 | + mass_mat |
902 | + real, dimension(ele_loc(T,ele), ele_loc(T,ele)) :: & |
903 | + Advection_mat, Ad_mat1, Ad_mat2 |
904 | + |
905 | + ! Local assembly matrices. |
906 | + real, dimension(ele_loc(T,ele), ele_loc(T,ele)) :: l_T_mat |
907 | + real, dimension(ele_loc(T,ele)) :: l_T_rhs |
908 | + |
909 | + ! Local variables. |
910 | + |
911 | + ! Neighbour element, face and neighbour face. |
912 | + integer :: ele_2, face, face_2 |
913 | + ! Loops over faces. |
914 | + integer :: ni |
915 | + |
916 | + ! Transform from local to physical coordinates. |
917 | + real, dimension(ele_ngi(X,ele)) :: detwei |
918 | + real, dimension(mesh_dim(U_nl), X%dim, ele_ngi(X,ele)) :: J_mat |
919 | + |
920 | + ! Different velocities at quad points. |
921 | + real, dimension(U_nl%dim, ele_ngi(U_nl, ele)) :: U_quad |
922 | + real, dimension(U_nl%dim, ele_ngi(U_nl, ele)) :: U_nl_q |
923 | + real, dimension(ele_ngi(U_nl, ele)) :: U_nl_div_q |
924 | + |
925 | + ! Node and shape pointers. |
926 | + integer, dimension(:), pointer :: T_ele |
927 | + type(element_type), pointer :: T_shape, U_shape |
928 | + ! Neighbours of this element. |
929 | + integer, dimension(:), pointer :: neigh |
930 | + |
931 | + integer :: gi,i,j |
932 | + |
933 | + !---------------------------------------------------------------------- |
934 | + ! Establish local node lists |
935 | + !---------------------------------------------------------------------- |
936 | + |
937 | + T_ele=>ele_nodes(T,ele) ! Tracer node numbers |
938 | + |
939 | + !---------------------------------------------------------------------- |
940 | + ! Establish local shape functions |
941 | + !---------------------------------------------------------------------- |
942 | + |
943 | + T_shape=>ele_shape(T, ele) |
944 | + U_shape=>ele_shape(U_nl, ele) |
945 | + |
946 | + !========================== |
947 | + ! Coordinates |
948 | + !========================== |
949 | + |
950 | + ! Get J_mat |
951 | + call compute_jacobian(ele_val(X,ele), ele_shape(X,ele), detwei=detwei, J=J_mat) |
952 | + |
953 | + !---------------------------------------------------------------------- |
954 | + ! Construct bilinear forms. |
955 | + !---------------------------------------------------------------------- |
956 | + |
957 | + ! Element density matrix. |
958 | + ! / |
959 | + ! | T T dV |
960 | + ! / |
961 | + mass_mat = shape_shape(T_shape, T_shape, detwei) |
962 | + |
963 | + if (include_advection) then |
964 | + |
965 | + ! Advecting velocity at quadrature points. |
966 | + U_quad=ele_val_at_quad(U_nl,ele) |
967 | + U_nl_q=U_quad |
968 | + |
969 | + U_nl_div_q=ele_div_at_quad(U_nl, ele, U_shape%dn) |
970 | + |
971 | + ! Element advection matrix |
972 | + ! / / |
973 | + ! - | (grad phi dot U_nl) T dV -| phi ( div U_nl ) T dV |
974 | + ! / / |
975 | + Advection_mat = -dshape_dot_vector_shape(T_shape%dn, U_nl_q, T_shape,& |
976 | + & T_shape%quadrature%weight) |
977 | + if(.not.present_and_true(continuity)) then |
978 | + Advection_mat = Advection_mat& |
979 | + &-shape_shape(T_shape, T_shape, U_nl_div_q * T_shape& |
980 | + &%quadrature%weight) |
981 | + end if |
982 | + else |
983 | + Advection_mat=0.0 |
984 | + end if |
985 | + |
986 | + !---------------------------------------------------------------------- |
987 | + ! Perform global assembly. |
988 | + !---------------------------------------------------------------------- |
989 | + |
990 | + l_T_rhs=0.0 |
991 | + |
992 | + ! Assemble matrix. |
993 | + |
994 | + ! Advection. |
995 | + l_T_mat= Advection_mat |
996 | + |
997 | + call addto(mass, t_ele, t_ele, mass_mat) |
998 | + |
999 | + call addto(big_m, t_ele, t_ele, l_T_mat) |
1000 | + |
1001 | + !------------------------------------------------------------------- |
1002 | + ! Interface integrals |
1003 | + !------------------------------------------------------------------- |
1004 | + |
1005 | + neigh=>ele_neigh(T, ele) |
1006 | + |
1007 | + neighbourloop: do ni=1,size(neigh) |
1008 | + |
1009 | + !---------------------------------------------------------------------- |
1010 | + ! Find the relevant faces. |
1011 | + !---------------------------------------------------------------------- |
1012 | + |
1013 | + ! These finding routines are outside the inner loop so as to allow |
1014 | + ! for local stack variables of the right size in |
1015 | + ! construct_add_diff_interface_dg. |
1016 | + |
1017 | + ele_2=neigh(ni) |
1018 | + |
1019 | + ! Note that although face is calculated on field U, it is in fact |
1020 | + ! applicable to any field which shares the same mesh topology. |
1021 | + face=ele_face(T, ele, ele_2) |
1022 | + |
1023 | + if (ele_2>0) then |
1024 | + ! Internal faces. |
1025 | + face_2=ele_face(T, ele_2, ele) |
1026 | + else |
1027 | + ! External face. |
1028 | + face_2=face |
1029 | + end if |
1030 | + |
1031 | + call construct_adv_interface_dg(ele, face, face_2,& |
1032 | + & big_m, rhs, X, T, U_nl, upwindflux, upwindfluxmatrix) |
1033 | + |
1034 | + end do neighbourloop |
1035 | + |
1036 | + end subroutine construct_adv_element_dg |
1037 | + |
1038 | + subroutine construct_adv_interface_dg(ele, face, face_2, & |
1039 | + big_m, rhs, X, T, U_nl,upwindflux, upwindfluxmatrix) |
1040 | + |
1041 | + !!< Construct the DG element boundary integrals on the ni-th face of |
1042 | + !!< element ele. |
1043 | + implicit none |
1044 | + |
1045 | + integer, intent(in) :: ele, face, face_2 |
1046 | + type(csr_matrix), intent(inout) :: big_m |
1047 | + type(scalar_field), intent(inout) :: rhs |
1048 | + ! We pass these additional fields to save on state lookups. |
1049 | + type(vector_field), intent(in) :: X, U_nl |
1050 | + type(scalar_field), intent(in) :: T |
1051 | + !! Upwind flux field |
1052 | + type(scalar_field), intent(in), optional :: UpwindFlux |
1053 | + !! Upwind flux matrix |
1054 | + type(csr_matrix), intent(inout), optional :: UpwindFluxMatrix |
1055 | + |
1056 | + ! Face objects and numberings. |
1057 | + type(element_type), pointer :: T_shape, T_shape_2 |
1058 | + integer, dimension(face_loc(T,face)) :: T_face |
1059 | + integer, dimension(face_loc(T,face_2)) :: T_face_2 |
1060 | + integer, dimension(face_loc(U_nl,face)) :: U_face |
1061 | + integer, dimension(face_loc(U_nl,face_2)) :: U_face_2 |
1062 | + |
1063 | + ! Note that both sides of the face can be assumed to have the same |
1064 | + ! number of quadrature points. |
1065 | + real, dimension(U_nl%dim, face_ngi(U_nl, face)) :: n1, n2, normal, U_nl_q,& |
1066 | + & u_f_q, u_f2_q, div_u_f_q |
1067 | + logical, dimension(face_ngi(U_nl, face)) :: inflow |
1068 | + real, dimension(face_ngi(U_nl, face)) :: U_nl_q_dotn1, U_nl_q_dotn2, U_nl_q_dotn, income |
1069 | + ! Variable transform times quadrature weights. |
1070 | + real, dimension(face_ngi(T,face)) :: detwei |
1071 | + real, dimension(U_nl%dim, X%dim, face_ngi(T,face)) :: J |
1072 | + real, dimension(face_ngi(T,face)) :: inner_advection_integral, outer_advection_integral |
1073 | + |
1074 | + ! Bilinear forms |
1075 | + real, dimension(face_loc(T,face),face_loc(T,face)) :: nnAdvection_out |
1076 | + real, dimension(face_loc(T,face),face_loc(T,face_2)) :: nnAdvection_in |
1077 | + |
1078 | + ! Normal weights |
1079 | + real :: w1, w2 |
1080 | + integer :: i |
1081 | + |
1082 | + T_face=face_global_nodes(T, face) |
1083 | + T_shape=>face_shape(T, face) |
1084 | + |
1085 | + T_face_2=face_global_nodes(T, face_2) |
1086 | + T_shape_2=>face_shape(T, face_2) |
1087 | + |
1088 | + !Get normals |
1089 | + call get_local_normal(n1, w1, U_nl, local_face_number(U_nl%mesh,face)) |
1090 | + call get_local_normal(n2, w2, U_nl, local_face_number(U_nl%mesh,face_2)) |
1091 | + |
1092 | + if (include_advection) then |
1093 | + |
1094 | + ! Advecting velocity at quadrature points. |
1095 | + U_f_q = face_val_at_quad(U_nl, face) |
1096 | + U_f2_q = face_val_at_quad(U_nl, face_2) |
1097 | + |
1098 | + u_nl_q_dotn1 = sum(U_f_q*w1*n1,1) |
1099 | + u_nl_q_dotn2 = -sum(U_f2_q*w2*n2,1) |
1100 | + U_nl_q_dotn=0.5*(u_nl_q_dotn1+u_nl_q_dotn2) |
1101 | + |
1102 | + ! Inflow is true if the flow at this gauss point is directed |
1103 | + ! into this element. |
1104 | + inflow = u_nl_q_dotn<0.0 |
1105 | + income = merge(1.0,0.0,inflow) |
1106 | + |
1107 | + !---------------------------------------------------------------------- |
1108 | + ! Construct bilinear forms. |
1109 | + !---------------------------------------------------------------------- |
1110 | + |
1111 | + ! Calculate outflow boundary integral. |
1112 | + ! can anyone think of a way of optimising this more to avoid |
1113 | + ! superfluous operations (i.e. multiplying things by 0 or 1)? |
1114 | + |
1115 | + ! first the integral around the inside of the element |
1116 | + ! (this is the flux *out* of the element) |
1117 | + inner_advection_integral = (1.-income)*u_nl_q_dotn |
1118 | + nnAdvection_out=shape_shape(T_shape, T_shape, & |
1119 | + & inner_advection_integral*T_shape%quadrature%weight) |
1120 | + |
1121 | + ! now the integral around the outside of the element |
1122 | + ! (this is the flux *in* to the element) |
1123 | + outer_advection_integral = income*u_nl_q_dotn |
1124 | + nnAdvection_in=shape_shape(T_shape, T_shape_2, & |
1125 | + & outer_advection_integral*T_shape%quadrature%weight) |
1126 | + |
1127 | + end if |
1128 | + |
1129 | + !---------------------------------------------------------------------- |
1130 | + ! Perform global assembly. |
1131 | + !---------------------------------------------------------------------- |
1132 | + |
1133 | + ! Insert advection in matrix. |
1134 | + if (include_advection) then |
1135 | + |
1136 | + ! Outflow boundary integral. |
1137 | + call addto(big_M, T_face, T_face,& |
1138 | + nnAdvection_out) |
1139 | + |
1140 | + ! Inflow boundary integral. |
1141 | + call addto(big_M, T_face, T_face_2,& |
1142 | + nnAdvection_in) |
1143 | + |
1144 | + if(present(UpwindFlux).and.present(UpwindFluxMatrix)) then |
1145 | + call construct_upwindflux_interface(upwindflux,upwindfluxmatrix) |
1146 | + end if |
1147 | + end if |
1148 | + |
1149 | + contains |
1150 | + subroutine construct_upwindflux_interface(upwindflux,upwindfluxmatrix) |
1151 | + type(scalar_field), intent(in) :: upwindflux |
1152 | + type(csr_matrix), intent(inout) :: upwindfluxmatrix |
1153 | + ! |
1154 | + ! Bilinear forms |
1155 | + real, dimension(face_loc(upwindflux,face),& |
1156 | + face_loc(T,face)) :: upwindflux_mat_in,upwindflux_mat_out |
1157 | + type(element_type), pointer :: flux_shape |
1158 | + integer, dimension(face_loc(upwindflux,face)) :: flux_face |
1159 | + integer :: sign |
1160 | + |
1161 | + flux_shape=>face_shape(upwindflux, face) |
1162 | + flux_face=face_global_nodes(upwindflux, face) |
1163 | + |
1164 | + upwindflux_mat_in=shape_shape(flux_shape, T_shape, & |
1165 | + income*u_nl_q_dotn*T_shape%quadrature%weight) |
1166 | + upwindflux_mat_out=shape_shape(flux_shape, T_shape, & |
1167 | + (1.0-income)*u_nl_q_dotn*T_shape%quadrature%weight) |
1168 | + |
1169 | + !Need to adopt a sign convention: |
1170 | + !If face>face_2 |
1171 | + !We store flux with normal pointing from face into face_2 |
1172 | + !Otherwise |
1173 | + !We store flux with normal pointing from face_2 into face |
1174 | + ! Outflow boundary integral. |
1175 | + |
1176 | + !inflow = u_nl_q_dotn<0.0 |
1177 | + !income = 1 if(inflow) and 0 otherwise |
1178 | + if(face>face_2) then |
1179 | + sign = 1 |
1180 | + else |
1181 | + sign = -1 |
1182 | + end if |
1183 | + |
1184 | + !Factor of 0.5 is because we visit from both sides |
1185 | + if(face.ne.face_2) then |
1186 | + call addto(upwindfluxmatrix, flux_face, T_face_2,& |
1187 | + 0.5*sign*upwindflux_mat_in) |
1188 | + end if |
1189 | + call addto(upwindfluxmatrix, flux_face, T_face,& |
1190 | + 0.5*sign*upwindflux_mat_out) |
1191 | + |
1192 | + end subroutine construct_upwindflux_interface |
1193 | + |
1194 | + end subroutine construct_adv_interface_dg |
1195 | + |
1196 | + subroutine solve_advection_cg_tracer(Q,D,D_old,Flux,U_nl,QF,state) |
1197 | + !!< Solve the continuity equation for D*Q with Flux |
1198 | + !!< d/dt (D*Q) + div(Flux*Q) = diffusion terms. |
1199 | + !!< Done on the vorticity mesh |
1200 | + !!< Return a PV flux Q defined on the velocity mesh |
1201 | + !!< which is the projection of Flux*Q into the velocity space |
1202 | + !!< Note that Flux and Q contain a factor of dt for convenience. |
1203 | + type(state_type), intent(inout) :: state |
1204 | + type(scalar_field), intent(in),target :: D,D_old |
1205 | + type(scalar_field), intent(inout),target :: Q |
1206 | + type(vector_field), intent(in) :: Flux,U_nl |
1207 | + type(vector_field), intent(inout) :: QF |
1208 | + ! |
1209 | + type(csr_sparsity), pointer :: Q_sparsity |
1210 | + type(csr_matrix) :: Adv_mat |
1211 | + type(scalar_field) :: Q_rhs, Qtest1,Qtest2 |
1212 | + type(vector_field), pointer :: X, down |
1213 | + type(scalar_field), pointer :: Q_old |
1214 | + integer :: ele |
1215 | + real :: dt, t_theta, residual |
1216 | + |
1217 | + ewrite(1,*) ' subroutine solve_advection_cg_tracer(' |
1218 | + |
1219 | + X=>extract_vector_field(state, "Coordinate") |
1220 | + down=>extract_vector_field(state, "GravityDirection") |
1221 | + Q_old=>extract_scalar_field(state, "Old"//trim(Q%name)) |
1222 | + call get_option('/timestepping/timestep',dt) |
1223 | + call get_option('/timestepping/theta',t_theta) |
1224 | + |
1225 | + !set up matrix and rhs |
1226 | + Q_sparsity => get_csr_sparsity_firstorder(state, Q%mesh, Q%mesh) |
1227 | + call allocate(adv_mat, Q_sparsity) ! Add data space to the sparsity |
1228 | + ! pattern. |
1229 | + call zero(adv_mat) |
1230 | + call allocate(Q_rhs,Q%mesh,trim(Q%name)//"RHS") |
1231 | + call zero(Q_rhs) |
1232 | + call zero(QF) |
1233 | + |
1234 | + do ele = 1, ele_count(Q) |
1235 | + call construct_advection_cg_tracer_ele(Q_rhs,adv_mat,Q,D,D_old,Flux& |
1236 | + &,X,down,U_nl,dt,t_theta,ele) |
1237 | + end do |
1238 | + |
1239 | + ewrite(2,*) 'Q_RHS', maxval(abs(Q_rhs%val)) |
1240 | + |
1241 | + call petsc_solve(Q,adv_mat,Q_rhs) |
1242 | + |
1243 | + !! Compute the PV flux to pass to velocity equation |
1244 | + do ele = 1, ele_count(Q) |
1245 | + call construct_pv_flux_ele(QF,Q,Q_old,D,D_old,Flux,& |
1246 | + X,down,U_nl,t_theta,ele) |
1247 | + end do |
1248 | + |
1249 | + if(have_option('/material_phase::Fluid/scalar_field::PotentialVorticity/& |
1250 | + &prognostic/debug')) then |
1251 | + call allocate(Qtest1,Q%mesh,trim(Q%name)//"test1") |
1252 | + call zero(Qtest1) |
1253 | + call allocate(Qtest2,Q%mesh,trim(Q%name)//"test2") |
1254 | + call zero(Qtest2) |
1255 | + do ele = 1, ele_count(Q) |
1256 | + call test_pv_flux_ele(Qtest1,Qtest2,QF,Q,Q_old,D,D_old,& |
1257 | + Flux,X,down,t_theta,ele) |
1258 | + end do |
1259 | + ewrite(2,*) 'Error = ', maxval(abs(Qtest2%val)), maxval(abs(Qtest1%val)) |
1260 | + ewrite(2,*) 'Error = ', maxval(abs(Qtest1%val-Qtest2%val)), maxval(Qtest1%val) |
1261 | + residual = maxval(abs(Qtest1%val-Qtest2%val))/max(1.0& |
1262 | + &,maxval(abs(Qtest1%val))) |
1263 | + ewrite(2,*) 'residual from qtest', residual |
1264 | + assert(residual<1.0e-6) |
1265 | + ewrite(2,*) 'test passed' |
1266 | + call deallocate(Qtest1) |
1267 | + call deallocate(Qtest2) |
1268 | + end if |
1269 | + |
1270 | + call deallocate(adv_mat) |
1271 | + call deallocate(Q_rhs) |
1272 | + |
1273 | + ewrite(1,*) 'END subroutine solve_advection_cg_tracer(' |
1274 | + |
1275 | + end subroutine solve_advection_cg_tracer |
1276 | + |
1277 | + subroutine construct_advection_cg_tracer_ele(Q_rhs,adv_mat,Q,D,D_old,Flux,& |
1278 | + & X,down,U_nl,dt,t_theta,ele) |
1279 | + type(scalar_field), intent(in) :: D,D_old,Q |
1280 | + type(scalar_field), intent(inout) :: Q_rhs |
1281 | + type(csr_matrix), intent(inout) :: Adv_mat |
1282 | + type(vector_field), intent(in) :: X, Flux, down,U_nl |
1283 | + integer, intent(in) :: ele |
1284 | + real, intent(in) :: dt, t_theta |
1285 | + ! |
1286 | + real, dimension(ele_loc(Q,ele),ele_loc(Q,ele)) :: l_adv_mat,tmp_mat |
1287 | + real, dimension(ele_loc(Q,ele)) :: l_rhs |
1288 | + real, dimension(U_nl%dim,ele_ngi(U_nl,ele)) :: U_nl_gi |
1289 | + real, dimension(X%dim, ele_ngi(U_nl,ele)) :: U_cart_gi |
1290 | + real, dimension(Flux%dim,ele_ngi(Flux,ele)) :: Flux_gi |
1291 | + real, dimension(Flux%dim,FLux%dim,ele_ngi(Flux,ele)) :: Grad_Flux_gi,& |
1292 | + & tensor_gi |
1293 | + real, dimension(ele_ngi(X,ele)) :: detwei, Q_gi, D_gi, & |
1294 | + & D_old_gi,div_flux_gi, detwei_l, detJ |
1295 | + real, dimension(ele_loc(D,ele)) :: D_val |
1296 | + real, dimension(ele_loc(Q,ele)) :: Q_val |
1297 | + real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J |
1298 | + type(element_type), pointer :: Q_shape, Flux_shape |
1299 | + integer :: loc,dim1,dim2,gi |
1300 | + real :: tau, alpha, tol, area, h,c_sc,disc_indicator |
1301 | + real, dimension(ele_ngi(X,ele),ele_ngi(X,ele)) :: Metric, MetricT |
1302 | + real, dimension(mesh_dim(X),ele_ngi(X,ele)) :: gradQ |
1303 | + type(element_type), pointer :: D_shape |
1304 | + ! |
1305 | + |
1306 | + ! Get J and detwei |
1307 | + call compute_jacobian(ele_val(X,ele), ele_shape(X,ele), detwei& |
1308 | + &=detwei, J=J, detJ=detJ) |
1309 | + |
1310 | + D_shape => ele_shape(D,ele) |
1311 | + Q_shape => ele_shape(Q,ele) |
1312 | + Flux_shape => ele_shape(Flux,ele) |
1313 | + D_val = invert_pi_ele(ele_val(D,ele),D_shape,detwei) |
1314 | + D_gi = matmul(transpose(D_shape%n),D_val) |
1315 | + D_val = invert_pi_ele(ele_val(D_old,ele),D_shape,detwei) |
1316 | + D_old_gi = matmul(transpose(D_shape%n),D_val) |
1317 | + Q_gi = ele_val_at_quad(Q,ele) |
1318 | + Flux_gi = ele_val_at_quad(Flux,ele) |
1319 | + U_nl_gi = ele_val_at_quad(U_nl,ele) |
1320 | + Q_val = ele_val(Q,ele) |
1321 | + |
1322 | + !Equations |
1323 | + ! D^{n+1} = D^n + \pi div Flux |
1324 | + ! If define \int_K\phi\hat{D}/J J dS = \int_K\phi D J dS, then |
1325 | + ! <\phi,\pi(\hat{D}/J)> = <\phi, D> for all \phi, |
1326 | + ! => \pi \hat{D} = D |
1327 | + ! \hat{D}^{n+1}/J = \hat{D}^n/J + div Flux |
1328 | + |
1329 | + ! So (integrating by parts) |
1330 | + ! <\gamma, \hat{D}^{n+1}/J> = |
1331 | + ! <\gamma, D^n/J> - <\nabla\gamma, F> |
1332 | + |
1333 | + ! and a consistent theta-method for Q is |
1334 | + ! <\gamma,\hat{D}^{n+1}Q^{n+1}/J> = |
1335 | + ! <\gamma, \hat{D}^nQ^n/J> - |
1336 | + ! \theta<\nabla\gamma,FQ^{n+1}> |
1337 | + ! -(1-\theta)<\nabla\gamma,FQ^n> |
1338 | + |
1339 | + detwei_l = Q_shape%quadrature%weight |
1340 | + !Advection terms |
1341 | + !! <-grad gamma, FQ > |
1342 | + !! Can be evaluated locally using pullback |
1343 | + tmp_mat = dshape_dot_vector_shape(& |
1344 | + Q_shape%dn,Flux_gi,Q_shape,detwei_l) |
1345 | + l_adv_mat = t_theta*tmp_mat |
1346 | + l_rhs = -(1-t_theta)*matmul(tmp_mat,Q_val) |
1347 | + |
1348 | + !Mass terms |
1349 | + !! <gamma, QD> |
1350 | + !! Requires transformed integral |
1351 | + tmp_mat = shape_shape(ele_shape(Q,ele),ele_shape(Q,ele),D_gi*detwei_l) |
1352 | + l_adv_mat = l_adv_mat + tmp_mat |
1353 | + tmp_mat = shape_shape(ele_shape(Q,ele),ele_shape(Q,ele),D_old_gi*detwei_l) |
1354 | + l_rhs = l_rhs + matmul(tmp_mat,Q_val) |
1355 | + |
1356 | + !Laplacian filter options |
1357 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1358 | + &continuous_galerkin/laplacian_filter')) then |
1359 | + FLExit('Laplacian filter not coded yet.') |
1360 | + end if |
1361 | + !Streamline upwinding options |
1362 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1363 | + &continuous_galerkin/streamline_upwinding')) then |
1364 | + !! Replace test function \gamma with \gamma + \tau u\cdot\nabla\gamma |
1365 | + call get_option(trim(Q%option_path)//'/prognostic/spatial_discretisat& |
1366 | + &ion/continuous_galerkin/streamline_upwinding/alpha',alpha) |
1367 | + call get_option(trim(Q%option_path)//'/prognostic/spatial_discretisat& |
1368 | + &ion/continuous_galerkin/streamline_upwinding/tol',tol) |
1369 | + |
1370 | + !Gradients of fluxes |
1371 | + Grad_flux_gi = ele_grad_at_quad(Flux,ele,Flux_shape%dn) |
1372 | + div_flux_gi = 0. |
1373 | + tensor_gi = 0. |
1374 | + do dim1 = 1, Flux%dim |
1375 | + div_flux_gi = div_flux_gi + grad_flux_gi(dim1,dim1,:) |
1376 | + do dim2 = 1, Flux%dim |
1377 | + tensor_gi(dim1,dim2,:) = U_nl_gi(dim1,:)*Flux_gi(dim2,:) |
1378 | + end do |
1379 | + end do |
1380 | + !real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J |
1381 | + do gi = 1, ele_ngi(X,ele) |
1382 | + U_cart_gi(:,gi) = matmul(transpose(J(:,:,gi)),U_nl_gi(:,gi))/detJ(gi) |
1383 | + end do |
1384 | + |
1385 | + if(maxval(sqrt(sum(U_cart_gi**2,1)))<tol) then |
1386 | + tau = 0. |
1387 | + else |
1388 | + area = sum(detwei) |
1389 | + h = sqrt(4*area/sqrt(3.)) |
1390 | + tau = h*alpha/maxval(sqrt(sum(U_cart_gi**2,1))) |
1391 | + end if |
1392 | + !! Mass terms |
1393 | + !! tau < u . grad gamma, QD> |
1394 | + !! = tau < grad gamma, u QD> |
1395 | + !! can do locally because of pullback formula |
1396 | + tmp_mat = dshape_dot_vector_shape(& |
1397 | + Q_shape%dn,U_nl_gi,Q_shape,D_gi*detwei_l/detJ) |
1398 | + l_adv_mat = l_adv_mat + tau*tmp_mat |
1399 | + tmp_mat = dshape_dot_vector_shape(& |
1400 | + Q_shape%dn,U_nl_gi,Q_shape,D_old_gi*detwei_l/detJ) |
1401 | + l_rhs = l_rhs + tau*matmul(tmp_mat,Q_val) |
1402 | + !! Advection terms |
1403 | + !! tau < u. grad gamma, div (F Q)> |
1404 | + !! = tau <grad gamma, u (F.grad Q + Q div F)> |
1405 | + !! can do locally because of pullback formula |
1406 | + !! tensor = u outer F (F already contains factor of dt) |
1407 | + tmp_mat = dshape_dot_vector_shape(& |
1408 | + Q_shape%dn,U_nl_gi,Q_shape,div_flux_gi*detwei_l/detJ) & |
1409 | + + dshape_tensor_dshape(& |
1410 | + Q_shape%dn,tensor_gi,Q_shape%dn,detwei_l/detJ) |
1411 | + l_adv_mat = l_adv_mat - tau*t_theta*tmp_mat |
1412 | + l_rhs = l_rhs + tau*(1-t_theta)*matmul(tmp_mat,Q_val) |
1413 | + end if |
1414 | + !Discontinuity capturing options |
1415 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1416 | + &continuous_galerkin/discontinuity_capturing')) then |
1417 | + ! call have_option(& |
1418 | + ! &trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1419 | + ! &continuous_galerkin/discontinuity_capturing/& |
1420 | + ! &scaling_coefficient',c_sc) |
1421 | + |
1422 | + ! do gi=1,ele_ngi(Q,ele) |
1423 | + ! Metric(:,:,gi)=matmul(J(:,:,gi), transpose(J(:,:,gi)))/detJ(gi) |
1424 | + ! end do |
1425 | + ! MetricT(1,1,:) = MetricT(2,2,:) |
1426 | + ! MetricT(2,2,:) = MetricT(1,1,:) |
1427 | + ! MetricT(1,2,:) =-MetricT(2,1,:) |
1428 | + ! MetricT(2,1,:) =-MetricT(1,2,:) |
1429 | + |
1430 | + ! area = sum(detwei) |
1431 | + ! D_gi = ele_val_at_quad(D_old,ele) |
1432 | + ! tmp_mat = dshape_tensor_dshape(Q_shape%dn, & |
1433 | + ! area*D_gi*MetricT, Q_shape%dn,& |
1434 | + ! Q_shape%quadrature%weight) |
1435 | + ! l_rhs = l_rhs - dt*c_sc*matmul(tmp_mat,Q_val) |
1436 | + FLAbort('not ready yet') |
1437 | + end if |
1438 | + |
1439 | + call addto(Q_rhs,ele_nodes(Q_rhs,ele),l_rhs) |
1440 | + call addto(adv_mat,ele_nodes(Q_rhs,ele),ele_nodes(Q_rhs,ele),& |
1441 | + l_adv_mat) |
1442 | + |
1443 | + end subroutine construct_advection_cg_tracer_ele |
1444 | + |
1445 | + subroutine construct_pv_flux_ele(QFlux,Q,Q_old,D,D_old,& |
1446 | + Flux,X,down,U_nl,t_theta,ele) |
1447 | + type(scalar_field), intent(in) :: Q,Q_old,D,D_old |
1448 | + type(vector_field), intent(inout) :: QFlux |
1449 | + type(vector_field), intent(in) :: X, Flux, Down, U_nl |
1450 | + integer, intent(in) :: ele |
1451 | + real, intent(in) :: t_theta |
1452 | + ! |
1453 | + real, dimension(mesh_dim(X),ele_loc(QFlux,ele)) :: QFlux_perp_rhs |
1454 | + real, dimension(Flux%dim,ele_ngi(Flux,ele)) :: Flux_gi, Flux_perp_gi,& |
1455 | + QFlux_gi |
1456 | + real, dimension(ele_ngi(X,ele)) :: Q_gi,Q_old_gi,D_gi,D_old_gi,Qbar_gi |
1457 | + real, dimension(ele_loc(D,ele)) :: D_val |
1458 | + real, dimension(X%dim, ele_ngi(Q, ele)) :: up_gi |
1459 | + real, dimension(mesh_dim(QFlux),mesh_dim(QFlux),ele_loc(QFlux,ele)& |
1460 | + &,ele_loc(QFlux,ele)) :: l_u_mat |
1461 | + real, dimension(mesh_dim(QFlux)*ele_loc(QFlux,ele),mesh_dim(QFlux)& |
1462 | + &*ele_loc(QFlux,ele)) :: solve_mat |
1463 | + real, dimension(ele_loc(Q,ele)) :: Q_test1_rhs, Q_test2_rhs |
1464 | + real, dimension(mesh_dim(Qflux)*ele_loc(QFlux,ele)) :: solve_rhs |
1465 | + real, dimension(mesh_dim(Qflux),ele_ngi(Qflux,ele)) :: & |
1466 | + contravariant_velocity_gi, velocity_perp_gi |
1467 | + type(element_type), pointer :: Q_shape, QFlux_shape, Flux_shape |
1468 | + integer :: loc, orientation,gi, dim1, dim2 |
1469 | + real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J |
1470 | + real, dimension(ele_ngi(X,ele)) :: detwei, detJ, detwei_l, div_flux_gi |
1471 | + real, dimension(mesh_dim(Q),ele_ngi(Q,ele)) :: gradQ_gi |
1472 | + real, dimension(Flux%dim,FLux%dim,ele_ngi(Flux,ele)) :: Grad_Flux_gi |
1473 | + real, dimension(U_nl%dim,ele_ngi(U_nl,ele)) :: U_nl_gi |
1474 | + real, dimension(X%dim,ele_ngi(U_nl,ele)) :: U_cart_gi |
1475 | + real :: residual, alpha, tol, tau, area, h |
1476 | + type(element_type), pointer :: D_shape |
1477 | + ! |
1478 | + |
1479 | + D_shape => ele_shape(D,ele) |
1480 | + |
1481 | + call compute_jacobian(ele_val(X,ele), ele_shape(X,ele), J, detwei, detJ) |
1482 | + |
1483 | + Q_shape => ele_shape(Q,ele) |
1484 | + Flux_shape => ele_shape(Flux,ele) |
1485 | + QFlux_shape => ele_shape(QFlux,ele) |
1486 | + Q_gi = ele_val_at_quad(Q,ele) |
1487 | + Q_old_gi = ele_val_at_quad(Q_old,ele) |
1488 | + Qbar_gi = t_theta*Q_gi + (1-t_theta)*Q_old_gi |
1489 | + D_val = invert_pi_ele(ele_val(D,ele),D_shape,detwei) |
1490 | + D_gi = matmul(transpose(D_shape%n),D_val) |
1491 | + D_val = invert_pi_ele(ele_val(D_old,ele),D_shape,detwei) |
1492 | + D_old_gi = matmul(transpose(D_shape%n),D_val) |
1493 | + Flux_gi = ele_val_at_quad(Flux,ele) |
1494 | + U_nl_gi = ele_val_at_quad(U_nl,ele) |
1495 | + |
1496 | + detwei_l = Q_shape%quadrature%weight |
1497 | + up_gi = -ele_val_at_quad(down,ele) |
1498 | + |
1499 | + call get_up_gi(X,ele,up_gi,orientation) |
1500 | + |
1501 | + !Equations |
1502 | + ! <\nabla \gamma, (-v,u)> = <(\gamma_x, \gamma_y),(-v,u)> |
1503 | + ! = <(\gamma_y,-\gamma_x),( u,v)> |
1504 | + ! = <-\nabla^\perp\gamma,(u,v)> |
1505 | + |
1506 | + ! and a consistent theta-method for Q is |
1507 | + ! <\gamma, D^{n+1}Q^{n+1}> = <\gamma, D^nQ^n> - |
1508 | + ! \theta<\nabla\gamma,FQ^{n+1}> |
1509 | + ! -(1-\theta)<\nabla\gamma,FQ^n> |
1510 | + ! So vorticity update is |
1511 | + ! <\gamma, \zeta^{n+1}> = <-\nabla^\perp\gamma,u^{n+1}> |
1512 | + != <-\nabla^\perp\gamma,u^n> |
1513 | + ! +\theta<-\nabla^\perp\gamma,(FQ^{n+1})^\perp> |
1514 | + ! +(1-\theta)<-\nabla^\perp\gamma,(FQ^n)^\perp> |
1515 | + ! taking w = -\nabla^\perp\gamma, |
1516 | + ! <w,u^{n+1}>=<w,u^n> + <w,F(\theta Q^{n+1}+(1-\theta)Q^n)^\perp> |
1517 | + ! <w,u^{n+1}>=<w,u^n> + <w,\bar{Q}^\perp> |
1518 | + ! We actually store the inner product with test function (FQ_rhs) |
1519 | + ! (avoids having to do a solve) |
1520 | + |
1521 | + do gi = 1, ele_ngi(QFlux,ele) |
1522 | + QFlux_gi(:,gi) = Flux_gi(:,gi)*Qbar_gi(gi) |
1523 | + end do |
1524 | + |
1525 | + !! Additional dissipative terms. |
1526 | + !! They all take the form |
1527 | + !! <\nabla gamma, G> |
1528 | + !! Which can be evaluated in local coordinates due to pullback magic |
1529 | + |
1530 | + !Laplacian filter options |
1531 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1532 | + &continuous_galerkin/laplacian_filter')) then |
1533 | + FLExit('Laplacian filter not coded yet.') |
1534 | + end if |
1535 | + !Streamline upwinding options |
1536 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1537 | + &continuous_galerkin/streamline_upwinding')) then |
1538 | + !! Replace test function \gamma with \gamma + \tau u\cdot\nabla\gamma |
1539 | + call get_option(trim(Q%option_path)//'/prognostic/spatial_discretisat& |
1540 | + &ion/continuous_galerkin/streamline_upwinding/alpha',alpha) |
1541 | + call get_option(trim(Q%option_path)//'/prognostic/spatial_discretisat& |
1542 | + &ion/continuous_galerkin/streamline_upwinding/tol',tol) |
1543 | + |
1544 | + !Gradients of fluxes |
1545 | + Grad_flux_gi = ele_grad_at_quad(Flux,ele,Flux_shape%dn) |
1546 | + div_flux_gi = 0. |
1547 | + do dim1 = 1, Flux%dim |
1548 | + div_flux_gi = div_flux_gi + grad_flux_gi(dim1,dim1,:) |
1549 | + end do |
1550 | + !real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J |
1551 | + do gi = 1, ele_ngi(X,ele) |
1552 | + U_cart_gi(:,gi) = matmul(transpose(J(:,:,gi)),U_nl_gi(:,gi))/detJ(gi) |
1553 | + end do |
1554 | + |
1555 | + if(maxval(sqrt(sum(U_cart_gi**2,1)))<tol) then |
1556 | + tau = 0. |
1557 | + else |
1558 | + area = sum(detwei) |
1559 | + h = sqrt(4*area/sqrt(3.)) |
1560 | + tau = h*alpha/maxval(sqrt(sum(U_cart_gi**2,1))) |
1561 | + end if |
1562 | + !! Mass terms |
1563 | + !! tau < u . grad gamma, -(QD)^{n+1}+(QD)^n> |
1564 | + !! = tau < grad gamma, u(-(QD)^{n+1}+(QD)^n)> |
1565 | + !! can do locally because of pullback formula |
1566 | + !! Extra flux is tau u\Delta(QD) |
1567 | + !! minus sign from definition of vorticity |
1568 | + !! tau |
1569 | + do gi = 1, ele_ngi(Q,ele) |
1570 | + QFLux_gi(:,gi) = QFlux_gi(:,gi) + & |
1571 | + & tau*U_nl_gi(:,gi)*(Q_gi(gi)*D_gi(gi)-Q_old_gi(gi)& |
1572 | + &*D_old_gi(gi))/detJ(gi) |
1573 | + |
1574 | + end do |
1575 | + !! Advection terms |
1576 | + !! tau < u. grad gamma, div (F\bar{Q})> |
1577 | + !! can do locally because of pullback formula |
1578 | + !! = <grad gamma, tau u (F.grad\bar{Q} + \bar{Q} div F)/det J>_{Ehat} |
1579 | + !! minus sign because of definition of vorticity |
1580 | + |
1581 | + GradQ_gi = t_theta*ele_grad_at_quad(Q,ele,Q_shape%dn) + & |
1582 | + (1-t_theta)*ele_grad_at_quad(Q_old,ele,Q_shape%dn) |
1583 | + |
1584 | + do gi = 1, ele_ngi(Q,ele) |
1585 | + QFlux_gi(:,gi) = QFlux_gi(:,gi) - tau*u_nl_gi(:,gi)*(& |
1586 | + & sum(Flux_gi(:,gi)*gradQ_gi(:,gi)) + & |
1587 | + & div_flux_gi(gi)*Qbar_gi(gi))/detJ(gi) |
1588 | + end do |
1589 | + end if |
1590 | + !Discontinuity capturing options |
1591 | + if(have_option(trim(Q%option_path)//'/prognostic/spatial_discretisation/& |
1592 | + &continuous_galerkin/discontinuity_capturing')) then |
1593 | + FLExit('Discontinuity capturing not coded yet.') |
1594 | + end if |
1595 | + |
1596 | + !! Evaluate |
1597 | + !! < w, F^\perp > in local coordinates |
1598 | + |
1599 | + Flux_perp_gi(1,:) = -orientation*QFlux_gi(2,:) |
1600 | + Flux_perp_gi(2,:) = orientation*QFlux_gi(1,:) |
1601 | + |
1602 | + QFlux_perp_rhs = shape_vector_rhs(QFlux_shape,Flux_perp_gi,& |
1603 | + & QFlux_shape%quadrature%weight) |
1604 | + |
1605 | + call set(QFlux,ele_nodes(QFlux,ele),QFlux_perp_rhs) |
1606 | + |
1607 | + end subroutine construct_pv_flux_ele |
1608 | + |
1609 | + subroutine test_pv_flux_ele(Qtest1,Qtest2,QFlux,Q,Q_old,D,D_old,& |
1610 | + Flux,X,down,t_theta,ele) |
1611 | + type(scalar_field), intent(in) :: Q,Q_old,D,D_old |
1612 | + type(scalar_field), intent(inout) :: Qtest1, Qtest2 |
1613 | + type(vector_field), intent(in) :: X, Flux, Down,QFlux |
1614 | + integer, intent(in) :: ele |
1615 | + real, intent(in) :: t_theta |
1616 | + ! |
1617 | + real, dimension(mesh_dim(X),ele_loc(QFlux,ele)) :: QFlux_perp_rhs |
1618 | + real, dimension(ele_ngi(X,ele)) :: Q_gi,Q_old_gi,D_gi,D_old_gi |
1619 | + real, dimension(Flux%dim,ele_ngi(Flux,ele)) :: Flux_gi, Flux_perp_gi |
1620 | + real, dimension(X%dim, ele_ngi(Q, ele)) :: up_gi |
1621 | + real, dimension(mesh_dim(QFlux), mesh_dim(QFlux), ele_ngi(QFlux,ele)) & |
1622 | + :: Metric, Metricf |
1623 | + real, dimension(mesh_dim(QFlux),mesh_dim(QFlux),ele_loc(QFlux,ele)& |
1624 | + &,ele_loc(QFlux,ele)) :: l_u_mat |
1625 | + real, dimension(mesh_dim(QFlux)*ele_loc(QFlux,ele),mesh_dim(QFlux)& |
1626 | + &*ele_loc(QFlux,ele)) :: solve_mat |
1627 | + real, dimension(ele_loc(Q,ele)) :: Q_test1_rhs, Q_test2_rhs |
1628 | + real, dimension(mesh_dim(Qflux)*ele_loc(QFlux,ele)) :: solve_rhs |
1629 | + real, dimension(mesh_dim(Qflux),ele_ngi(Qflux,ele)) :: & |
1630 | + contravariant_velocity_gi, velocity_perp_gi |
1631 | + type(element_type), pointer :: Q_shape, QFlux_shape,D_shape |
1632 | + integer :: loc, orientation,gi, dim1, dim2 |
1633 | + real, dimension(mesh_dim(X), X%dim, ele_ngi(X,ele)) :: J |
1634 | + real, dimension(ele_ngi(X,ele)) :: detwei, detJ |
1635 | + real, dimension(X%dim, X%dim, ele_ngi(X,ele)) :: rot |
1636 | + real, dimension(ele_loc(D,ele)) :: D_val |
1637 | + |
1638 | + D_shape => ele_shape(D,ele) |
1639 | + Q_shape => ele_shape(Q,ele) |
1640 | + QFlux_shape => ele_shape(QFlux,ele) |
1641 | + Q_gi = ele_val_at_quad(Q,ele) |
1642 | + Q_old_gi = ele_val_at_quad(Q_old,ele) |
1643 | + |
1644 | + call compute_jacobian(ele_val(X,ele), ele_shape(X,ele), J, detwei, detJ) |
1645 | + D_val = invert_pi_ele(ele_val(D,ele),D_shape,detwei) |
1646 | + D_gi = matmul(transpose(D_shape%n),D_val) |
1647 | + D_val = invert_pi_ele(ele_val(D_old,ele),D_shape,detwei) |
1648 | + D_old_gi = matmul(transpose(D_shape%n),D_val) |
1649 | + |
1650 | + Flux_gi = ele_val_at_quad(Flux,ele) |
1651 | + Qflux_perp_rhs = ele_val(Qflux,ele) |
1652 | + |
1653 | + do gi = 1, ele_ngi(QFlux,ele) |
1654 | + Flux_gi(:,gi) = Flux_gi(:,gi)*(t_theta*Q_gi(gi) + & |
1655 | + (1-t_theta)*Q_old_gi(gi)) |
1656 | + end do |
1657 | + |
1658 | + up_gi = -ele_val_at_quad(down,ele) |
1659 | + call get_up_gi(X,ele,up_gi,orientation) |
1660 | + |
1661 | + do gi=1, ele_ngi(QFlux,ele) |
1662 | + rot(1,:,gi)=(/0.,-up_gi(3,gi),up_gi(2,gi)/) |
1663 | + rot(2,:,gi)=(/up_gi(3,gi),0.,-up_gi(1,gi)/) |
1664 | + rot(3,:,gi)=(/-up_gi(2,gi),up_gi(1,gi),0./) |
1665 | + end do |
1666 | + do gi=1,ele_ngi(QFlux,ele) |
1667 | + Metric(:,:,gi)=matmul(J(:,:,gi), transpose(J(:,:,gi)))/detJ(gi) |
1668 | + Metricf(:,:,gi)=matmul(J(:,:,gi), & |
1669 | + matmul(rot(:,:,gi), transpose(J(:,:,gi))))/detJ(gi) |
1670 | + end do |
1671 | + |
1672 | + l_u_mat = shape_shape_tensor(qflux_shape, qflux_shape, & |
1673 | + qflux_shape%quadrature%weight,Metric) |
1674 | + solve_mat = 0. |
1675 | + solve_rhs = 0. |
1676 | + do dim1 = 1, mesh_dim(qflux) |
1677 | + do dim2 = 1, mesh_dim(qflux) |
1678 | + solve_mat( (dim1-1)*ele_loc(qflux,ele)+1:dim1*ele_loc(qflux,ele),& |
1679 | + (dim2-1)*ele_loc(qflux,ele)+1:dim2*ele_loc(qflux,ele)) = & |
1680 | + l_u_mat(dim1,dim2,:,:) |
1681 | + end do |
1682 | + solve_rhs( (dim1-1)*ele_loc(qflux,ele)+1:dim1*ele_loc(qflux,ele))& |
1683 | + = QFlux_perp_rhs(dim1,:) |
1684 | + end do |
1685 | + call solve(solve_mat,solve_rhs) |
1686 | + !Don't need to include constraints since u eqn is |
1687 | + ! <w,Q^\perp> + <<[w],\lambda>> + \sum_i C_i\cdot w \Gamma_i = RHS |
1688 | + ! but if w=-\nabla^\perp\gamma then [w]=0 and C_i\cdot w=0. |
1689 | + |
1690 | + do dim1 = 1, mesh_dim(qflux) |
1691 | + flux_perp_gi(dim1,:) = matmul(transpose(QFlux_shape%n),& |
1692 | + solve_rhs((dim1-1)*ele_loc(qflux,ele)+1:dim1*ele_loc(qflux& |
1693 | + &,ele))) |
1694 | + end do |
1695 | + !Now compute vorticity |
1696 | + do gi=1,ele_ngi(X,ele) |
1697 | + Metric(:,:,gi)=matmul(J(:,:,gi), transpose(J(:,:,gi)))/detJ(gi) |
1698 | + contravariant_velocity_gi(:,gi) = & |
1699 | + matmul(Metric(:,:,gi),Flux_perp_gi(:,gi)) |
1700 | + end do |
1701 | + |
1702 | + !!Q_test1_rhs contains -<\nabla\gamma,Q> |
1703 | + |
1704 | + select case(mesh_dim(X)) |
1705 | + case (2) |
1706 | + velocity_perp_gi(1,:) = -contravariant_velocity_gi(2,:) |
1707 | + velocity_perp_gi(2,:) = contravariant_velocity_gi(1,:) |
1708 | + Q_test1_rhs = dshape_dot_vector_rhs(Q%mesh%shape%dn, & |
1709 | + velocity_perp_gi,Q%mesh%shape%quadrature%weight) |
1710 | + Q_test1_rhs = q_test1_rhs*orientation |
1711 | + case default |
1712 | + FLAbort('Exterior derivative not implemented for given mesh dimension' |
Hi Colin,
Only had a quick glance but can I check if these changes provide any new functionality to fluidity itself? I ask because you've changed mesh_options.rn[cg] and these options are now appearing in the fluidity schema too but I can't see how they're applicable to fluidity as I can only trace them back to the hybridized helmholtz solver. If they're not used in fluidity then I don't think they should appear in a piece of the schema that is visible within an flml but I may be missing something.
Unrelated to this merge but the parent option (geometry/ mesh/from_ mesh/constrain_ type) for these new options is undocumented in the schema.
Cheers,
Cian