MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_hypoelastic.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2!>
3!! @file
4!! @brief Contains module m_hypoelastic
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp" 2
354
355!> @brief Computes hypoelastic stress-rate source terms and damage-state evolution
356module m_hypoelastic
357
358 use m_derived_types
359 use m_global_parameters
360 use m_finite_differences
361 use m_helper
362 use m_eos, only: s_phase_bulk_modulus
363
364 implicit none
365
366 private; public :: s_initialize_hypoelastic_module, s_finalize_hypoelastic_module, &
367 & s_compute_hypoelastic_rhs_finite_diff_per_sweep, s_compute_hypoelastic_rhs_iface, &
368 & s_compute_hypoelastic_rhs_axisym_geom_iface, s_compute_hypoelastic_rhs_axisym_geom_dual_pass, s_compute_damage_state, &
369 & s_enforce_cont_damage_bounds
370
371 real(wp), allocatable, dimension(:) :: gs_hypo
372
373# 24 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
374#if defined(MFC_OpenACC)
375# 24 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
376!$acc declare create(Gs_hypo)
377# 24 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
378#elif defined(MFC_OpenMP)
379# 24 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
380!$omp declare target (Gs_hypo)
381# 24 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
382#endif
383# 25 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
384
385 real(wp), allocatable, dimension(:,:,:) :: du_dx_hypo, du_dy_hypo, du_dz_hypo
386 real(wp), allocatable, dimension(:,:,:) :: dv_dx_hypo, dv_dy_hypo, dv_dz_hypo
387 real(wp), allocatable, dimension(:,:,:) :: dw_dx_hypo, dw_dy_hypo, dw_dz_hypo
388
389# 29 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
390#if defined(MFC_OpenACC)
391# 29 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
392!$acc declare create(du_dx_hypo, du_dy_hypo, du_dz_hypo, dv_dx_hypo, dv_dy_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
393# 29 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
394#elif defined(MFC_OpenMP)
395# 29 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
396!$omp declare target (du_dx_hypo, du_dy_hypo, du_dz_hypo, dv_dx_hypo, dv_dy_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
397# 29 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
398#endif
399# 30 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
400
401 real(wp), allocatable, dimension(:,:,:) :: rho_k_field, g_k_field
402
403# 32 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
404#if defined(MFC_OpenACC)
405# 32 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
406!$acc declare create(rho_K_field, G_K_field)
407# 32 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
408#elif defined(MFC_OpenMP)
409# 32 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
410!$omp declare target (rho_K_field, G_K_field)
411# 32 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
412#endif
413# 33 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
414
415 real(wp), allocatable, dimension(:,:) :: fd_coeff_x_hypo
416 real(wp), allocatable, dimension(:,:) :: fd_coeff_y_hypo
417 real(wp), allocatable, dimension(:,:) :: fd_coeff_z_hypo
418
419# 37 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
420#if defined(MFC_OpenACC)
421# 37 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
422!$acc declare create(fd_coeff_x_hypo, fd_coeff_y_hypo, fd_coeff_z_hypo)
423# 37 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
424#elif defined(MFC_OpenMP)
425# 37 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
426!$omp declare target (fd_coeff_x_hypo, fd_coeff_y_hypo, fd_coeff_z_hypo)
427# 37 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
428#endif
429# 38 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
430
431contains
432
433 !> Initialize the hypoelastic module
434 impure subroutine s_initialize_hypoelastic_module
435
436 integer :: i
437
438#ifdef MFC_DEBUG
439# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
440 block
441# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
442 use iso_fortran_env, only: output_unit
443# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
444
445# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
446 print *, 'm_hypoelastic.fpp:46: ', '@:ALLOCATE(Gs_hypo(1:num_fluids))'
447# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
448
449# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
450 call flush (output_unit)
451# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
452 end block
453# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
454#endif
455# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
456 allocate (gs_hypo(1:num_fluids))
457# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
458
459# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
460
461# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
462#if defined(MFC_OpenACC)
463# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
464!$acc enter data create(Gs_hypo)
465# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
466#elif defined(MFC_OpenMP)
467# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
468!$omp target enter data map(always,alloc:Gs_hypo)
469# 46 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
470#endif
471# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
472#ifdef MFC_DEBUG
473# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
474 block
475# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
476 use iso_fortran_env, only: output_unit
477# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
478
479# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
480 print *, 'm_hypoelastic.fpp:47: ', '@:ALLOCATE(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p))'
481# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
482
483# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
484 call flush (output_unit)
485# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
486 end block
487# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
488#endif
489# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
490 allocate (rho_k_field(0:m,0:n,0:p), g_k_field(0:m,0:n,0:p))
491# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
492
493# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
494
495# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
496
497# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
498#if defined(MFC_OpenACC)
499# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
500!$acc enter data create(rho_K_field, G_K_field)
501# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
502#elif defined(MFC_OpenMP)
503# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
504!$omp target enter data map(always,alloc:rho_K_field, G_K_field)
505# 47 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
506#endif
507# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
508#ifdef MFC_DEBUG
509# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
510 block
511# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
512 use iso_fortran_env, only: output_unit
513# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
514
515# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
516 print *, 'm_hypoelastic.fpp:48: ', '@:ALLOCATE(du_dx_hypo(0:m,0:n,0:p))'
517# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
518
519# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
520 call flush (output_unit)
521# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
522 end block
523# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
524#endif
525# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
526 allocate (du_dx_hypo(0:m,0:n,0:p))
527# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
528
529# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
530
531# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
532#if defined(MFC_OpenACC)
533# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
534!$acc enter data create(du_dx_hypo)
535# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
536#elif defined(MFC_OpenMP)
537# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
538!$omp target enter data map(always,alloc:du_dx_hypo)
539# 48 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
540#endif
541# 49 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
542 if (n > 0) then
543#ifdef MFC_DEBUG
544# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
545 block
546# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
547 use iso_fortran_env, only: output_unit
548# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
549
550# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
551 print *, 'm_hypoelastic.fpp:50: ', '@:ALLOCATE(du_dy_hypo(0:m,0:n,0:p), dv_dx_hypo(0:m,0:n,0:p), dv_dy_hypo(0:m,0:n,0:p))'
552# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
553
554# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
555 call flush (output_unit)
556# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
557 end block
558# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
559#endif
560# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
561 allocate (du_dy_hypo(0:m,0:n,0:p), dv_dx_hypo(0:m,0:n,0:p), dv_dy_hypo(0:m,0:n,0:p))
562# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
563
564# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
565
566# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
567
568# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
569
570# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
571#if defined(MFC_OpenACC)
572# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
573!$acc enter data create(du_dy_hypo, dv_dx_hypo, dv_dy_hypo)
574# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
575#elif defined(MFC_OpenMP)
576# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
577!$omp target enter data map(always,alloc:du_dy_hypo, dv_dx_hypo, dv_dy_hypo)
578# 50 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
579#endif
580# 51 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
581 if (p > 0) then
582#ifdef MFC_DEBUG
583# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
584 block
585# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
586 use iso_fortran_env, only: output_unit
587# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
588
589# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
590 print *, 'm_hypoelastic.fpp:52: ', '@:ALLOCATE(du_dz_hypo(0:m,0:n,0:p), dv_dz_hypo(0:m,0:n,0:p))'
591# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
592
593# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
594 call flush (output_unit)
595# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
596 end block
597# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
598#endif
599# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
600 allocate (du_dz_hypo(0:m,0:n,0:p), dv_dz_hypo(0:m,0:n,0:p))
601# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
602
603# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
604
605# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
606
607# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
608#if defined(MFC_OpenACC)
609# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
610!$acc enter data create(du_dz_hypo, dv_dz_hypo)
611# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
612#elif defined(MFC_OpenMP)
613# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
614!$omp target enter data map(always,alloc:du_dz_hypo, dv_dz_hypo)
615# 52 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
616#endif
617# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
618#ifdef MFC_DEBUG
619# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
620 block
621# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
622 use iso_fortran_env, only: output_unit
623# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
624
625# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
626 print *, 'm_hypoelastic.fpp:53: ', '@:ALLOCATE(dw_dx_hypo(0:m,0:n,0:p), dw_dy_hypo(0:m,0:n,0:p), dw_dz_hypo(0:m,0:n,0:p))'
627# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
628
629# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
630 call flush (output_unit)
631# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
632 end block
633# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
634#endif
635# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
636 allocate (dw_dx_hypo(0:m,0:n,0:p), dw_dy_hypo(0:m,0:n,0:p), dw_dz_hypo(0:m,0:n,0:p))
637# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
638
639# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
640
641# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
642
643# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
644
645# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
646#if defined(MFC_OpenACC)
647# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
648!$acc enter data create(dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
649# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
650#elif defined(MFC_OpenMP)
651# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
652!$omp target enter data map(always,alloc:dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
653# 53 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
654#endif
655# 54 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
656 end if
657 end if
658
659 do i = 1, num_fluids
660 gs_hypo(i) = fluid_pp(i)%G
661 end do
662
663# 60 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
664#if defined(MFC_OpenACC)
665# 60 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
666!$acc update device(Gs_hypo)
667# 60 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
668#elif defined(MFC_OpenMP)
669# 60 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
670!$omp target update to(Gs_hypo)
671# 60 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
672#endif
673# 61 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
674
675 ! s_compute_finite_difference_coefficients always extends fd_number beyond the interior on each side
676#ifdef MFC_DEBUG
677# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
678 block
679# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
680 use iso_fortran_env, only: output_unit
681# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
682
683# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
684 print *, 'm_hypoelastic.fpp:63: ', '@:ALLOCATE(fd_coeff_x_hypo(-fd_number:fd_number,-fd_number:m + fd_number))'
685# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
686
687# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
688 call flush (output_unit)
689# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
690 end block
691# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
692#endif
693# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
694 allocate (fd_coeff_x_hypo(-fd_number:fd_number,-fd_number:m + fd_number))
695# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
696
697# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
698
699# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
700#if defined(MFC_OpenACC)
701# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
702!$acc enter data create(fd_coeff_x_hypo)
703# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
704#elif defined(MFC_OpenMP)
705# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
706!$omp target enter data map(always,alloc:fd_coeff_x_hypo)
707# 63 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
708#endif
709# 64 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
710 if (n > 0) then
711#ifdef MFC_DEBUG
712# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
713 block
714# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
715 use iso_fortran_env, only: output_unit
716# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
717
718# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
719 print *, 'm_hypoelastic.fpp:65: ', '@:ALLOCATE(fd_coeff_y_hypo(-fd_number:fd_number,-fd_number:n + fd_number))'
720# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
721
722# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
723 call flush (output_unit)
724# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
725 end block
726# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
727#endif
728# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
729 allocate (fd_coeff_y_hypo(-fd_number:fd_number,-fd_number:n + fd_number))
730# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
731
732# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
733
734# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
735#if defined(MFC_OpenACC)
736# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
737!$acc enter data create(fd_coeff_y_hypo)
738# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
739#elif defined(MFC_OpenMP)
740# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
741!$omp target enter data map(always,alloc:fd_coeff_y_hypo)
742# 65 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
743#endif
744# 66 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
745 end if
746 if (p > 0) then
747#ifdef MFC_DEBUG
748# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
749 block
750# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
751 use iso_fortran_env, only: output_unit
752# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
753
754# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
755 print *, 'm_hypoelastic.fpp:68: ', '@:ALLOCATE(fd_coeff_z_hypo(-fd_number:fd_number,-fd_number:p + fd_number))'
756# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
757
758# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
759 call flush (output_unit)
760# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
761 end block
762# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
763#endif
764# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
765 allocate (fd_coeff_z_hypo(-fd_number:fd_number,-fd_number:p + fd_number))
766# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
767
768# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
769
770# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
771#if defined(MFC_OpenACC)
772# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
773!$acc enter data create(fd_coeff_z_hypo)
774# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
775#elif defined(MFC_OpenMP)
776# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
777!$omp target enter data map(always,alloc:fd_coeff_z_hypo)
778# 68 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
779#endif
780# 69 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
781 end if
782
783 ! Computing centered finite difference coefficients
784 call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_hypo, buff_size, fd_number, fd_order)
785
786# 73 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
787#if defined(MFC_OpenACC)
788# 73 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
789!$acc update device(fd_coeff_x_hypo)
790# 73 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
791#elif defined(MFC_OpenMP)
792# 73 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
793!$omp target update to(fd_coeff_x_hypo)
794# 73 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
795#endif
796# 74 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
797 if (n > 0) then
798 call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_hypo, buff_size, fd_number, fd_order)
799
800# 76 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
801#if defined(MFC_OpenACC)
802# 76 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
803!$acc update device(fd_coeff_y_hypo)
804# 76 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
805#elif defined(MFC_OpenMP)
806# 76 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
807!$omp target update to(fd_coeff_y_hypo)
808# 76 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
809#endif
810# 77 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
811 end if
812 if (p > 0) then
813 call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_hypo, buff_size, fd_number, fd_order)
814
815# 80 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
816#if defined(MFC_OpenACC)
817# 80 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
818!$acc update device(fd_coeff_z_hypo)
819# 80 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
820#elif defined(MFC_OpenMP)
821# 80 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
822!$omp target update to(fd_coeff_z_hypo)
823# 80 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
824#endif
825# 81 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
826 end if
827
828 end subroutine s_initialize_hypoelastic_module
829
830 !> Legacy FD-based hypoelastic RHS (Mode 1: HLL). Uses finite-difference velocity gradients computed from cell-centered
831 !! primitive variables. Called once per direction inside the dim-split loop. Supports 1D/2D/3D Cartesian and cylindrical
832 !! geometry.
833 !! @param idir Dimension splitting index
834 !! @param q_prim_vf Primitive variables
835 !! @param rhs_vf rhs variables
836 subroutine s_compute_hypoelastic_rhs_finite_diff_per_sweep(idir, q_prim_vf, rhs_vf)
837
838 integer, intent(in) :: idir
839 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
840 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
841 real(wp) :: rho_k, g_k
842 integer :: i, k, l, q, r !< Loop variables
843 integer :: ndirs !< Number of coordinate directions
844
845 ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3
846
847 if (idir == 1) then
848 ! calculate velocity gradients + rho_K and G_K TODO: re-organize these loops one by one for GPU efficiency if possible?
849
850
851# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
852
853# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
854#if defined(MFC_OpenACC)
855# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
856!$acc parallel loop collapse(3) gang vector default(present)
857# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
858#elif defined(MFC_OpenMP)
859# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
860
861# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
862
863# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
864
865# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
866!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
867# 105 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
868#endif
869# 106 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
870 do q = 0, p
871 do l = 0, n
872 do k = 0, m
873 du_dx_hypo(k, l, q) = 0._wp
874 end do
875 end do
876 end do
877
878# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
879#if defined(MFC_OpenACC)
880# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
881!$acc end parallel loop
882# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
883#elif defined(MFC_OpenMP)
884# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
885
886# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
887!$omp end target teams loop
888# 113 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
889#endif
890# 114 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
891
892
893# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
894
895# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
896#if defined(MFC_OpenACC)
897# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
898!$acc parallel loop collapse(3) gang vector default(present)
899# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
900#elif defined(MFC_OpenMP)
901# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
902
903# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
904
905# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
906
907# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
908!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
909# 115 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
910#endif
911# 116 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
912 do q = 0, p
913 do l = 0, n
914 do k = 0, m
915
916# 119 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
917#if defined(MFC_OpenACC)
918# 119 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
919!$acc loop seq
920# 119 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
921#elif defined(MFC_OpenMP)
922# 119 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
923
924# 119 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
925#endif
926# 120 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
927 do r = -fd_number, fd_number
928 du_dx_hypo(k, l, q) = du_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k + r, l, &
929 & q)*fd_coeff_x_hypo(r, k)
930 end do
931 end do
932 end do
933 end do
934
935# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
936#if defined(MFC_OpenACC)
937# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
938!$acc end parallel loop
939# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
940#elif defined(MFC_OpenMP)
941# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
942
943# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
944!$omp end target teams loop
945# 127 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
946#endif
947# 128 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
948
949 if (ndirs > 1) then
950
951# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
952
953# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
954#if defined(MFC_OpenACC)
955# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
956!$acc parallel loop collapse(3) gang vector default(present)
957# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
958#elif defined(MFC_OpenMP)
959# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
960
961# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
962
963# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
964
965# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
966!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
967# 130 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
968#endif
969# 131 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
970 do q = 0, p
971 do l = 0, n
972 do k = 0, m
973 du_dy_hypo(k, l, q) = 0._wp; dv_dx_hypo(k, l, q) = 0._wp; dv_dy_hypo(k, l, q) = 0._wp
974 end do
975 end do
976 end do
977
978# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
979#if defined(MFC_OpenACC)
980# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
981!$acc end parallel loop
982# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
983#elif defined(MFC_OpenMP)
984# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
985
986# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
987!$omp end target teams loop
988# 138 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
989#endif
990# 139 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
991
992
993# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
994
995# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
996#if defined(MFC_OpenACC)
997# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
998!$acc parallel loop collapse(3) gang vector default(present)
999# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1000#elif defined(MFC_OpenMP)
1001# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1002
1003# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1004
1005# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1006
1007# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1008!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1009# 140 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1010#endif
1011# 141 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1012 do q = 0, p
1013 do l = 0, n
1014 do k = 0, m
1015
1016# 144 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1017#if defined(MFC_OpenACC)
1018# 144 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1019!$acc loop seq
1020# 144 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1021#elif defined(MFC_OpenMP)
1022# 144 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1023
1024# 144 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1025#endif
1026# 145 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1027 do r = -fd_number, fd_number
1028 du_dy_hypo(k, l, q) = du_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k, l + r, &
1029 & q)*fd_coeff_y_hypo(r, l)
1030 dv_dx_hypo(k, l, q) = dv_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k + r, l, &
1031 & q)*fd_coeff_x_hypo(r, k)
1032 dv_dy_hypo(k, l, q) = dv_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l + r, &
1033 & q)*fd_coeff_y_hypo(r, l)
1034 end do
1035 end do
1036 end do
1037 end do
1038
1039# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1040#if defined(MFC_OpenACC)
1041# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1042!$acc end parallel loop
1043# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1044#elif defined(MFC_OpenMP)
1045# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1046
1047# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1048!$omp end target teams loop
1049# 156 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1050#endif
1051# 157 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1052
1053 ! 3D
1054 if (ndirs == 3) then
1055
1056# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1057
1058# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1059#if defined(MFC_OpenACC)
1060# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1061!$acc parallel loop collapse(3) gang vector default(present)
1062# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1063#elif defined(MFC_OpenMP)
1064# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1065
1066# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1067
1068# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1069
1070# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1071!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1072# 160 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1073#endif
1074# 161 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1075 do q = 0, p
1076 do l = 0, n
1077 do k = 0, m
1078 du_dz_hypo(k, l, q) = 0._wp; dv_dz_hypo(k, l, q) = 0._wp; dw_dx_hypo(k, l, q) = 0._wp
1079 dw_dy_hypo(k, l, q) = 0._wp; dw_dz_hypo(k, l, q) = 0._wp
1080 end do
1081 end do
1082 end do
1083
1084# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1085#if defined(MFC_OpenACC)
1086# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1087!$acc end parallel loop
1088# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1089#elif defined(MFC_OpenMP)
1090# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1091
1092# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1093!$omp end target teams loop
1094# 169 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1095#endif
1096# 170 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1097
1098
1099# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1100
1101# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1102#if defined(MFC_OpenACC)
1103# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1104!$acc parallel loop collapse(3) gang vector default(present)
1105# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1106#elif defined(MFC_OpenMP)
1107# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1108
1109# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1110
1111# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1112
1113# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1114!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1115# 171 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1116#endif
1117# 172 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1118 do q = 0, p
1119 do l = 0, n
1120 do k = 0, m
1121
1122# 175 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1123#if defined(MFC_OpenACC)
1124# 175 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1125!$acc loop seq
1126# 175 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1127#elif defined(MFC_OpenMP)
1128# 175 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1129
1130# 175 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1131#endif
1132# 176 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1133 do r = -fd_number, fd_number
1134 du_dz_hypo(k, l, q) = du_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k, l, &
1135 & q + r)*fd_coeff_z_hypo(r, q)
1136 dv_dz_hypo(k, l, q) = dv_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, &
1137 & q + r)*fd_coeff_z_hypo(r, q)
1138 dw_dx_hypo(k, l, q) = dw_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k + r, l, &
1139 & q)*fd_coeff_x_hypo(r, k)
1140 dw_dy_hypo(k, l, q) = dw_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k, l + r, &
1141 & q)*fd_coeff_y_hypo(r, l)
1142 dw_dz_hypo(k, l, q) = dw_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k, l, &
1143 & q + r)*fd_coeff_z_hypo(r, q)
1144 end do
1145 end do
1146 end do
1147 end do
1148
1149# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1150#if defined(MFC_OpenACC)
1151# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1152!$acc end parallel loop
1153# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1154#elif defined(MFC_OpenMP)
1155# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1156
1157# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1158!$omp end target teams loop
1159# 191 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1160#endif
1161# 192 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1162 end if
1163 end if
1164
1165
1166# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1167
1168# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1169#if defined(MFC_OpenACC)
1170# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1171!$acc parallel loop collapse(3) gang vector default(present) private(rho_K, G_K)
1172# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1173#elif defined(MFC_OpenMP)
1174# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1175
1176# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1177
1178# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1179
1180# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1181!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(rho_K, G_K)
1182# 195 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1183#endif
1184# 196 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1185 do q = 0, p
1186 do l = 0, n
1187 do k = 0, m
1188 rho_k = 0._wp; g_k = 0._wp
1189 do i = 1, num_fluids
1190 rho_k = rho_k + q_prim_vf(i)%sf(k, l, q) ! alpha_rho_K(1)
1191 g_k = g_k + q_prim_vf(eqn_idx%adv%beg - 1 + i)%sf(k, l, q)*gs_hypo(i) ! alpha_K(1) * Gs_hypo(1)
1192 end do
1193
1194 ! Continuum damage: (1-D) scales effective stiffness, D in [0,1]
1195 if (cont_damage) g_k = g_k*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(k, l, q)), 0._wp)
1196
1197 rho_k_field(k, l, q) = rho_k
1198 g_k_field(k, l, q) = g_k
1199
1200 if (g_k < verysmall) then
1201 g_k_field(k, l, q) = 0._wp
1202 end if
1203 end do
1204 end do
1205 end do
1206
1207# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1208#if defined(MFC_OpenACC)
1209# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1210!$acc end parallel loop
1211# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1212#elif defined(MFC_OpenMP)
1213# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1214
1215# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1216!$omp end target teams loop
1217# 217 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1218#endif
1219# 218 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1220
1221 ! apply rhs source term to elastic stress equation
1222
1223# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1224
1225# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1226#if defined(MFC_OpenACC)
1227# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1228!$acc parallel loop collapse(3) gang vector default(present)
1229# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1230#elif defined(MFC_OpenMP)
1231# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1232
1233# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1234
1235# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1236
1237# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1238!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1239# 220 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1240#endif
1241# 221 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1242 do q = 0, p
1243 do l = 0, n
1244 do k = 0, m
1245 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1246 & q)*((4._wp*g_k_field(k, l, q)/3._wp) + q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q))*du_dx_hypo(k, &
1247 & l, q)
1248 end do
1249 end do
1250 end do
1251
1252# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1253#if defined(MFC_OpenACC)
1254# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1255!$acc end parallel loop
1256# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1257#elif defined(MFC_OpenMP)
1258# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1259
1260# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1261!$omp end target teams loop
1262# 230 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1263#endif
1264# 231 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1265 else if (idir == 2) then
1266
1267# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1268
1269# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1270#if defined(MFC_OpenACC)
1271# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1272!$acc parallel loop collapse(3) gang vector default(present)
1273# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1274#elif defined(MFC_OpenMP)
1275# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1276
1277# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1278
1279# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1280
1281# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1282!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1283# 232 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1284#endif
1285# 233 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1286 do q = 0, p
1287 do l = 0, n
1288 do k = 0, m
1289 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1290 & q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dy_hypo(k, l, &
1291 & q) - q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dy_hypo(k, l, q) - (2._wp/3._wp)*g_k_field(k, &
1292 & l, q)*dv_dy_hypo(k, l, q))
1293
1294 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_k_field(k, &
1295 & l, q)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dx_hypo(k, l, &
1296 & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dy_hypo(k, l, q) + g_k_field(k, l, &
1297 & q)*(du_dy_hypo(k, l, q) + dv_dx_hypo(k, l, q)))
1298
1299 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_k_field(k, &
1300 & l, q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dx_hypo(k, l, &
1301 & q) - q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dx_hypo(k, l, &
1302 & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dv_dy_hypo(k, l, q) + 2._wp*g_k_field(k, l, &
1303 & q)*(dv_dy_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q))))
1304 end do
1305 end do
1306 end do
1307
1308# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1309#if defined(MFC_OpenACC)
1310# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1311!$acc end parallel loop
1312# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1313#elif defined(MFC_OpenMP)
1314# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1315
1316# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1317!$omp end target teams loop
1318# 254 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1319#endif
1320# 255 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1321 else if (idir == 3) then
1322
1323# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1324
1325# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1326#if defined(MFC_OpenACC)
1327# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1328!$acc parallel loop collapse(3) gang vector default(present)
1329# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1330#elif defined(MFC_OpenMP)
1331# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1332
1333# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1334
1335# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1336
1337# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1338!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1339# 256 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1340#endif
1341# 257 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1342 do q = 0, p
1343 do l = 0, n
1344 do k = 0, m
1345 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1346 & q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*du_dz_hypo(k, l, &
1347 & q) - q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dw_dz_hypo(k, l, q) - (2._wp/3._wp)*g_k_field(k, &
1348 & l, q)*dw_dz_hypo(k, l, q))
1349
1350 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_k_field(k, &
1351 & l, q)*(q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dz_hypo(k, l, &
1352 & q) + q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dz_hypo(k, l, &
1353 & q) - q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dz_hypo(k, l, q))
1354
1355 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_k_field(k, &
1356 & l, q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dv_dz_hypo(k, l, &
1357 & q) - q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dw_dz_hypo(k, l, &
1358 & q) - (2._wp/3._wp)*g_k_field(k, l, q)*dw_dz_hypo(k, l, q))
1359
1360 rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_k_field(k, &
1361 & l, q)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dw_dx_hypo(k, l, &
1362 & q) + q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dy_hypo(k, l, &
1363 & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dy_hypo(k, l, &
1364 & q) - q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dy_hypo(k, l, &
1365 & q) + q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)*du_dz_hypo(k, l, q) + g_k_field(k, l, &
1366 & q)*(du_dz_hypo(k, l, q) + dw_dx_hypo(k, l, q)))
1367
1368 rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) + rho_k_field(k, &
1369 & l, q)*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dx_hypo(k, l, &
1370 & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dx_hypo(k, l, &
1371 & q) - q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dx_hypo(k, l, &
1372 & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dw_dy_hypo(k, l, &
1373 & q) + q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)*dv_dz_hypo(k, l, q) + g_k_field(k, l, &
1374 & q)*(dv_dz_hypo(k, l, q) + dw_dy_hypo(k, l, q)))
1375
1376 rhs_vf(eqn_idx%stress%end)%sf(k, l, q) = rhs_vf(eqn_idx%stress%end)%sf(k, l, q) + rho_k_field(k, l, &
1377 & q)*(2._wp*q_prim_vf(eqn_idx%stress%end - 2)%sf(k, l, q)*dw_dx_hypo(k, l, &
1378 & q) - q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*du_dx_hypo(k, l, &
1379 & q) + 2._wp*q_prim_vf(eqn_idx%stress%end - 1)%sf(k, l, q)*dw_dy_hypo(k, l, &
1380 & q) - q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*dv_dy_hypo(k, l, &
1381 & q) + q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*dw_dz_hypo(k, l, q) + 2._wp*g_k_field(k, l, &
1382 & q)*(dw_dz_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, &
1383 & q) + dw_dz_hypo(k, l, q))))
1384 end do
1385 end do
1386 end do
1387
1388# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1389#if defined(MFC_OpenACC)
1390# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1391!$acc end parallel loop
1392# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1393#elif defined(MFC_OpenMP)
1394# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1395
1396# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1397!$omp end target teams loop
1398# 302 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1399#endif
1400# 303 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1401 end if
1402
1403 if (cyl_coord .and. idir == 2) then
1404
1405# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1406
1407# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1408#if defined(MFC_OpenACC)
1409# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1410!$acc parallel loop collapse(3) gang vector default(present)
1411# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1412#elif defined(MFC_OpenMP)
1413# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1414
1415# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1416
1417# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1418
1419# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1420!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1421# 306 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1422#endif
1423# 307 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1424 do q = 0, p
1425 do l = 0, n
1426 do k = 0, m
1427 ! S_xx -= rho * v/r * (tau_xx + 2/3*G)
1428 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) - rho_k_field(k, l, &
1429 & q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, &
1430 & q) + (2._wp/3._wp)*g_k_field(k, l, q)) ! tau_xx + 2/3*G
1431
1432 ! S_xr -= rho * v/r * tau_xr
1433 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) - rho_k_field(k, &
1434 & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, &
1435 & l, q) ! tau_xx
1436
1437 ! S_rr -= rho * v/r * (tau_rr + 2/3*G)
1438 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) - rho_k_field(k, &
1439 & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, &
1440 & q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + (2._wp/3._wp)*g_k_field(k, l, q)) ! tau_rr + 2/3*G
1441
1442 ! S_thetatheta += rho * ( -(tau_thetatheta + 2/3*G)*(du/dx + dv/dr + v/r) + 2*(tau_thetatheta + G)*v/r )
1443 rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_k_field(k, &
1444 & l, q)*(-(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + (2._wp/3._wp)*g_k_field(k, l, &
1445 & q))*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, &
1446 & q)/y_cc(l)) + 2._wp*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + g_k_field(k, l, &
1447 & q))*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l))
1448 end do
1449 end do
1450 end do
1451
1452# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1453#if defined(MFC_OpenACC)
1454# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1455!$acc end parallel loop
1456# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1457#elif defined(MFC_OpenMP)
1458# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1459
1460# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1461!$omp end target teams loop
1462# 334 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1463#endif
1464# 335 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1465 end if
1466
1467 end subroutine s_compute_hypoelastic_rhs_finite_diff_per_sweep
1468
1469 !> Interface-consistent hypoelastic RHS (Mode 2: HLL/HLLC). Uses interface velocities from the Riemann solver to compute
1470 !! velocity gradients. Called once after all dimensional sweeps. Supports 1D, 2D Cartesian, 2D axisymmetric, and 3D Cartesian.
1471 !! @param q_prim_vf Primitive variables
1472 !! @param rhs_vf rhs variables
1473 !! @param nc_iface_vel_n Interface velocities per direction
1474 subroutine s_compute_hypoelastic_rhs_iface(q_prim_vf, rhs_vf, nc_iface_vel_n)
1475
1476 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1477 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
1478 type(vector_field), dimension(:), intent(in) :: nc_iface_vel_n
1479 real(wp) :: rho_k, g_k
1480 real(wp) :: trace, shear, shear2, diag, diag_z, offdiag, cross1, cross2
1481 real(wp) :: txx, txy, tyy, txz, tyz, tzz
1482 integer :: i, k, l, q
1483 integer :: ndirs
1484
1485 ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3
1486
1487
1488# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1489
1490# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1491#if defined(MFC_OpenACC)
1492# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1493!$acc parallel loop collapse(3) gang vector default(present)
1494# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1495#elif defined(MFC_OpenMP)
1496# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1497
1498# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1499
1500# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1501
1502# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1503!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1504# 357 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1505#endif
1506# 358 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1507 do q = 0, p
1508 do l = 0, n
1509 do k = 0, m
1510 du_dx_hypo(k, l, q) = (nc_iface_vel_n(1)%vf(1)%sf(k, l, q) - nc_iface_vel_n(1)%vf(1)%sf(k - 1, l, q))/dx(k)
1511 end do
1512 end do
1513 end do
1514
1515# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1516#if defined(MFC_OpenACC)
1517# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1518!$acc end parallel loop
1519# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1520#elif defined(MFC_OpenMP)
1521# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1522
1523# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1524!$omp end target teams loop
1525# 365 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1526#endif
1527# 366 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1528
1529 if (ndirs > 1) then
1530
1531# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1532
1533# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1534#if defined(MFC_OpenACC)
1535# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1536!$acc parallel loop collapse(3) gang vector default(present)
1537# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1538#elif defined(MFC_OpenMP)
1539# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1540
1541# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1542
1543# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1544
1545# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1546!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1547# 368 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1548#endif
1549# 369 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1550 do q = 0, p
1551 do l = 0, n
1552 do k = 0, m
1553 du_dy_hypo(k, l, q) = (nc_iface_vel_n(2)%vf(1)%sf(k, l, q) - nc_iface_vel_n(2)%vf(1)%sf(k, l - 1, q))/dy(l)
1554 dv_dx_hypo(k, l, q) = (nc_iface_vel_n(1)%vf(2)%sf(k, l, q) - nc_iface_vel_n(1)%vf(2)%sf(k - 1, l, q))/dx(k)
1555 dv_dy_hypo(k, l, q) = (nc_iface_vel_n(2)%vf(2)%sf(k, l, q) - nc_iface_vel_n(2)%vf(2)%sf(k, l - 1, q))/dy(l)
1556 end do
1557 end do
1558 end do
1559
1560# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1561#if defined(MFC_OpenACC)
1562# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1563!$acc end parallel loop
1564# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1565#elif defined(MFC_OpenMP)
1566# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1567
1568# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1569!$omp end target teams loop
1570# 378 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1571#endif
1572# 379 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1573 end if
1574
1575 if (ndirs == 3) then
1576
1577# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1578
1579# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1580#if defined(MFC_OpenACC)
1581# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1582!$acc parallel loop collapse(3) gang vector default(present)
1583# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1584#elif defined(MFC_OpenMP)
1585# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1586
1587# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1588
1589# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1590
1591# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1592!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1593# 382 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1594#endif
1595# 383 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1596 do q = 0, p
1597 do l = 0, n
1598 do k = 0, m
1599 du_dz_hypo(k, l, q) = (nc_iface_vel_n(3)%vf(1)%sf(k, l, q) - nc_iface_vel_n(3)%vf(1)%sf(k, l, q - 1))/dz(q)
1600 dv_dz_hypo(k, l, q) = (nc_iface_vel_n(3)%vf(2)%sf(k, l, q) - nc_iface_vel_n(3)%vf(2)%sf(k, l, q - 1))/dz(q)
1601 dw_dx_hypo(k, l, q) = (nc_iface_vel_n(1)%vf(3)%sf(k, l, q) - nc_iface_vel_n(1)%vf(3)%sf(k - 1, l, q))/dx(k)
1602 dw_dy_hypo(k, l, q) = (nc_iface_vel_n(2)%vf(3)%sf(k, l, q) - nc_iface_vel_n(2)%vf(3)%sf(k, l - 1, q))/dy(l)
1603 dw_dz_hypo(k, l, q) = (nc_iface_vel_n(3)%vf(3)%sf(k, l, q) - nc_iface_vel_n(3)%vf(3)%sf(k, l, q - 1))/dz(q)
1604 end do
1605 end do
1606 end do
1607
1608# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1609#if defined(MFC_OpenACC)
1610# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1611!$acc end parallel loop
1612# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1613#elif defined(MFC_OpenMP)
1614# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1615
1616# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1617!$omp end target teams loop
1618# 394 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1619#endif
1620# 395 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1621 end if
1622
1623
1624# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1625
1626# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1627#if defined(MFC_OpenACC)
1628# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1629!$acc parallel loop collapse(3) gang vector default(present) private(rho_K, G_K)
1630# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1631#elif defined(MFC_OpenMP)
1632# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1633
1634# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1635
1636# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1637
1638# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1639!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(rho_K, G_K)
1640# 397 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1641#endif
1642# 398 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1643 do q = 0, p
1644 do l = 0, n
1645 do k = 0, m
1646 rho_k = 0._wp; g_k = 0._wp
1647 do i = 1, num_fluids
1648 rho_k = rho_k + q_prim_vf(i)%sf(k, l, q)
1649 g_k = g_k + q_prim_vf(eqn_idx%adv%beg - 1 + i)%sf(k, l, q)*gs_hypo(i)
1650 end do
1651
1652 if (cont_damage) g_k = g_k*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(k, l, q)), 0._wp)
1653
1654 rho_k_field(k, l, q) = rho_k
1655 g_k_field(k, l, q) = g_k
1656
1657 if (g_k < verysmall) then
1658 g_k_field(k, l, q) = 0._wp
1659 end if
1660 end do
1661 end do
1662 end do
1663
1664# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1665#if defined(MFC_OpenACC)
1666# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1667!$acc end parallel loop
1668# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1669#elif defined(MFC_OpenMP)
1670# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1671
1672# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1673!$omp end target teams loop
1674# 418 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1675#endif
1676# 419 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1677
1678
1679# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1680
1681# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1682#if defined(MFC_OpenACC)
1683# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1684!$acc parallel loop collapse(3) gang vector default(present)
1685# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1686#elif defined(MFC_OpenMP)
1687# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1688
1689# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1690
1691# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1692
1693# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1694!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1695# 420 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1696#endif
1697# 421 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1698 do q = 0, p
1699 do l = 0, n
1700 do k = 0, m
1701 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1702 & q)*((4._wp*g_k_field(k, l, q)/3._wp) + q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q))*du_dx_hypo(k, l, q)
1703 end do
1704 end do
1705 end do
1706
1707# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1708#if defined(MFC_OpenACC)
1709# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1710!$acc end parallel loop
1711# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1712#elif defined(MFC_OpenMP)
1713# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1714
1715# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1716!$omp end target teams loop
1717# 429 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1718#endif
1719# 430 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1720
1721 if (ndirs > 1) then
1722
1723# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1724
1725# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1726#if defined(MFC_OpenACC)
1727# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1728!$acc parallel loop collapse(3) gang vector default(present)
1729# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1730#elif defined(MFC_OpenMP)
1731# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1732
1733# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1734
1735# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1736
1737# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1738!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1739# 432 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1740#endif
1741# 433 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1742 do q = 0, p
1743 do l = 0, n
1744 do k = 0, m
1745 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1746 & q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dy_hypo(k, l, &
1747 & q) - q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dy_hypo(k, l, q) - (2._wp/3._wp)*g_k_field(k, &
1748 & l, q)*dv_dy_hypo(k, l, q))
1749
1750 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_k_field(k, &
1751 & l, q)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dx_hypo(k, l, &
1752 & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dy_hypo(k, l, q) + g_k_field(k, l, &
1753 & q)*(du_dy_hypo(k, l, q) + dv_dx_hypo(k, l, q)))
1754
1755 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_k_field(k, &
1756 & l, q)*(2._wp*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dx_hypo(k, l, &
1757 & q) - q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dx_hypo(k, l, &
1758 & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dv_dy_hypo(k, l, q) + 2._wp*g_k_field(k, l, &
1759 & q)*(dv_dy_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q))))
1760 end do
1761 end do
1762 end do
1763
1764# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1765#if defined(MFC_OpenACC)
1766# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1767!$acc end parallel loop
1768# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1769#elif defined(MFC_OpenMP)
1770# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1771
1772# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1773!$omp end target teams loop
1774# 454 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1775#endif
1776# 455 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1777 end if
1778
1779 if (ndirs == 3 .and. .not. cyl_coord) then
1780
1781# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1782
1783# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1784#if defined(MFC_OpenACC)
1785# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1786!$acc parallel loop collapse(3) gang vector default(present) private(txx, txy, tyy, txz, tyz, tzz, trace, shear, shear2, diag, diag_z, offdiag, cross1, cross2)
1787# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1788#elif defined(MFC_OpenMP)
1789# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1790
1791# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1792
1793# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1794
1795# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1796!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1797# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1798!$omp& private(txx, txy, tyy, txz, tyz, tzz, trace, shear, shear2, diag, diag_z, offdiag, cross1, cross2)
1799# 458 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1800#endif
1801# 460 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1802 do q = 0, p
1803 do l = 0, n
1804 do k = 0, m
1805 txx = q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)
1806 txy = q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)
1807 tyy = q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)
1808 txz = q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)
1809 tyz = q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)
1810 tzz = q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)
1811
1812 ! z-direction contributions to tau_xx
1813 trace = -(2._wp/3._wp*g_k_field(k, l, q) + txx)
1814 shear = 2._wp*txz
1815 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_k_field(k, l, &
1816 & q)*(trace*dw_dz_hypo(k, l, q) + shear*du_dz_hypo(k, l, q))
1817
1818 ! z-direction contributions to tau_xy
1819 offdiag = -txy
1820 cross1 = tyz
1821 cross2 = txz
1822 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_k_field(k, &
1823 & l, q)*(offdiag*dw_dz_hypo(k, l, q) + cross1*du_dz_hypo(k, l, q) + cross2*dv_dz_hypo(k, l, q))
1824
1825 ! z-direction contributions to tau_yy
1826 trace = -(2._wp/3._wp*g_k_field(k, l, q) + tyy)
1827 shear = 2._wp*tyz
1828 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_k_field(k, &
1829 & l, q)*(trace*dw_dz_hypo(k, l, q) + shear*dv_dz_hypo(k, l, q))
1830
1831 ! tau_xz (stress%beg+3)
1832 diag = g_k_field(k, l, q) + txx
1833 offdiag = -txz
1834 cross1 = tyz
1835 cross2 = txy
1836 diag_z = g_k_field(k, l, q) + tzz
1837 rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_k_field(k, &
1838 & l, q)*(diag*dw_dx_hypo(k, l, q) + offdiag*dv_dy_hypo(k, l, q) + cross1*du_dy_hypo(k, l, &
1839 & q) + cross2*dw_dy_hypo(k, l, q) + diag_z*du_dz_hypo(k, l, q))
1840
1841 ! tau_yz (stress%beg+4)
1842 offdiag = -tyz
1843 cross1 = txz
1844 cross2 = txy
1845 diag = g_k_field(k, l, q) + tyy
1846 rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) + rho_k_field(k, &
1847 & l, q)*(offdiag*du_dx_hypo(k, l, q) + cross1*dv_dx_hypo(k, l, q) + cross2*dw_dx_hypo(k, l, &
1848 & q) + diag*dw_dy_hypo(k, l, q) + diag_z*dv_dz_hypo(k, l, q))
1849
1850 ! tau_zz (stress%beg+5)
1851 trace = -(2._wp/3._wp*g_k_field(k, l, q) + tzz)
1852 shear = 2._wp*txz
1853 shear2 = 2._wp*tyz
1854 diag = 4._wp/3._wp*g_k_field(k, l, q) + tzz
1855 rhs_vf(eqn_idx%stress%beg + 5)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 5)%sf(k, l, q) + rho_k_field(k, &
1856 & l, q)*(trace*du_dx_hypo(k, l, q) + shear*dw_dx_hypo(k, l, q) + trace*dv_dy_hypo(k, l, &
1857 & q) + shear2*dw_dy_hypo(k, l, q) + diag*dw_dz_hypo(k, l, q))
1858 end do
1859 end do
1860 end do
1861
1862# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1863#if defined(MFC_OpenACC)
1864# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1865!$acc end parallel loop
1866# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1867#elif defined(MFC_OpenMP)
1868# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1869
1870# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1871!$omp end target teams loop
1872# 519 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1873#endif
1874# 520 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1875 end if
1876
1877 if (grid_geometry == 2) then
1878 call s_compute_hypoelastic_rhs_axisym_geom_iface(q_prim_vf, rhs_vf, nc_iface_vel_n(1)%vf, nc_iface_vel_n(2)%vf)
1879 end if
1880
1881 end subroutine s_compute_hypoelastic_rhs_iface
1882
1883 !> Axisymmetric geometric source terms for the hypoelastic stress evolution, using interface velocities. Adds the v/r and div(u)
1884 !! contributions that arise in cylindrical (r-z) coordinates: tau_xx, tau_xr, tau_rr get a -rho*(v/r) source; tau_thetatheta
1885 !! gets a combined divergence and hoop-stress source. Called from s_compute_hypoelastic_rhs_iface when grid_geometry == 2.
1886 !! @param q_prim_vf Primitive variables
1887 !! @param rhs_vf rhs variables
1888 !! @param nc_iface_vel_x_vf Interface velocities in x-direction
1889 !! @param nc_iface_vel_y_vf Interface velocities in y-direction
1890 subroutine s_compute_hypoelastic_rhs_axisym_geom_iface(q_prim_vf, rhs_vf, nc_iface_vel_x_vf, nc_iface_vel_y_vf)
1891
1892 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1893 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
1894 type(scalar_field), dimension(:), intent(in) :: nc_iface_vel_x_vf
1895 type(scalar_field), dimension(:), intent(in) :: nc_iface_vel_y_vf
1896 integer :: i, k, l, q
1897 real(wp) :: rho_k, g_k, v_over_r, divu_axi
1898
1899
1900# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1901
1902# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1903#if defined(MFC_OpenACC)
1904# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1905!$acc parallel loop collapse(3) gang vector default(present)
1906# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1907#elif defined(MFC_OpenMP)
1908# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1909
1910# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1911
1912# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1913
1914# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1915!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
1916# 544 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1917#endif
1918# 545 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1919 do q = 0, p
1920 do l = 0, n
1921 do k = 0, m
1922 du_dx_hypo(k, l, q) = (nc_iface_vel_x_vf(1)%sf(k, l, q) - nc_iface_vel_x_vf(1)%sf(k - 1, l, q))/dx(k)
1923
1924 dv_dy_hypo(k, l, q) = (nc_iface_vel_y_vf(2)%sf(k, l, q) - nc_iface_vel_y_vf(2)%sf(k, l - 1, q))/dy(l)
1925 end do
1926 end do
1927 end do
1928
1929# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1930#if defined(MFC_OpenACC)
1931# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1932!$acc end parallel loop
1933# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1934#elif defined(MFC_OpenMP)
1935# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1936
1937# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1938!$omp end target teams loop
1939# 554 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1940#endif
1941# 555 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1942
1943
1944# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1945
1946# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1947#if defined(MFC_OpenACC)
1948# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1949!$acc parallel loop collapse(3) gang vector default(present) private(rho_K, G_K, v_over_r, divU_axi)
1950# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1951#elif defined(MFC_OpenMP)
1952# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1953
1954# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1955
1956# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1957
1958# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1959!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1960# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1961!$omp& private(rho_K, G_K, v_over_r, divU_axi)
1962# 556 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1963#endif
1964# 557 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1965 do q = 0, p
1966 do l = 0, n
1967 do k = 0, m
1968 rho_k = 0._wp
1969 g_k = 0._wp
1970 do i = 1, num_fluids
1971 rho_k = rho_k + q_prim_vf(i)%sf(k, l, q)
1972 g_k = g_k + q_prim_vf(eqn_idx%adv%beg - 1 + i)%sf(k, l, q)*gs_hypo(i)
1973 end do
1974
1975 if (cont_damage) g_k = g_k*max(1._wp - q_prim_vf(eqn_idx%damage)%sf(k, l, q), 0._wp)
1976
1977 v_over_r = q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)
1978 divu_axi = du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q) + v_over_r
1979
1980 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, &
1981 & q) - rho_k*v_over_r*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q) + 2._wp*g_k/3._wp)
1982
1983 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, &
1984 & q) - rho_k*v_over_r*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)
1985
1986 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, &
1987 & q) - rho_k*v_over_r*(q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + 2._wp*g_k/3._wp)
1988
1989 rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, &
1990 & q) + rho_k*(-(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, &
1991 & q) + 2._wp*g_k/3._wp)*divu_axi + 2._wp*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + g_k)*v_over_r)
1992 end do
1993 end do
1994 end do
1995
1996# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1997#if defined(MFC_OpenACC)
1998# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
1999!$acc end parallel loop
2000# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2001#elif defined(MFC_OpenMP)
2002# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2003
2004# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2005!$omp end target teams loop
2006# 587 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2007#endif
2008# 588 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2009
2010 end subroutine s_compute_hypoelastic_rhs_axisym_geom_iface
2011
2012 !> Cylindrical completion for the dual-pass (anchored HLLD) hypoelastic path. The anchored augmented fluxes already carry every
2013 !! axial/radial derivative term of the stress law and the stress rows of flux_gsrc are zero, so the complete remaining
2014 !! cylindrical physics is the cell-local v/r family below: the advective metric -q_s*v/r plus the constitutive v/r terms (and
2015 !! +/-K*C for the volume fractions under alt_soundspeed). The discrete C = v/r averages the cell's own two anchored radial face
2016 !! traces (hat_L outer face, hat_R inner face) over y_cc, so no absolute axial velocity enters and uniform axial translation
2017 !! gives exactly zero. Called once after the two anchored partial RHS's are summed. Continuum damage needs no handling here:
2018 !! HLLD + cont_damage is prohibited (m_checker.fpp).
2019 !! @param q_prim_vf Primitive variables
2020 !! @param rhs_vf rhs variables
2021 !! @param nc_iface_vel_y_vf hat_L-pass radial-direction interface velocities
2022 !! @param nc_iface_vel_y_hatR_vf hat_R-pass radial-direction interface velocities
2023 subroutine s_compute_hypoelastic_rhs_axisym_geom_dual_pass(q_prim_vf, rhs_vf, nc_iface_vel_y_vf, nc_iface_vel_y_hatR_vf)
2024
2025 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
2026 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
2027 type(scalar_field), dimension(:), intent(in) :: nc_iface_vel_y_vf
2028 type(scalar_field), dimension(:), intent(in) :: nc_iface_vel_y_hatr_vf
2029 real(wp) :: rho_k, g_k, k_k, c_num, pres_k, blkmod1_k, blkmod2_k, alpha_k, alpha_rho_k
2030 integer :: i, k, l, q
2031
2032
2033# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2034
2035# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2036#if defined(MFC_OpenACC)
2037# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2038!$acc parallel loop collapse(3) gang vector default(present) private(rho_K, G_K, K_K, C_num, pres_K, blkmod1_K, blkmod2_K, alpha_K, alpha_rho_K)
2039# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2040#elif defined(MFC_OpenMP)
2041# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2042
2043# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2044
2045# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2046
2047# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2048!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2049# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2050!$omp& private(rho_K, G_K, K_K, C_num, pres_K, blkmod1_K, blkmod2_K, alpha_K, alpha_rho_K)
2051# 611 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2052#endif
2053# 612 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2054 do q = 0, p
2055 do l = 0, n
2056 do k = 0, m
2057 rho_k = 0._wp
2058 g_k = 0._wp
2059
2060# 617 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2061#if defined(MFC_OpenACC)
2062# 617 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2063!$acc loop seq
2064# 617 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2065#elif defined(MFC_OpenMP)
2066# 617 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2067
2068# 617 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2069#endif
2070# 618 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2071 do i = 1, num_fluids
2072 rho_k = rho_k + q_prim_vf(i)%sf(k, l, q)
2073 g_k = g_k + q_prim_vf(eqn_idx%adv%beg - 1 + i)%sf(k, l, q)*gs_hypo(i)
2074 end do
2075
2076 if (g_k < verysmall) g_k = 0._wp
2077
2078 ! Cell-owned anchored radial face traces: hat_L owns the outer face l, hat_R the inner face l - 1
2079 c_num = 5e-1_wp*(nc_iface_vel_y_vf(2)%sf(k, l, q) + nc_iface_vel_y_hatr_vf(2)%sf(k, l - 1, q))/y_cc(l)
2080
2081 if (alt_soundspeed) then
2082 ! Same two-component K as the HLLD anchor state (see m_riemann_solver_hypo_hlld.fpp), including the
2083 ! verysmall denominator regularization
2084 pres_k = q_prim_vf(eqn_idx%E)%sf(k, l, q)
2085 alpha_k = q_prim_vf(eqn_idx%adv%beg)%sf(k, l, q)
2086 alpha_rho_k = q_prim_vf(eqn_idx%cont%beg)%sf(k, l, q)
2087 call s_phase_bulk_modulus(pres_k, alpha_k, alpha_rho_k, 1, blkmod1_k)
2088 alpha_k = q_prim_vf(eqn_idx%adv%end)%sf(k, l, q)
2089 alpha_rho_k = q_prim_vf(eqn_idx%cont%end)%sf(k, l, q)
2090 call s_phase_bulk_modulus(pres_k, alpha_k, alpha_rho_k, 2, blkmod2_k)
2091 blkmod1_k = blkmod1_k + (4._wp/3._wp)*gs_hypo(1)
2092 blkmod2_k = blkmod2_k + (4._wp/3._wp)*gs_hypo(2)
2093 k_k = q_prim_vf(eqn_idx%adv%beg)%sf(k, l, q)*q_prim_vf(eqn_idx%adv%end)%sf(k, l, &
2094 & q)*(blkmod2_k - blkmod1_k)/(q_prim_vf(eqn_idx%adv%beg)%sf(k, l, &
2095 & q)*blkmod2_k + q_prim_vf(eqn_idx%adv%end)%sf(k, l, q)*blkmod1_k + verysmall)
2096 rhs_vf(eqn_idx%adv%beg)%sf(k, l, q) = rhs_vf(eqn_idx%adv%beg)%sf(k, l, q) + k_k*c_num
2097 rhs_vf(eqn_idx%adv%end)%sf(k, l, q) = rhs_vf(eqn_idx%adv%end)%sf(k, l, q) - k_k*c_num
2098 end if
2099
2100 rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, &
2101 & q) - rho_k*(2._wp*q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q) + 2._wp*g_k/3._wp)*c_num
2102
2103 rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, &
2104 & q) - 2._wp*rho_k*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*c_num
2105
2106 rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, &
2107 & q) - rho_k*(2._wp*q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + 2._wp*g_k/3._wp)*c_num
2108
2109 rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, &
2110 & q) + (4._wp/3._wp)*rho_k*g_k*c_num
2111 end do
2112 end do
2113 end do
2114
2115# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2116#if defined(MFC_OpenACC)
2117# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2118!$acc end parallel loop
2119# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2120#elif defined(MFC_OpenMP)
2121# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2122
2123# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2124!$omp end target teams loop
2125# 661 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2126#endif
2127# 662 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2128
2129 end subroutine s_compute_hypoelastic_rhs_axisym_geom_dual_pass
2130
2131 !> Finalize the hypoelastic module
2132 impure subroutine s_finalize_hypoelastic_module()
2133
2134#ifdef MFC_DEBUG
2135# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2136 block
2137# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2138 use iso_fortran_env, only: output_unit
2139# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2140
2141# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2142 print *, 'm_hypoelastic.fpp:668: ', '@:DEALLOCATE(Gs_hypo)'
2143# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2144
2145# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2146 call flush (output_unit)
2147# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2148 end block
2149# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2150#endif
2151# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2152
2153# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2154#if defined(MFC_OpenACC)
2155# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2156!$acc exit data delete(Gs_hypo)
2157# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2158#elif defined(MFC_OpenMP)
2159# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2160!$omp target exit data map(release:Gs_hypo)
2161# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2162#endif
2163# 668 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2164 deallocate (gs_hypo)
2165# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2166#ifdef MFC_DEBUG
2167# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2168 block
2169# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2170 use iso_fortran_env, only: output_unit
2171# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2172
2173# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2174 print *, 'm_hypoelastic.fpp:669: ', '@:DEALLOCATE(rho_K_field, G_K_field)'
2175# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2176
2177# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2178 call flush (output_unit)
2179# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2180 end block
2181# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2182#endif
2183# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2184
2185# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2186#if defined(MFC_OpenACC)
2187# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2188!$acc exit data delete(rho_K_field, G_K_field)
2189# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2190#elif defined(MFC_OpenMP)
2191# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2192!$omp target exit data map(release:rho_K_field, G_K_field)
2193# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2194#endif
2195# 669 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2196 deallocate (rho_k_field, g_k_field)
2197# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2198#ifdef MFC_DEBUG
2199# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2200 block
2201# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2202 use iso_fortran_env, only: output_unit
2203# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2204
2205# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2206 print *, 'm_hypoelastic.fpp:670: ', '@:DEALLOCATE(du_dx_hypo)'
2207# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2208
2209# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2210 call flush (output_unit)
2211# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2212 end block
2213# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2214#endif
2215# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2216
2217# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2218#if defined(MFC_OpenACC)
2219# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2220!$acc exit data delete(du_dx_hypo)
2221# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2222#elif defined(MFC_OpenMP)
2223# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2224!$omp target exit data map(release:du_dx_hypo)
2225# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2226#endif
2227# 670 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2228 deallocate (du_dx_hypo)
2229# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2230#ifdef MFC_DEBUG
2231# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2232 block
2233# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2234 use iso_fortran_env, only: output_unit
2235# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2236
2237# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2238 print *, 'm_hypoelastic.fpp:671: ', '@:DEALLOCATE(fd_coeff_x_hypo)'
2239# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2240
2241# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2242 call flush (output_unit)
2243# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2244 end block
2245# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2246#endif
2247# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2248
2249# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2250#if defined(MFC_OpenACC)
2251# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2252!$acc exit data delete(fd_coeff_x_hypo)
2253# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2254#elif defined(MFC_OpenMP)
2255# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2256!$omp target exit data map(release:fd_coeff_x_hypo)
2257# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2258#endif
2259# 671 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2260 deallocate (fd_coeff_x_hypo)
2261# 672 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2262 if (n > 0) then
2263#ifdef MFC_DEBUG
2264# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2265 block
2266# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2267 use iso_fortran_env, only: output_unit
2268# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2269
2270# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2271 print *, 'm_hypoelastic.fpp:673: ', '@:DEALLOCATE(du_dy_hypo, dv_dx_hypo, dv_dy_hypo)'
2272# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2273
2274# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2275 call flush (output_unit)
2276# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2277 end block
2278# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2279#endif
2280# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2281
2282# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2283#if defined(MFC_OpenACC)
2284# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2285!$acc exit data delete(du_dy_hypo, dv_dx_hypo, dv_dy_hypo)
2286# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2287#elif defined(MFC_OpenMP)
2288# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2289!$omp target exit data map(release:du_dy_hypo, dv_dx_hypo, dv_dy_hypo)
2290# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2291#endif
2292# 673 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2293 deallocate (du_dy_hypo, dv_dx_hypo, dv_dy_hypo)
2294# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2295#ifdef MFC_DEBUG
2296# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2297 block
2298# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2299 use iso_fortran_env, only: output_unit
2300# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2301
2302# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2303 print *, 'm_hypoelastic.fpp:674: ', '@:DEALLOCATE(fd_coeff_y_hypo)'
2304# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2305
2306# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2307 call flush (output_unit)
2308# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2309 end block
2310# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2311#endif
2312# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2313
2314# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2315#if defined(MFC_OpenACC)
2316# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2317!$acc exit data delete(fd_coeff_y_hypo)
2318# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2319#elif defined(MFC_OpenMP)
2320# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2321!$omp target exit data map(release:fd_coeff_y_hypo)
2322# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2323#endif
2324# 674 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2325 deallocate (fd_coeff_y_hypo)
2326# 675 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2327 if (p > 0) then
2328#ifdef MFC_DEBUG
2329# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2330 block
2331# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2332 use iso_fortran_env, only: output_unit
2333# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2334
2335# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2336 print *, 'm_hypoelastic.fpp:676: ', '@:DEALLOCATE(du_dz_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)'
2337# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2338
2339# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2340 call flush (output_unit)
2341# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2342 end block
2343# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2344#endif
2345# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2346
2347# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2348#if defined(MFC_OpenACC)
2349# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2350!$acc exit data delete(du_dz_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
2351# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2352#elif defined(MFC_OpenMP)
2353# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2354!$omp target exit data map(release:du_dz_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
2355# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2356#endif
2357# 676 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2358 deallocate (du_dz_hypo, dv_dz_hypo, dw_dx_hypo, dw_dy_hypo, dw_dz_hypo)
2359# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2360#ifdef MFC_DEBUG
2361# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2362 block
2363# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2364 use iso_fortran_env, only: output_unit
2365# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2366
2367# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2368 print *, 'm_hypoelastic.fpp:677: ', '@:DEALLOCATE(fd_coeff_z_hypo)'
2369# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2370
2371# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2372 call flush (output_unit)
2373# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2374 end block
2375# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2376#endif
2377# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2378
2379# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2380#if defined(MFC_OpenACC)
2381# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2382!$acc exit data delete(fd_coeff_z_hypo)
2383# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2384#elif defined(MFC_OpenMP)
2385# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2386!$omp target exit data map(release:fd_coeff_z_hypo)
2387# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2388#endif
2389# 677 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2390 deallocate (fd_coeff_z_hypo)
2391# 678 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2392 end if
2393 end if
2394
2395 end subroutine s_finalize_hypoelastic_module
2396
2397 !> Maximum eigenvalue of the symmetric 2x2 matrix [[a, b], [b, c]]
2398 pure function f_max_eig_sym2x2(a, b, c) result(eig_max)
2399
2400
2401# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2402#if MFC_OpenACC
2403# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2404!$acc routine seq
2405# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2406#elif MFC_OpenMP
2407# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2408
2409# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2410
2411# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2412!$omp declare target device_type(any)
2413# 686 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2414#endif
2415# 687 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2416 real(wp), intent(in) :: a, b, c
2417 real(wp) :: eig_max
2418
2419 eig_max = 0.5_wp*(a + c) + sqrt((0.5_wp*(a - c))**2._wp + b*b)
2420
2421 end function f_max_eig_sym2x2
2422
2423 !> Maximum eigenvalue of a symmetric 3x3 matrix via the trigonometric closed form on its invariants; the acos argument is
2424 !! clamped and hydrostatic/repeated-eigenvalue states fall back to I1/3 to avoid 0/0
2425 pure function f_max_eig_sym3x3(t_xx, t_xy, t_yy, t_xz, t_yz, t_zz) result(eig_max)
2426
2427
2428# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2429#if MFC_OpenACC
2430# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2431!$acc routine seq
2432# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2433#elif MFC_OpenMP
2434# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2435
2436# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2437
2438# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2439!$omp declare target device_type(any)
2440# 698 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2441#endif
2442# 699 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2443 real(wp), intent(in) :: t_xx, t_xy, t_yy, t_xz, t_yz, t_zz
2444 real(wp) :: eig_max
2445 real(wp) :: i1, i2, i3, sqrt_term, argument
2446
2447 i1 = t_xx + t_yy + t_zz
2448 i2 = t_xx*t_yy + t_xx*t_zz + t_yy*t_zz - (t_xy**2._wp + t_xz**2._wp + t_yz**2._wp)
2449 i3 = t_xx*t_yy*t_zz + 2._wp*t_xy*t_xz*t_yz - t_xx*t_yz**2._wp - t_yy*t_xz**2._wp - t_zz*t_xy**2._wp
2450
2451 sqrt_term = sqrt(max(i1*i1 - 3._wp*i2, 0._wp))
2452 if (sqrt_term > verysmall) then
2453 argument = (2._wp*i1*i1*i1 - 9._wp*i1*i2 + 27._wp*i3)/(2._wp*sqrt_term*sqrt_term*sqrt_term)
2454 if (argument > 1._wp) argument = 1._wp
2455 if (argument < -1._wp) argument = -1._wp
2456 eig_max = i1/3._wp + (2._wp/3._wp)*sqrt_term*cos(acos(argument)/3._wp)
2457 else
2458 eig_max = i1/3._wp
2459 end if
2460
2461 end function f_max_eig_sym3x3
2462
2463 !> Accumulate the continuum damage source: the overstress rate on the maximum principal Cauchy stress sigma = -p I + tau_e (full
2464 !! 3D principal set in every dimensionality), weighted by the damageable-solid partial mass
2465 subroutine s_compute_damage_state(q_cons_vf, q_prim_vf, rhs_vf)
2466
2467 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
2468 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
2469 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
2470 real(wp) :: sigma_p !< maximum principal Cauchy stress
2471 real(wp) :: pres, solid_partial_density
2472 real(wp) :: tau_xx, tau_xy, tau_yy, tau_xz, tau_yz, tau_zz
2473 integer :: q, l, k, i
2474
2475
2476# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2477
2478# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2479#if defined(MFC_OpenACC)
2480# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2481!$acc parallel loop collapse(3) gang vector default(present) private(sigma_p, pres, solid_partial_density, tau_xx, tau_xy, tau_yy, tau_xz, tau_yz, tau_zz)
2482# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2483#elif defined(MFC_OpenMP)
2484# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2485
2486# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2487
2488# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2489
2490# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2491!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2492# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2493!$omp& private(sigma_p, pres, solid_partial_density, tau_xx, tau_xy, tau_yy, tau_xz, tau_yz, tau_zz)
2494# 731 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2495#endif
2496# 733 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2497 do q = 0, p
2498 do l = 0, n
2499 do k = 0, m
2500 ! Damageable-solid partial mass
2501 solid_partial_density = 0._wp
2502
2503# 738 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2504#if defined(MFC_OpenACC)
2505# 738 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2506!$acc loop seq
2507# 738 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2508#elif defined(MFC_OpenMP)
2509# 738 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2510
2511# 738 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2512#endif
2513# 739 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2514 do i = 1, num_fluids
2515 if (gs_hypo(i) > verysmall) then
2516 solid_partial_density = solid_partial_density + q_cons_vf(eqn_idx%cont%beg + i - 1)%sf(k, l, q)
2517 end if
2518 end do
2519
2520 if (solid_partial_density > verysmall .and. q_prim_vf(eqn_idx%damage)%sf(k, l, q) < 1._wp) then
2521 pres = q_prim_vf(eqn_idx%E)%sf(k, l, q)
2522 tau_xx = q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)
2523
2524 if (n == 0) then
2525 ! Transverse deviatoric components are -tau_xx/2 (traceless closure)
2526 sigma_p = -pres + max(tau_xx, -0.5_wp*tau_xx)
2527 else if (p == 0) then
2528 tau_xy = q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)
2529 tau_yy = q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)
2530 if (cyl_coord) then
2531 ! Out-of-plane principal component is the stored hoop stress
2532 tau_zz = q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)
2533 else
2534 ! Out-of-plane deviatoric component from the traceless closure
2535 tau_zz = -(tau_xx + tau_yy)
2536 end if
2537 sigma_p = -pres + max(f_max_eig_sym2x2(tau_xx, tau_xy, tau_yy), tau_zz)
2538 else
2539 tau_xy = q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)
2540 tau_yy = q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)
2541 tau_xz = q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)
2542 tau_yz = q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)
2543 tau_zz = q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)
2544 sigma_p = -pres + f_max_eig_sym3x3(tau_xx, tau_xy, tau_yy, tau_xz, tau_yz, tau_zz)
2545 end if
2546
2547 if (sigma_p > tau_star) then
2548 rhs_vf(eqn_idx%damage)%sf(k, l, q) = rhs_vf(eqn_idx%damage)%sf(k, l, &
2549 & q) + solid_partial_density*(alpha_bar*(sigma_p - tau_star))**cont_damage_s
2550 end if
2551 end if
2552 end do
2553 end do
2554 end do
2555
2556# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2557#if defined(MFC_OpenACC)
2558# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2559!$acc end parallel loop
2560# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2561#elif defined(MFC_OpenMP)
2562# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2563
2564# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2565!$omp end target teams loop
2566# 780 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2567#endif
2568# 781 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2569
2570 end subroutine s_compute_damage_state
2571
2572 !> Project the conservative continuum-damage carrier onto 0 <= U_D <= m_s.
2573 subroutine s_enforce_cont_damage_bounds(q_cons_vf)
2574
2575 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
2576 real(stp) :: solid_partial_density
2577 integer :: q, l, k, i
2578
2579
2580# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2581
2582# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2583#if defined(MFC_OpenACC)
2584# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2585!$acc parallel loop collapse(3) gang vector default(present) private(solid_partial_density)
2586# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2587#elif defined(MFC_OpenMP)
2588# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2589
2590# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2591
2592# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2593
2594# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2595!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2596# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2597!$omp& private(solid_partial_density)
2598# 791 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2599#endif
2600# 792 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2601 do q = 0, p
2602 do l = 0, n
2603 do k = 0, m
2604 ! Damageable-solid partial mass
2605 solid_partial_density = 0._stp
2606
2607# 797 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2608#if defined(MFC_OpenACC)
2609# 797 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2610!$acc loop seq
2611# 797 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2612#elif defined(MFC_OpenMP)
2613# 797 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2614
2615# 797 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2616#endif
2617# 798 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2618 do i = 1, num_fluids
2619 if (gs_hypo(i) > verysmall) then
2620 solid_partial_density = solid_partial_density + q_cons_vf(eqn_idx%cont%beg + i - 1)%sf(k, l, q)
2621 end if
2622 end do
2623 solid_partial_density = max(solid_partial_density, 0._stp)
2624 q_cons_vf(eqn_idx%damage)%sf(k, l, q) = min(max(q_cons_vf(eqn_idx%damage)%sf(k, l, q), 0._stp), &
2625 & solid_partial_density)
2626 end do
2627 end do
2628 end do
2629
2630# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2631#if defined(MFC_OpenACC)
2632# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2633!$acc end parallel loop
2634# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2635#elif defined(MFC_OpenMP)
2636# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2637
2638# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2639!$omp end target teams loop
2640# 809 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2641#endif
2642# 810 "/home/runner/work/MFC/MFC/src/simulation/m_hypoelastic.fpp"
2643
2644 end subroutine s_enforce_cont_damage_bounds
2645
2646end module m_hypoelastic
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1041
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1043
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1043
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:402
m_eos::s_phase_bulk_modulus
subroutine, public s_phase_bulk_modulus(pres, alpha, alpha_rho, i, blkmod)
Bulk modulus rho c^2 of phase i at pressure pres: f_bulk_modulus for a constant-coefficient fluid,...
Definition m_eos.fpp.f90:1784
m_finite_differences
Finite difference operators for computing divergence of velocity fields.
Definition m_finite_differences.fpp.f90:356
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:367
m_hypoelastic
Computes hypoelastic stress-rate source terms and damage-state evolution.
Definition m_hypoelastic.fpp.f90:356
m_hypoelastic::fd_coeff_x_hypo
real(wp), dimension(:,:), allocatable fd_coeff_x_hypo
Definition m_hypoelastic.fpp.f90:415
m_hypoelastic::gs_hypo
real(wp), dimension(:), allocatable gs_hypo
Definition m_hypoelastic.fpp.f90:371
m_hypoelastic::f_max_eig_sym2x2
pure real(wp) function f_max_eig_sym2x2(a, b, c)
Maximum eigenvalue of the symmetric 2x2 matrix [[a, b], [b, c]].
Definition m_hypoelastic.fpp.f90:2399
m_hypoelastic::fd_coeff_y_hypo
real(wp), dimension(:,:), allocatable fd_coeff_y_hypo
Definition m_hypoelastic.fpp.f90:416
m_hypoelastic::dv_dz_hypo
real(wp), dimension(:,:,:), allocatable dv_dz_hypo
Definition m_hypoelastic.fpp.f90:386
m_hypoelastic::dv_dy_hypo
real(wp), dimension(:,:,:), allocatable dv_dy_hypo
Definition m_hypoelastic.fpp.f90:386
m_hypoelastic::s_compute_damage_state
subroutine, public s_compute_damage_state(q_cons_vf, q_prim_vf, rhs_vf)
Accumulate the continuum damage source: the overstress rate on the maximum principal Cauchy stress si...
Definition m_hypoelastic.fpp.f90:2466
m_hypoelastic::dw_dz_hypo
real(wp), dimension(:,:,:), allocatable dw_dz_hypo
Definition m_hypoelastic.fpp.f90:387
m_hypoelastic::s_compute_hypoelastic_rhs_iface
subroutine, public s_compute_hypoelastic_rhs_iface(q_prim_vf, rhs_vf, nc_iface_vel_n)
Interface-consistent hypoelastic RHS (Mode 2: HLL/HLLC). Uses interface velocities from the Riemann s...
Definition m_hypoelastic.fpp.f90:1475
m_hypoelastic::du_dx_hypo
real(wp), dimension(:,:,:), allocatable du_dx_hypo
Definition m_hypoelastic.fpp.f90:385
m_hypoelastic::s_compute_hypoelastic_rhs_finite_diff_per_sweep
subroutine, public s_compute_hypoelastic_rhs_finite_diff_per_sweep(idir, q_prim_vf, rhs_vf)
Legacy FD-based hypoelastic RHS (Mode 1: HLL). Uses finite-difference velocity gradients computed fro...
Definition m_hypoelastic.fpp.f90:837
m_hypoelastic::f_max_eig_sym3x3
pure real(wp) function f_max_eig_sym3x3(t_xx, t_xy, t_yy, t_xz, t_yz, t_zz)
Maximum eigenvalue of a symmetric 3x3 matrix via the trigonometric closed form on its invariants; the...
Definition m_hypoelastic.fpp.f90:2426
m_hypoelastic::dw_dx_hypo
real(wp), dimension(:,:,:), allocatable dw_dx_hypo
Definition m_hypoelastic.fpp.f90:387
m_hypoelastic::s_compute_hypoelastic_rhs_axisym_geom_dual_pass
subroutine, public s_compute_hypoelastic_rhs_axisym_geom_dual_pass(q_prim_vf, rhs_vf, nc_iface_vel_y_vf, nc_iface_vel_y_hatr_vf)
Cylindrical completion for the dual-pass (anchored HLLD) hypoelastic path. The anchored augmented flu...
Definition m_hypoelastic.fpp.f90:2024
m_hypoelastic::du_dz_hypo
real(wp), dimension(:,:,:), allocatable du_dz_hypo
Definition m_hypoelastic.fpp.f90:385
m_hypoelastic::s_enforce_cont_damage_bounds
subroutine, public s_enforce_cont_damage_bounds(q_cons_vf)
Project the conservative continuum-damage carrier onto 0 <= U_D <= m_s.
Definition m_hypoelastic.fpp.f90:2574
m_hypoelastic::dv_dx_hypo
real(wp), dimension(:,:,:), allocatable dv_dx_hypo
Definition m_hypoelastic.fpp.f90:386
m_hypoelastic::fd_coeff_z_hypo
real(wp), dimension(:,:), allocatable fd_coeff_z_hypo
Definition m_hypoelastic.fpp.f90:417
m_hypoelastic::g_k_field
real(wp), dimension(:,:,:), allocatable g_k_field
Definition m_hypoelastic.fpp.f90:401
m_hypoelastic::du_dy_hypo
real(wp), dimension(:,:,:), allocatable du_dy_hypo
Definition m_hypoelastic.fpp.f90:385
m_hypoelastic::dw_dy_hypo
real(wp), dimension(:,:,:), allocatable dw_dy_hypo
Definition m_hypoelastic.fpp.f90:387
m_hypoelastic::s_initialize_hypoelastic_module
impure subroutine, public s_initialize_hypoelastic_module
Initialize the hypoelastic module.
Definition m_hypoelastic.fpp.f90:435
m_hypoelastic::s_compute_hypoelastic_rhs_axisym_geom_iface
subroutine, public s_compute_hypoelastic_rhs_axisym_geom_iface(q_prim_vf, rhs_vf, nc_iface_vel_x_vf, nc_iface_vel_y_vf)
Axisymmetric geometric source terms for the hypoelastic stress evolution, using interface velocities....
Definition m_hypoelastic.fpp.f90:1891
m_hypoelastic::s_finalize_hypoelastic_module
impure subroutine, public s_finalize_hypoelastic_module()
Finalize the hypoelastic module.
Definition m_hypoelastic.fpp.f90:2133
m_hypoelastic::rho_k_field
real(wp), dimension(:,:,:), allocatable rho_k_field
Definition m_hypoelastic.fpp.f90:401