14 function interpolator_interface (q,i,j,k,w)
result(qtilde)
16 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
17 integer,
intent(in):: i, j, k
18 real,
intent(in):: w(3)
19 real(kind=KindScalarVar):: qtilde
24 integer:: order_interpolator
25 procedure(interpolator_interface),
pointer,
nopass:: interpolator => null()
27 procedure,
nopass:: trilinear_log
28 procedure,
nopass:: trilinear_pv
29 procedure,
nopass:: four_d
30 procedure,
nopass:: four_d_log
31 procedure,
nopass:: four_d_pv
33 type(interpolator_t):: interpolator
35 PUBLIC selectinterpolator, interpolator, interpolator_interface, interpolator_unsigned
41 FUNCTION selectinterpolator (iorder)
result(interp)
42 procedure(interpolator_interface),
pointer :: interp
43 integer,
intent(in) :: iorder
45 call trace_begin(
'interpolate_t%SelectInterpolator')
49 interp => interpolator_donor_cell
50 interpolator%interpolator => interpolator_donor_cell
52 interp => interpolator_van_leer_3d
53 interpolator%interpolator => interpolator_van_leer_3d
55 interp => interpolator_trilinear
56 interpolator%interpolator => interpolator_trilinear
58 call mpi%abort(
"The order you have selected has not been implemented. Abort!")
60 interpolator%order_interpolator = iorder
63 END FUNCTION selectinterpolator
68 FUNCTION interpolator_donor_cell (q,i,j,k,w)
result(qtilde)
69 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
70 integer,
intent(in):: i, j, k
71 real,
intent(in):: w(3)
72 real(kind=KindScalarVar):: qtilde
74 call trace_begin(
'interpolate_mod::donor_cell', 2)
79 END FUNCTION interpolator_donor_cell
89 FUNCTION interpolator_van_leer_3d (q,i,j,k,w)
result(qtilde)
90 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
91 integer,
intent(in):: i, j, k
92 real,
intent(in):: w(3)
93 real(kind=KindScalarVar):: qtilde
95 logical :: ldim(3), lzc=.false., lfc(3)=.false.
96 real(8) :: qijk, dq1, dq2, dq3, qp, qm, dp, dm, aych1, aych2, aych3
99 call trace_begin(
'interpolate_mod::van_Leer', 1, itimer=itimer)
101 if (lzc) ldim(:) = .true.
102 if (lfc(2) .or. lfc(3)) ldim(1) = .true.
103 if (lfc(3) .or. lfc(1)) ldim(2) = .true.
104 if (lfc(1) .or. lfc(2)) ldim(3) = .true.
105 if (
size(q,1) <= 1) ldim(1) = .false.
106 if (
size(q,2) <= 1) ldim(2) = .false.
107 if (
size(q,3) <= 1) ldim(3) = .false.
122 if ( dp * dm > 0.0d0)
then 123 dq1 = (dp * dm) / (qp - qm)
135 if ( dp * dm > 0.0d0)
then 136 dq2 = (dp * dm) / (qp - qm)
148 if ( dp * dm .gt. 0.0d0)
then 149 dq3 = (dp * dm) / (qp - qm)
162 qtilde = qijk + dq1 * ( w(1) - aych1 ) &
163 + dq2 * ( w(2) - aych2 ) &
164 + dq3 * ( w(3) - aych3 )
166 call trace_end (itimer)
167 END FUNCTION interpolator_van_leer_3d
172 FUNCTION interpolator_trilinear (q,i,j,k,w)
result(qtilde)
173 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
174 integer,
intent(in):: i, j, k
175 real,
intent(in):: w(3)
176 real(kind=KindScalarVar):: qtilde, m(3)
181 i1 = merge(1,0,
size(q,1) > 1)
182 j1 = merge(1,0,
size(q,2) > 1)
183 k1 = merge(1,0,
size(q,3) > 1)
185 qtilde = m(3) * (m(2) * (m(1) * q(i ,j ,k ) + w(1) * q(i+i1,j ,k )) + &
186 w(2) * (m(1) * q(i ,j+j1,k ) + w(1) * q(i+i1,j+j1,k ))) + &
187 w(3) * (m(2) * (m(1) * q(i ,j ,k+k1) + w(1) * q(i+i1,j ,k+k1)) + &
188 w(2) * (m(1) * q(i ,j+j1,k+k1) + w(1) * q(i+i1,j+j1,k+k1)))
190 END FUNCTION interpolator_trilinear
195 FUNCTION trilinear_log (q,i,j,k,w)
result(qtilde)
196 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
197 integer,
intent(in):: i, j, k
198 real,
intent(in):: w(3)
199 real(kind=KindScalarVar):: qtilde, m(3)
204 i1 = merge(1,0,
size(q,1) > 1)
205 j1 = merge(1,0,
size(q,2) > 1)
206 k1 = merge(1,0,
size(q,3) > 1)
208 qtilde = m(3)*(m(2)*(m(1)*log(q(i ,j ,k )) + w(1)*log(q(i+i1,j ,k ))) + &
209 w(2)*(m(1)*log(q(i ,j+j1,k )) + w(1)*log(q(i+i1,j+j1,k )))) + &
210 w(3)*(m(2)*(m(1)*log(q(i ,j ,k+k1)) + w(1)*log(q(i+i1,j ,k+k1))) + &
211 w(2)*(m(1)*log(q(i ,j+j1,k+k1)) + w(1)*log(q(i+i1,j+j1,k+k1))))
213 END FUNCTION trilinear_log
218 FUNCTION trilinear_pv (q,d,i,j,k,w)
result(qtilde)
219 real(kind=KindScalarVar),
intent(in):: d(:,:,:), q(:,:,:)
220 integer,
intent(in):: i, j, k
221 real,
intent(in):: w(3)
222 real(kind=KindScalarVar):: qtilde, m(3)
227 i1 = merge(1,0,
size(q,1) > 1)
228 j1 = merge(1,0,
size(q,2) > 1)
229 k1 = merge(1,0,
size(q,3) > 1)
231 qtilde = m(3)*(m(2)*(m(1)*q(i ,j ,k )/d(i ,j ,k ) + &
232 w(1)*q(i+i1,j ,k )/d(i+i1,j ,k )) + &
233 w(2)*(m(1)*q(i ,j+j1,k )/d(i ,j+j1,k ) + &
234 w(1)*q(i+i1,j+j1,k )/d(i+i1,j+j1,k ))) + &
235 w(3)*(m(2)*(m(1)*q(i ,j ,k+k1)/d(i ,j ,k+k1) + &
236 w(1)*q(i+i1,j ,k+k1)/d(i+i1,j ,k+k1)) + &
237 w(2)*(m(1)*q(i ,j+j1,k+k1)/d(i ,j+j1,k+k1) + &
238 w(1)*q(i+i1,j+j1,k+k1)/d(i+i1,j+j1,k+k1)))
240 END FUNCTION trilinear_pv
245 FUNCTION interpolator_trilinear_3d (q,i,j,k,w)
result(qtilde)
246 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
247 integer,
intent(in):: i, j, k
248 real,
intent(in):: w(3)
249 real(kind=KindScalarVar):: qtilde, m(3)
255 qtilde = m(3) * (m(2) * (m(1) * q(i ,j ,k ) + w(1) * q(i+1,j ,k )) + &
256 w(2) * (m(1) * q(i ,j+1,k ) + w(1) * q(i+1,j+1,k ))) + &
257 w(3) * (m(2) * (m(1) * q(i ,j ,k+1) + w(1) * q(i+1,j ,k+1)) + &
258 w(2) * (m(1) * q(i ,j+1,k+1) + w(1) * q(i+1,j+1,k+1)))
260 END FUNCTION interpolator_trilinear_3d
266 FUNCTION interpolator_unsigned (q,i,j,k,w)
result(qtilde)
267 real(kind=KindScalarVar),
intent(in):: q(:,:,:)
268 integer,
intent(in):: i, j, k
269 real,
intent(in):: w(3)
270 real(kind=KindScalarVar):: qtilde
271 real(kind=KindScalarVar),
allocatable:: logq(:,:,:)
274 call trace_begin(
'interpolate_mod::unsigned', 1, itimer=itimer)
276 allocate(logq(
size(q,1),
size(q,2),
size(q,3)))
277 logq(:,:,:) = log(q(:,:,:))
278 qtilde = exp(interpolator%interpolator(logq,i,j,k,w))
281 call trace_end (itimer)
282 END FUNCTION interpolator_unsigned
287 FUNCTION four_d (q, i, j, k, l, w)
RESULT (qtilde)
288 real(kind=KindScalarVar),
intent(in) :: q(:,:,:,:)
289 real(kind=KindScalarVar) :: qtilde
290 integer,
intent(in) :: i, j, k, l(2)
291 real,
intent(in) :: w(4)
294 real(kind=KindScalarVar):: m(4)
302 m(4)*(m(3)*(m(2)*(m(1)*q(i ,j ,k ,l1) + w(1)*q(i+1,j ,k ,l1)) + &
303 w(2)*(m(1)*q(i ,j+1,k ,l1) + w(1)*q(i+1,j+1,k ,l1))) + &
304 w(3)*(m(2)*(m(1)*q(i ,j ,k+1,l1) + w(1)*q(i+1,j ,k+1,l1)) + &
305 w(2)*(m(1)*q(i ,j+1,k+1,l1) + w(1)*q(i+1,j+1,k+1,l1)))) + &
306 w(4)*(m(3)*(m(2)*(m(1)*q(i ,j ,k ,l2) + w(1)*q(i+1,j ,k ,l2)) + &
307 w(2)*(m(1)*q(i ,j+1,k ,l2) + w(1)*q(i+1,j+1,k ,l2))) + &
308 w(3)*(m(2)*(m(1)*q(i ,j ,k+1,l2) + w(1)*q(i+1,j ,k+1,l2)) + &
309 w(2)*(m(1)*q(i ,j+1,k+1,l2) + w(1)*q(i+1,j+1,k+1,l2))))
316 FUNCTION four_d_pv (q, d1, d2, i, j, k, l, w)
RESULT (qtilde)
317 real(kind=KindScalarVar),
intent(in) :: q(:,:,:,:), d1(:,:,:), d2(:,:,:)
318 real(kind=KindScalarVar) :: qtilde
319 integer,
intent(in) :: i, j, k, l(2)
320 real,
intent(in) :: w(4)
323 real(kind=KindScalarVar):: m(4)
331 m(4)*(m(3)*(m(2)*(m(1)*q(i ,j ,k ,l1)/d1(i ,j ,k ) + &
332 w(1)*q(i+1,j ,k ,l1)/d1(i+1,j ,k )) + &
333 w(2)*(m(1)*q(i ,j+1,k ,l1)/d1(i ,j+1,k ) + &
334 w(1)*q(i+1,j+1,k ,l1)/d1(i+1,j+1,k ))) + &
335 w(3)*(m(2)*(m(1)*q(i ,j ,k+1,l1)/d1(i ,j ,k+1) + &
336 w(1)*q(i+1,j ,k+1,l1)/d1(i+1,j ,k+1)) + &
337 w(2)*(m(1)*q(i ,j+1,k+1,l1)/d1(i ,j+1,k+1) + &
338 w(1)*q(i+1,j+1,k+1,l1)/d1(i+1,j+1,k+1)))) + &
339 w(4)*(m(3)*(m(2)*(m(1)*q(i ,j ,k ,l2)/d2(i ,j ,k ) + &
340 w(1)*q(i+1,j ,k ,l2)/d2(i+1,j ,k )) + &
341 w(2)*(m(1)*q(i ,j+1,k ,l2)/d2(i ,j+1,k ) + &
342 w(1)*q(i+1,j+1,k ,l2)/d2(i+1,j+1,k ))) + &
343 w(3)*(m(2)*(m(1)*q(i ,j ,k+1,l2)/d2(i ,j ,k+1) + &
344 w(1)*q(i+1,j ,k+1,l2)/d2(i+1,j ,k+1)) + &
345 w(2)*(m(1)*q(i ,j+1,k+1,l2)/d2(i ,j+1,k+1) + &
346 w(1)*q(i+1,j+1,k+1,l2)/d2(i+1,j+1,k+1))))
348 END FUNCTION four_d_pv
353 FUNCTION four_d_log (q, i, j, k, l, w)
RESULT (qtilde)
354 real(kind=KindScalarVar),
intent(in) :: q(:,:,:,:)
355 real(kind=KindScalarVar) :: qtilde
356 integer,
intent(in) :: i, j, k, l(2)
357 real,
intent(in) :: w(4)
360 real(kind=KindScalarVar):: m(4)
368 m(4)*(m(3)*(m(2)*(m(1)*log(q(i ,j ,k ,l1)) + w(1)*log(q(i+1,j ,k ,l1))) + &
369 w(2)*(m(1)*log(q(i ,j+1,k ,l1)) + w(1)*log(q(i+1,j+1,k ,l1)))) + &
370 w(3)*(m(2)*(m(1)*log(q(i ,j ,k+1,l1)) + w(1)*log(q(i+1,j ,k+1,l1))) + &
371 w(2)*(m(1)*log(q(i ,j+1,k+1,l1)) + w(1)*log(q(i+1,j+1,k+1,l1))))) + &
372 w(4)*(m(3)*(m(2)*(m(1)*log(q(i ,j ,k ,l2)) + w(1)*log(q(i+1,j ,k ,l2))) + &
373 w(2)*(m(1)*log(q(i ,j+1,k ,l2)) + w(1)*log(q(i+1,j+1,k ,l2)))) + &
374 w(3)*(m(2)*(m(1)*log(q(i ,j ,k+1,l2)) + w(1)*log(q(i+1,j ,k+1,l2))) + &
375 w(2)*(m(1)*log(q(i ,j+1,k+1,l2)) + w(1)*log(q(i+1,j+1,k+1,l2)))))
377 END FUNCTION four_d_log
379 END MODULE interpolate_mod
This index file has slot indices for all solver, all initially equal to zero It is the responsibility...