20 integer,
intent(in) :: ixi^
l, il^
l, idims
21 double precision,
intent(in) :: w(ixi^s,1:nw)
23 double precision,
intent(inout) :: wrc(ixi^s,1:nw),wlc(ixi^s,1:nw)
25 double precision,
dimension(ixI^S,1:nw) :: f, fmp, fmin, fmax, ful, dm4,
d, fmd, flc, flim
26 double precision,
dimension(ixI^S,1:nw) :: wrctmp, wlctmp
27 double precision,
dimension(ixI^S) :: tmp, tmp2, tmp3, a, b, c
28 double precision,
parameter :: eps=0.d0, alpha=4.0d0
30 integer :: ilm^
l, ilmm^
l, ilp^
l, ilpp^
l, ilppp^
l
31 integer :: id^
l, idp^
l, idpp^
l, idm^
l, ie^
l, iem^
l, iep^
l, iepp^
l
49 ilm^
l=il^
l-
kr(idims,^
d);
50 ilmm^
l=ilm^
l-
kr(idims,^
d);
51 ilp^
l=il^
l+
kr(idims,^
d);
52 ilpp^
l=ilp^
l+
kr(idims,^
d);
54 f(il^s,1:nw_recon) = 1.0d0/60.0d0 * (&
55 2.0d0* w(ilmm^s,1:nw_recon) &
56 - 13.0d0* w(ilm^s,1:nw_recon) &
57 + 47.0d0* w(il^s,1:nw_recon) &
58 + 27.0d0* w(ilp^s,1:nw_recon) &
59 - 3.0d0* w(ilpp^s,1:nw_recon))
63 a(il^s) = w(ilp^s,iw)-w(il^s,iw)
64 b(il^s) = alpha*(w(il^s,iw)-w(ilm^s,iw))
65 call minmod(ixi^
l,il^
l,a,b,tmp)
66 fmp(il^s,iw) = w(il^s,iw) + tmp(il^s)
67 ful(il^s,iw) = w(il^s,iw) + b(il^s)
71 idmax^
d=ilmax^
d; idmin^
d=ilmin^
d-
kr(idims,^
d);
72 idm^
l=id^
l-
kr(idims,^
d);
73 idp^
l=id^
l+
kr(idims,^
d);
75 iemax^
d=idmax^
d+
kr(idims,^
d); iemin^
d=idmin^
d;
76 iem^
l=ie^
l-
kr(idims,^
d);
77 iep^
l=ie^
l+
kr(idims,^
d);
79 d(ie^s,1:nw_recon) = w(iep^s,1:nw_recon)-2.0d0*w(ie^s,1:nw_recon)+w(iem^s,1:nw_recon)
82 a(id^s) = 4.0d0*
d(id^s,iw)-
d(idp^s,iw)
83 b(id^s) = 4.0d0*
d(idp^s,iw)-
d(id^s,iw)
84 call minmod(ixi^
l,id^
l,a,b,tmp)
87 call minmod(ixi^
l,id^
l,a,b,tmp2)
88 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
89 dm4(id^s,iw) = tmp3(id^s)
93 fmd(il^s,1:nw_recon) = (w(il^s,1:nw_recon)+w(ilp^s,1:nw_recon))/2.0d0-dm4(il^s,1:nw_recon)/2.0d0
96 flc(il^s,1:nw_recon) = half*(3.0d0*w(il^s,1:nw_recon) &
97 - w(ilm^s,1:nw_recon)) + 4.0d0/3.0d0*dm4(ilm^s,1:nw_recon)
99 fmin(il^s,1:nw_recon) = max(min(w(il^s,1:nw_recon),w(ilp^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
100 min(w(il^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
102 fmax(il^s,1:nw_recon) = min(max(w(il^s,1:nw_recon),w(ilp^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
103 max(w(il^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
106 a(il^s) = fmin(il^s,iw)
108 c(il^s) = fmax(il^s,iw)
109 call median(ixi^
l,il^
l,a,b,c,tmp)
110 flim(il^s,iw) = tmp(il^s)
114 where ((f(il^s,1:nw_recon)-w(il^s,1:nw_recon))*(f(il^s,1:nw_recon)-fmp(il^s,1:nw_recon)) .le. eps)
115 wlctmp(il^s,1:nw_recon) = f(il^s,1:nw_recon)
117 wlctmp(il^s,1:nw_recon) = flim(il^s,1:nw_recon)
130 ilppp^
l=ilpp^
l+
kr(idims,^
d);
132 f(il^s,1:nw_recon) = 1.0d0/60.0d0 * (&
133 2.0d0* w(ilppp^s,1:nw_recon) &
134 - 13.0d0* w(ilpp^s,1:nw_recon) &
135 + 47.0d0* w(ilp^s,1:nw_recon) &
136 + 27.0d0* w(il^s,1:nw_recon) &
137 - 3.0d0* w(ilm^s,1:nw_recon))
141 a(il^s) = w(il^s,iw)-w(ilp^s,iw)
142 b(il^s) = alpha*(w(ilp^s,iw)-w(ilpp^s,iw))
143 call minmod(ixi^
l,il^
l,a,b,tmp)
144 fmp(il^s,iw) = w(ilp^s,iw) + tmp(il^s)
145 ful(il^s,iw) = w(ilp^s,iw) + b(il^s)
149 idmax^
d=ilmax^
d+
kr(idims,^
d); idmin^
d=ilmin^
d;
150 idm^
l=id^
l-
kr(idims,^
d);
151 idp^
l=id^
l+
kr(idims,^
d);
153 iemax^
d=idmax^
d; iemin^
d=idmin^
d-
kr(idims,^
d);
154 iem^
l=ie^
l-
kr(idims,^
d);
155 iep^
l=ie^
l+
kr(idims,^
d);
156 iepp^
l=iep^
l+
kr(idims,^
d);
158 d(ie^s,1:nw_recon) = w(ie^s,1:nw_recon)-2.0d0*w(iep^s,1:nw_recon)+w(iepp^s,1:nw_recon)
161 a(id^s) = 4.0d0*
d(id^s,iw)-
d(idm^s,iw)
162 b(id^s) = 4.0d0*
d(idm^s,iw)-
d(id^s,iw)
163 call minmod(ixi^
l,id^
l,a,b,tmp)
165 b(id^s) =
d(idm^s,iw)
166 call minmod(ixi^
l,id^
l,a,b,tmp2)
167 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
168 dm4(id^s,iw) = tmp3(id^s)
172 fmd(il^s,1:nw_recon) = (w(il^s,1:nw_recon)+w(ilp^s,1:nw_recon))/2.0d0-dm4(il^s,1:nw_recon)/2.0d0
175 flc(il^s,1:nw_recon) = half*(3.0d0*w(ilp^s,1:nw_recon) &
176 - w(ilpp^s,1:nw_recon)) + 4.0d0/3.0d0*dm4(ilp^s,1:nw_recon)
178 fmin(il^s,1:nw_recon) = max(min(w(ilp^s,1:nw_recon),w(il^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
179 min(w(ilp^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
181 fmax(il^s,1:nw_recon) = min(max(w(ilp^s,1:nw_recon),w(il^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
182 max(w(ilp^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
185 a(il^s) = fmin(il^s,iw)
187 c(il^s) = fmax(il^s,iw)
188 call median(ixi^
l,il^
l,a,b,c,tmp)
189 flim(il^s,iw) = tmp(il^s)
193 where ((f(il^s,1:nw_recon)-w(ilp^s,1:nw_recon))*(f(il^s,1:nw_recon)-fmp(il^s,1:nw_recon)) .le. eps)
194 wrctmp(il^s,1:nw_recon) = f(il^s,1:nw_recon)
196 wrctmp(il^s,1:nw_recon) = flim(il^s,1:nw_recon)
207 integer,
intent(in) :: ixi^
l, il^
l, idims
208 double precision,
intent(in) :: w(ixi^s,1:nw)
210 double precision,
intent(inout) :: wlc(ixi^s,1:nw)
212 double precision,
dimension(ixI^S,1:nw) :: f, fmp, fmin, fmax, ful, dm4,
d, fmd, flc, flim
213 double precision,
dimension(ixI^S) :: tmp, tmp2, tmp3, a, b, c
214 double precision,
parameter :: eps=0.d0, alpha=4.0d0
217 integer :: ilm^
l, ilmm^
l, ilp^
l, ilpp^
l
218 integer :: id^
l, idp^
l, idpp^
l, idm^
l, ie^
l, iem^
l, iep^
l, iepp^
l
225 ilm^
l=il^
l-
kr(idims,^
d);
226 ilmm^
l=ilm^
l-
kr(idims,^
d);
227 ilp^
l=il^
l+
kr(idims,^
d);
228 ilpp^
l=ilp^
l+
kr(idims,^
d);
230 f(il^s,1:nw_recon) = 1.0d0/60.0d0 * (&
231 2.0d0* w(ilmm^s,1:nw_recon) &
232 - 13.0d0* w(ilm^s,1:nw_recon) &
233 + 47.0d0* w(il^s,1:nw_recon) &
234 + 27.0d0* w(ilp^s,1:nw_recon) &
235 - 3.0d0* w(ilpp^s,1:nw_recon))
239 a(il^s) = w(ilp^s,iw)-w(il^s,iw)
240 b(il^s) = alpha*(w(il^s,iw)-w(ilm^s,iw))
241 call minmod(ixi^
l,il^
l,a,b,tmp)
242 fmp(il^s,iw) = w(il^s,iw) + tmp(il^s)
243 ful(il^s,iw) = w(il^s,iw) + b(il^s)
247 idmax^
d=ilmax^
d; idmin^
d=ilmin^
d-
kr(idims,^
d);
248 idm^
l=id^
l-
kr(idims,^
d);
249 idp^
l=id^
l+
kr(idims,^
d);
251 iemax^
d=idmax^
d+
kr(idims,^
d); iemin^
d=idmin^
d;
252 iem^
l=ie^
l-
kr(idims,^
d);
253 iep^
l=ie^
l+
kr(idims,^
d);
255 d(ie^s,1:nw_recon) = w(iep^s,1:nw_recon)-2.0d0*w(ie^s,1:nw_recon)+w(iem^s,1:nw_recon)
258 a(id^s) = 4.0d0*
d(id^s,iw)-
d(idp^s,iw)
259 b(id^s) = 4.0d0*
d(idp^s,iw)-
d(id^s,iw)
260 call minmod(ixi^
l,id^
l,a,b,tmp)
262 b(id^s) =
d(idp^s,iw)
263 call minmod(ixi^
l,id^
l,a,b,tmp2)
264 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
265 dm4(id^s,iw) = tmp3(id^s)
269 fmd(il^s,1:nw_recon) = (w(il^s,1:nw_recon)+w(ilp^s,1:nw_recon))/2.0d0-dm4(il^s,1:nw_recon)/2.0d0
272 flc(il^s,1:nw_recon) = half*(3.0d0*w(il^s,1:nw_recon) &
273 - w(ilm^s,1:nw_recon)) + 4.0d0/3.0d0*dm4(ilm^s,1:nw_recon)
275 fmin(il^s,1:nw_recon) = max(min(w(il^s,1:nw_recon),w(ilp^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
276 min(w(il^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
278 fmax(il^s,1:nw_recon) = min(max(w(il^s,1:nw_recon),w(ilp^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
279 max(w(il^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
282 a(il^s) = fmin(il^s,iw)
284 c(il^s) = fmax(il^s,iw)
285 call median(ixi^
l,il^
l,a,b,c,tmp)
286 flim(il^s,iw) = tmp(il^s)
290 where ((f(il^s,1:nw_recon)-w(il^s,1:nw_recon))*(f(il^s,1:nw_recon)-fmp(il^s,1:nw_recon)) .le. eps)
291 wlc(il^s,1:nw_recon) = f(il^s,1:nw_recon)
293 wlc(il^s,1:nw_recon) = flim(il^s,1:nw_recon)
304 integer,
intent(in) :: ixi^
l, il^
l, idims
305 double precision,
intent(in) :: w(ixi^s,1:nw)
307 double precision,
intent(inout) :: wrc(ixi^s,1:nw)
309 double precision,
dimension(ixI^S,1:nw) :: f, fmp, fmin, fmax, ful, dm4,
d, fmd, flc, flim
310 double precision,
dimension(ixI^S) :: tmp, tmp2, tmp3, a, b, c
311 double precision,
parameter :: eps=0.d0, alpha=4.0d0
312 integer :: ilm^
l, ilp^
l, ilpp^
l, ilppp^
l
313 integer :: id^
l, idp^
l, idpp^
l, idm^
l, ie^
l, iem^
l, iep^
l, iepp^
l
328 ilm^
l=il^
l-
kr(idims,^
d);
329 ilp^
l=il^
l+
kr(idims,^
d);
330 ilpp^
l=ilp^
l+
kr(idims,^
d);
331 ilppp^
l=ilpp^
l+
kr(idims,^
d);
333 f(il^s,1:nw_recon) = 1.0d0/60.0d0 * (&
334 2.0d0* w(ilppp^s,1:nw_recon) &
335 - 13.0d0* w(ilpp^s,1:nw_recon) &
336 + 47.0d0* w(ilp^s,1:nw_recon) &
337 + 27.0d0* w(il^s,1:nw_recon) &
338 - 3.0d0* w(ilm^s,1:nw_recon))
342 a(il^s) = w(il^s,iw)-w(ilp^s,iw)
343 b(il^s) = alpha*(w(ilp^s,iw)-w(ilpp^s,iw))
344 call minmod(ixi^
l,il^
l,a,b,tmp)
345 fmp(il^s,iw) = w(ilp^s,iw) + tmp(il^s)
346 ful(il^s,iw) = w(ilp^s,iw) + b(il^s)
350 idmax^
d=ilmax^
d+
kr(idims,^
d); idmin^
d=ilmin^
d;
351 idm^
l=id^
l-
kr(idims,^
d);
352 idp^
l=id^
l+
kr(idims,^
d);
354 iemax^
d=idmax^
d; iemin^
d=idmin^
d-
kr(idims,^
d);
355 iem^
l=ie^
l-
kr(idims,^
d);
356 iep^
l=ie^
l+
kr(idims,^
d);
357 iepp^
l=iep^
l+
kr(idims,^
d);
359 d(ie^s,1:nw_recon) = w(ie^s,1:nw_recon)-2.0d0*w(iep^s,1:nw_recon)+w(iepp^s,1:nw_recon)
362 a(id^s) = 4.0d0*
d(id^s,iw)-
d(idm^s,iw)
363 b(id^s) = 4.0d0*
d(idm^s,iw)-
d(id^s,iw)
364 call minmod(ixi^
l,id^
l,a,b,tmp)
366 b(id^s) =
d(idm^s,iw)
367 call minmod(ixi^
l,id^
l,a,b,tmp2)
368 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
369 dm4(id^s,iw) = tmp3(id^s)
373 fmd(il^s,1:nw_recon) = (w(il^s,1:nw_recon)+w(ilp^s,1:nw_recon))/2.0d0-dm4(il^s,1:nw_recon)/2.0d0
376 flc(il^s,1:nw_recon) = half*(3.0d0*w(ilp^s,1:nw_recon) &
377 - w(ilpp^s,1:nw_recon)) + 4.0d0/3.0d0*dm4(ilp^s,1:nw_recon)
379 fmin(il^s,1:nw_recon) = max(min(w(ilp^s,1:nw_recon),w(il^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
380 min(w(ilp^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
382 fmax(il^s,1:nw_recon) = min(max(w(ilp^s,1:nw_recon),w(il^s,1:nw_recon),fmd(il^s,1:nw_recon)),&
383 max(w(ilp^s,1:nw_recon),ful(il^s,1:nw_recon),flc(il^s,1:nw_recon)))
386 a(il^s) = fmin(il^s,iw)
388 c(il^s) = fmax(il^s,iw)
389 call median(ixi^
l,il^
l,a,b,c,tmp)
390 flim(il^s,iw) = tmp(il^s)
394 where ((f(il^s,1:nw_recon)-w(ilp^s,1:nw_recon))*(f(il^s,1:nw_recon)-fmp(il^s,1:nw_recon)) .le. eps)
395 wrc(il^s,1:nw_recon) = f(il^s,1:nw_recon)
397 wrc(il^s,1:nw_recon) = flim(il^s,1:nw_recon)
441 integer,
intent(in) :: ixi^
l, il^
l, idims
442 double precision,
intent(in) :: w(ixi^s)
443 double precision,
intent(inout) :: wrc(ixi^s),wlc(ixi^s)
445 double precision,
dimension(ixI^S) :: f, fmp, fmin, fmax, ful, dm4,
d, fmd, flc, flim
446 double precision,
dimension(ixI^S) :: wrctmp, wlctmp
447 double precision,
dimension(ixI^S) :: tmp, tmp2, tmp3, a, b, c
448 double precision,
parameter :: eps=0.0d0, alpha=4.0d0
450 integer :: ilm^
l, ilmm^
l, ilp^
l, ilpp^
l, ilppp^
l
451 integer :: id^
l, idp^
l, idpp^
l, idm^
l, ie^
l, iem^
l, iep^
l, iepp^
l
467 ilm^
l=il^
l-
kr(idims,^
d);
468 ilmm^
l=ilm^
l-
kr(idims,^
d);
469 ilp^
l=il^
l+
kr(idims,^
d);
470 ilpp^
l=ilp^
l+
kr(idims,^
d);
472 f(il^s) = 1.0d0/60.0d0 * (&
480 a(il^s) = w(ilp^s)-w(il^s)
481 b(il^s) = alpha*(w(il^s)-w(ilm^s))
482 call minmod(ixi^
l,il^
l,a,b,tmp)
483 fmp(il^s) = w(il^s) + tmp(il^s)
484 ful(il^s) = w(il^s) + b(il^s)
487 idmax^
d=ilmax^
d; idmin^
d=ilmin^
d-
kr(idims,^
d);
488 idm^
l=id^
l-
kr(idims,^
d);
489 idp^
l=id^
l+
kr(idims,^
d);
491 iemax^
d=idmax^
d+
kr(idims,^
d); iemin^
d=idmin^
d;
492 iem^
l=ie^
l-
kr(idims,^
d);
493 iep^
l=ie^
l+
kr(idims,^
d);
495 d(ie^s) = w(iep^s)-2.0d0*w(ie^s)+w(iem^s)
497 a(id^s) = 4.0d0*
d(id^s)-
d(idp^s)
498 b(id^s) = 4.0d0*
d(idp^s)-
d(id^s)
499 call minmod(ixi^
l,id^
l,a,b,tmp)
502 call minmod(ixi^
l,id^
l,a,b,tmp2)
503 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
504 dm4(id^s) = tmp3(id^s)
507 fmd(il^s) = (w(il^s)+w(ilp^s))/2.0d0-dm4(il^s)/2.0d0
510 flc(il^s) = half*(3.0d0*w(il^s) &
511 - w(ilm^s)) + 4.0d0/3.0d0*dm4(ilm^s)
513 fmin(il^s) = max(min(w(il^s),w(ilp^s),fmd(il^s)),&
514 min(w(il^s),ful(il^s),flc(il^s)))
516 fmax(il^s) = min(max(w(il^s),w(ilp^s),fmd(il^s)),&
517 max(w(il^s),ful(il^s),flc(il^s)))
519 call median(ixi^
l,il^
l,fmin,f,fmax,tmp)
520 flim(il^s) = tmp(il^s)
523 where ((f(il^s)-w(il^s))*(f(il^s)-fmp(il^s)) .le. eps)
526 wlc(il^s) = flim(il^s)
539 ilppp^
l=ilpp^
l+
kr(idims,^
d);
541 f(il^s) = 1.0d0/60.0d0 * (&
543 - 13.0d0* w(ilpp^s) &
549 a(il^s) = w(il^s)-w(ilp^s)
550 b(il^s) = alpha*(w(ilp^s)-w(ilpp^s))
551 call minmod(ixi^
l,il^
l,a,b,tmp)
552 fmp(il^s) = w(ilp^s) + tmp(il^s)
553 ful(il^s) = w(ilp^s) + b(il^s)
556 idmax^
d=ilmax^
d+
kr(idims,^
d); idmin^
d=ilmin^
d;
557 idm^
l=id^
l-
kr(idims,^
d);
558 idp^
l=id^
l+
kr(idims,^
d);
560 iemax^
d=idmax^
d; iemin^
d=idmin^
d-
kr(idims,^
d);
561 iem^
l=ie^
l-
kr(idims,^
d);
562 iep^
l=ie^
l+
kr(idims,^
d);
563 iepp^
l=iep^
l+
kr(idims,^
d);
565 d(ie^s) = w(ie^s)-2.0d0*w(iep^s)+w(iepp^s)
567 a(id^s) = 4.0d0*
d(id^s)-
d(idm^s)
568 b(id^s) = 4.0d0*
d(idm^s)-
d(id^s)
569 call minmod(ixi^
l,id^
l,a,b,tmp)
572 call minmod(ixi^
l,id^
l,a,b,tmp2)
573 call minmod(ixi^
l,id^
l,tmp,tmp2,tmp3)
574 dm4(id^s) = tmp3(id^s)
577 fmd(il^s) = (w(il^s)+w(ilp^s))/2.0d0-dm4(il^s)/2.0d0
580 flc(il^s) = half*(3.0d0*w(ilp^s) &
581 - w(ilpp^s)) + 4.0d0/3.0d0*dm4(ilp^s)
583 fmin(il^s) = max(min(w(ilp^s),w(il^s),fmd(il^s)),&
584 min(w(ilp^s),ful(il^s),flc(il^s)))
586 fmax(il^s) = min(max(w(ilp^s),w(il^s),fmd(il^s)),&
587 max(w(ilp^s),ful(il^s),flc(il^s)))
589 call median(ixi^
l,il^
l,fmin,f,fmax,flim)
592 where ((f(il^s)-w(ilp^s))*(f(il^s)-fmp(il^s)) .le. eps)
595 wrc(il^s) = flim(il^s)