FE-Project
Loading...
Searching...
No Matches
scale_meshfield_fvm_util.F90
Go to the documentation of this file.
1
9#include "scaleFElib.h"
10module scale_meshfield_fvm_util
11 !-----------------------------------------------------------------------------
12 !
13 !++ used modules
14 !
15 use scale_precision
16 use scale_io
17
18 use scale_element_base, only: &
19 elementbase2d, elementbase3d
20 use scale_localmesh_2d, only: localmesh2d
21 use scale_localmesh_3d, only: localmesh3d
22
23 !-----------------------------------------------------------------------------
24 implicit none
25 private
26 !-----------------------------------------------------------------------------
27 !
28 !++ Public procedure
29 !
30 public :: meshfieldfvmutil_interp_fvtodg_3d
31 public :: meshfieldfvmutil_interp_fvtodg_2d
35 end interface
36 public :: meshfieldfvmutil_interp_fvtodg
37
38 !-----------------------------------------------------------------------------
39 !
40 !++ Public parameters & variables
41 !
42 !-----------------------------------------------------------------------------
43 !
44 !++ Private procedure
45 !
46
47 !-----------------------------------------------------------------------------
48 !
49 !++ Private parameters & variables
50 !
51 !-----------------------------------------------------------------------------
52
53contains
54
58!OCL SERIAL
59 subroutine meshfieldfvmutil_interp_fvtodg_3d( out_dg, &
60 in_fv, lcmesh3D, elem3D_, IS, IE, IA, IHALO, JS, JE, JA, JHALO, KS, KE, KA, KHALO, &
61 interp_ord, out_dg_flush_flag )
62 use scale_comm_cartesc, only: &
63 comm_vars8, &
64 comm_wait
65 implicit none
66 class(localmesh3d), intent(in) :: lcmesh3D
67 class(elementbase3d), intent(in) :: elem3D_
68 integer, intent(in) :: IS, IE, IA, IHALO
69 integer, intent(in) :: JS, JE, JA, JHALO
70 integer, intent(in) :: KS, KE, KA, KHALO
71 real(RP), intent(inout) :: out_dg(elem3D_%Np,lcmesh3D%NeA)
72 real(RP), intent(in) :: in_fv(KA,IA,JA)
73 integer, intent(in) :: interp_ord
74 logical, intent(in), optional :: out_dg_flush_flag
75
76 integer :: ke_x, ke_y, ke_z
77 integer :: i, j, k
78 integer :: kelem
79
80 real(RP) :: tend_fv_cp(KA,IA,JA)
81 real(RP) :: dqdx(KA,IA,JA), dqdy(KA,IA,JA), dqdz(KA,IA,JA)
82 real(RP) :: dqdxx(KA,IA,JA), dqdyy(KA,IA,JA), dqdzz(KA,IA,JA)
83 real(RP) :: dqdxy(KA,IA,JA), dqdxz(KA,IA,JA), dqdyz(KA,IA,JA)
84
85 logical :: out_dg_flush_flag_
86 !----------------------------------
87
88 if ( present(out_dg_flush_flag) ) then
89 out_dg_flush_flag_ = out_dg_flush_flag
90 else
91 out_dg_flush_flag_ = .true.
92 end if
93
94 tend_fv_cp(:,:,:) = in_fv(:,:,:)
95 if ( interp_ord > 0 ) then
96 call comm_vars8( tend_fv_cp(:,:,:), 1 )
97 call comm_wait( tend_fv_cp(:,:,:), 1, .true. )
98 end if
99
100 !$omp parallel private(ke_x,ke_y,ke_z,kelem, i,j,k)
101
102 if ( out_dg_flush_flag_ ) then
103 !$omp workshare
104 out_dg(:,:) = 0.0_rp
105 !$omp end workshare
106 end if
107
108 if ( interp_ord > 0 ) then
109 !$omp do collapse(2)
110 do j=js-1, je+1
111 do i=is, ie
112 do k=ks, ke
113 dqdx(k,i,j) = 0.25_rp * ( tend_fv_cp(k,i+1,j) - tend_fv_cp(k,i-1,j) )
114 enddo
115 enddo
116 enddo
117 !$omp do collapse(2)
118 do j=js, je
119 do i=is-1, ie+1
120 do k=ks, ke
121 dqdy(k,i,j) = 0.25_rp * ( tend_fv_cp(k,i,j+1) - tend_fv_cp(k,i,j-1) )
122 enddo
123 enddo
124 enddo
125 !$omp do collapse(2)
126 do j=js, je
127 do i=is, ie
128 do k=ks+1, ke-1
129 dqdz(k,i,j) = 0.25_rp * ( tend_fv_cp(k+1,i,j) - tend_fv_cp(k-1,i,j) )
130 enddo
131 dqdz(ks,i,j) = 0.25_rp * ( - tend_fv_cp(ks+2,i,j) + 4.0_rp * tend_fv_cp(ks+1,i,j) - 3.0_rp * tend_fv_cp(ks,i,j) )
132 dqdz(ke,i,j) = 0.25_rp * ( 3.0_rp * tend_fv_cp(ke,i,j) - 4.0_rp * tend_fv_cp(ke-1,i,j) + tend_fv_cp(ke-2,i,j) )
133 enddo
134 enddo
135 end if
136 if ( interp_ord > 1 ) then
137 !$omp do collapse(2)
138 do j=js, je
139 do i=is, ie
140 do k=ks, ke
141 dqdxx(k,i,j) = 0.25_rp * ( tend_fv_cp(k,i+1,j) - 2.0_rp * tend_fv_cp(k,i,j) + tend_fv_cp(k,i-1,j) )
142 enddo
143 enddo
144 enddo
145 !$omp do collapse(2)
146 do j=js, je
147 do i=is, ie
148 do k=ks, ke
149 dqdyy(k,i,j) = 0.25_rp * ( tend_fv_cp(k,i,j+1) - 2.0_rp * tend_fv_cp(k,i,j) + tend_fv_cp(k,i,j-1) )
150 enddo
151 enddo
152 enddo
153 !$omp do collapse(2)
154 do j=js, je
155 do i=is, ie
156 do k=ks, ke
157 dqdxy(k,i,j) = 0.25_rp * ( dqdx(k,i,j+1) - dqdx(k,i,j-1) )
158 enddo
159 enddo
160 enddo
161 !$omp do collapse(2)
162 do j=js, je
163 do i=is, ie
164 do k=ks+1, ke-1
165 dqdzz(k,i,j) = 0.25_rp * ( tend_fv_cp(k+1,i,j) - 2.0_rp * tend_fv_cp(k,i,j) + tend_fv_cp(k-1,i,j) )
166 dqdxz(k,i,j) = 0.25_rp * ( dqdx(k+1,i,j) - dqdx(k-1,i,j) )
167 dqdyz(k,i,j) = 0.25_rp * ( dqdy(k+1,i,j) - dqdy(k-1,i,j) )
168 enddo
169 dqdzz(ks,i,j) = dqdzz(ks+1,i,j); dqdzz(ke,i,j) = dqdzz(ke-1,i,j);
170 dqdxz(ks,i,j) = 0.5_rp * ( dqdx(ks+1,i,j) - dqdx(ks,i,j) ); dqdxz(ke,i,j) = 0.5_rp * ( dqdx(ke,i,j) - dqdx(ke-1,i,j) );
171 dqdyz(ks,i,j) = 0.5_rp * ( dqdy(ks+1,i,j) - dqdy(ks,i,j) ); dqdyz(ke,i,j) = 0.5_rp * ( dqdy(ke,i,j) - dqdy(ke-1,i,j) );
172 enddo
173 enddo
174 end if
175
176 select case(interp_ord)
177 case(0) !- Piecewise constant
178 !$omp do collapse(2)
179 do ke_z=1, lcmesh3d%NeZ
180 do ke_y=1, lcmesh3d%NeY
181 do ke_x=1, lcmesh3d%NeX
182 kelem = ke_x + (ke_y-1)*lcmesh3d%NeX + (ke_z-1)*lcmesh3d%NeX*lcmesh3d%NeY
183 i = ihalo + ke_x; j = jhalo + ke_y; k = khalo + ke_z
184 out_dg(:,kelem) = out_dg(:,kelem) &
185 + in_fv(k,i,j)
186 enddo
187 enddo
188 enddo
189 case(1) !- Piecewise linear reconstruction
190 !$omp do collapse(2)
191 do ke_z=1, lcmesh3d%NeZ
192 do ke_y=1, lcmesh3d%NeY
193 do ke_x=1, lcmesh3d%NeX
194 kelem = ke_x + (ke_y-1)*lcmesh3d%NeX + (ke_z-1)*lcmesh3d%NeX*lcmesh3d%NeY
195 i = ihalo + ke_x; j = jhalo + ke_y; k = khalo + ke_z
196 out_dg(:,kelem) = out_dg(:,kelem) &
197 + in_fv(k,i,j) &
198 + dqdx(k,i,j) * elem3d_%x1(:) &
199 + dqdy(k,i,j) * elem3d_%x2(:) &
200 + dqdz(k,i,j) * elem3d_%x3(:)
201 enddo
202 enddo
203 enddo
204 case(2) !- Piecewise quadratic reconstruction
205 !$omp do collapse(2)
206 do ke_z=1, lcmesh3d%NeZ
207 do ke_y=1, lcmesh3d%NeY
208 do ke_x=1, lcmesh3d%NeX
209 kelem = ke_x + (ke_y-1)*lcmesh3d%NeX + (ke_z-1)*lcmesh3d%NeX*lcmesh3d%NeY
210 i = ihalo + ke_x; j = jhalo + ke_y; k = khalo + ke_z
211 out_dg(:,kelem) = out_dg(:,kelem) &
212 + in_fv(k,i,j) &
213 + dqdx(k,i,j) * elem3d_%x1(:) &
214 + dqdy(k,i,j) * elem3d_%x2(:) &
215 + dqdz(k,i,j) * elem3d_%x3(:) &
216 + dqdxy(k,i,j) * elem3d_%x1(:) * elem3d_%x2(:) &
217 + dqdxz(k,i,j) * elem3d_%x1(:) * elem3d_%x3(:) &
218 + dqdyz(k,i,j) * elem3d_%x2(:) * elem3d_%x3(:) &
219 + 0.5_rp * dqdxx(k,i,j) * ( elem3d_%x1(:)**2 - 1.0_rp / 3.0_rp ) &
220 + 0.5_rp * dqdyy(k,i,j) * ( elem3d_%x2(:)**2 - 1.0_rp / 3.0_rp ) &
221 + 0.5_rp * dqdzz(k,i,j) * ( elem3d_%x3(:)**2 - 1.0_rp / 3.0_rp )
222 enddo
223 enddo
224 enddo
225 end select
226 !$omp end parallel
227 return
228 end subroutine meshfieldfvmutil_interp_fvtodg_3d
229
233!OCL SERIAL
234 subroutine meshfieldfvmutil_interp_fvtodg_2d( out_dg, &
235 in_fv, lcmesh2D, elem2D_, IS, IE, IA, IHALO, JS, JE, JA, JHALO, &
236 interp_ord, out_dg_flush_flag )
237 use scale_comm_cartesc, only: &
238 comm_vars8, &
239 comm_wait
240 implicit none
241 class(localmesh2d), intent(in) :: lcmesh2D
242 class(elementbase2d), intent(in) :: elem2D_
243 integer, intent(in) :: IS, IE, IA, IHALO
244 integer, intent(in) :: JS, JE, JA, JHALO
245 real(RP), intent(inout) :: out_dg(elem2D_%Np,lcmesh2D%NeA)
246 real(RP), intent(in) :: in_fv(IA,JA)
247 integer, intent(in) :: interp_ord
248 logical, intent(in), optional :: out_dg_flush_flag
249
250 integer :: ke_x, ke_y
251 integer :: i, j
252 integer :: kelem
253
254 real(RP) :: tend_fv_cp(IA,JA)
255 real(RP) :: dqdx(IA,JA), dqdy(IA,JA)
256 real(RP) :: dqdxx(IA,JA), dqdyy(IA,JA)
257 real(RP) :: dqdxy(IA,JA)
258
259 logical :: out_dg_flush_flag_
260 !----------------------------------
261
262 if ( present(out_dg_flush_flag) ) then
263 out_dg_flush_flag_ = out_dg_flush_flag
264 else
265 out_dg_flush_flag_ = .true.
266 end if
267
268 tend_fv_cp(:,:) = in_fv(:,:)
269 if ( interp_ord > 0 ) then
270 call comm_vars8( tend_fv_cp(:,:), 1 )
271 call comm_wait( tend_fv_cp(:,:), 1, .false. )
272 end if
273
274 !$omp parallel private(ke_x,ke_y,kelem, i,j)
275
276 if ( out_dg_flush_flag_ ) then
277 !$omp workshare
278 out_dg(:,:) = 0.0_rp
279 !$omp end workshare
280 end if
281
282 if ( interp_ord > 0 ) then
283 !$omp do
284 do j=js-1, je+1
285 do i=is, ie
286 dqdx(i,j) = 0.25_rp * ( tend_fv_cp(i+1,j) - tend_fv_cp(i-1,j) )
287 enddo
288 enddo
289 !$omp do
290 do j=js, je
291 do i=is-1, ie+1
292 dqdy(i,j) = 0.25_rp * ( tend_fv_cp(i,j+1) - tend_fv_cp(i,j-1) )
293 enddo
294 enddo
295 end if
296 if ( interp_ord > 1 ) then
297 !$omp do
298 do j=js, je
299 do i=is, ie
300 dqdxx(i,j) = 0.25_rp * ( tend_fv_cp(i+1,j) - 2.0_rp * tend_fv_cp(i,j) + tend_fv_cp(i-1,j) )
301 enddo
302 enddo
303 !$omp do
304 do j=js, je
305 do i=is, ie
306 dqdyy(i,j) = 0.25_rp * ( tend_fv_cp(i,j+1) - 2.0_rp * tend_fv_cp(i,j) + tend_fv_cp(i,j-1) )
307 enddo
308 enddo
309 !$omp do
310 do j=js, je
311 do i=is, ie
312 dqdxy(i,j) = 0.25_rp * ( dqdx(i,j+1) - dqdx(i,j-1) )
313 enddo
314 enddo
315 end if
316
317 select case(interp_ord)
318 case(0) !- Piecewise constant
319 !$omp do
320 do ke_y=1, lcmesh2d%NeY
321 do ke_x=1, lcmesh2d%NeX
322 kelem = ke_x + (ke_y-1)*lcmesh2d%NeX
323 i = ihalo + ke_x; j = jhalo + ke_y;
324 out_dg(:,kelem) = out_dg(:,kelem) &
325 + in_fv(i,j)
326 enddo
327 enddo
328 case(1) !- Piecewise linear reconstruction
329 !$omp do
330 do ke_y=1, lcmesh2d%NeY
331 do ke_x=1, lcmesh2d%NeX
332 kelem = ke_x + (ke_y-1)*lcmesh2d%NeX
333 i = ihalo + ke_x; j = jhalo + ke_y
334 out_dg(:,kelem) = out_dg(:,kelem) &
335 + in_fv(i,j) &
336 + dqdx(i,j) * elem2d_%x1(:) &
337 + dqdy(i,j) * elem2d_%x2(:)
338 enddo
339 enddo
340 case(2) !- Piecewise quadratic reconstruction
341 !$omp do
342 do ke_y=1, lcmesh2d%NeY
343 do ke_x=1, lcmesh2d%NeX
344 kelem = ke_x + (ke_y-1)*lcmesh2d%NeX
345 i = ihalo + ke_x; j = jhalo + ke_y
346 out_dg(:,kelem) = out_dg(:,kelem) &
347 + in_fv(i,j) &
348 + dqdx(i,j) * elem2d_%x1(:) &
349 + dqdy(i,j) * elem2d_%x2(:) &
350 + dqdxy(i,j) * elem2d_%x1(:) * elem2d_%x2(:) &
351 + 0.5_rp * dqdxx(i,j) * ( elem2d_%x1(:)**2 - 1.0_rp / 3.0_rp ) &
352 + 0.5_rp * dqdyy(i,j) * ( elem2d_%x2(:)**2 - 1.0_rp / 3.0_rp )
353 enddo
354 enddo
355 end select
356 !$omp end parallel
357 return
358end subroutine meshfieldfvmutil_interp_fvtodg_2d
359
360!- private ----------------------
361
362
363end module scale_meshfield_fvm_util
scale_meshfield_fvm_util::meshfieldfvmutil_interp_fvtodg
Definition scale_meshfield_fvm_util.F90:32
scale_element_base
module FElib / Element / Base
Definition scale_element_base.F90:11
scale_localmesh_2d
module FElib / Mesh / Local 2D
Definition scale_localmesh_2d.F90:10
scale_localmesh_3d
module FElib / Mesh / Local 3D
Definition scale_localmesh_3d.F90:10
scale_meshfield_fvm_util
module FElib / Data / Utility
Definition scale_meshfield_fvm_util.F90:10
scale_meshfield_fvm_util::meshfieldfvmutil_interp_fvtodg_2d
subroutine, public meshfieldfvmutil_interp_fvtodg_2d(out_dg, in_fv, lcmesh2d, elem2d_, is, ie, ia, ihalo, js, je, ja, jhalo, interp_ord, out_dg_flush_flag)
Interpolate 2D FV data into DG nodes.
Definition scale_meshfield_fvm_util.F90:237
scale_meshfield_fvm_util::meshfieldfvmutil_interp_fvtodg_3d
subroutine, public meshfieldfvmutil_interp_fvtodg_3d(out_dg, in_fv, lcmesh3d, elem3d_, is, ie, ia, ihalo, js, je, ja, jhalo, ks, ke, ka, khalo, interp_ord, out_dg_flush_flag)
Interpolate 3D FV data into DG nodes.
Definition scale_meshfield_fvm_util.F90:62
scale_element_base::elementbase2d
Definition scale_element_base.F90:68
scale_element_base::elementbase3d
Definition scale_element_base.F90:103
scale_localmesh_2d::localmesh2d
Definition scale_localmesh_2d.F90:29
scale_localmesh_3d::localmesh3d
Definition scale_localmesh_3d.F90:30
Generated by doxygen 1.10.0