MPI-AMRVAC  3.1
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
mod_ppm.t
Go to the documentation of this file.
1 module mod_ppm
2 
3  implicit none
4  private
5 
6  public :: ppmlimiter
7  public :: ppmlimitervar
8 
9 contains
10 
11  subroutine ppmlimitervar(ixI^L,ix^L,idims,q,qCT,qLC,qRC)
12 
13  ! references:
14  ! Mignone et al 2005, ApJS 160, 199,
15  ! Miller and Colella 2002, JCP 183, 26
16  ! Fryxell et al. 2000 ApJ, 131, 273 (Flash)
17  ! baciotti Phd (http://www.aei.mpg.de/~baiotti/Baiotti_PhD.pdf)
18  ! old version : april 2009
19  ! author: zakaria.meliani@wis.kuleuven.be
20  ! current version : March 2023 by Chun Xia
21 
23 
24  integer, intent(in) :: ixi^l, ix^l, idims
25  double precision, intent(in) :: q(ixi^s),qct(ixi^s)
26 
27  double precision, intent(inout) :: qrc(ixi^s),qlc(ixi^s)
28 
29  double precision,dimension(ixI^S) :: dqc,d2qc,ldq
30  double precision,dimension(ixI^S) :: qmin,qmax,tmp
31 
32  integer :: lxc^l,lxr^l,lxl^l
33  integer :: ixl^l,ixo^l,ixr^l,ixol^l,ixor^l
34  integer :: hxl^l,hxc^l,hxr^l
35  integer :: kxl^l,kxc^l,kxr^l
36 
37  ixomin^d=ixmin^d-kr(idims,^d);ixomax^d=ixmax^d+kr(idims,^d);!ixO[ixMmin-1,ixMmax+1]
38  ixolmin^d=ixomin^d-kr(idims,^d);ixolmax^d=ixomax^d; !ixOL[ixMmin-2,ixMmax+1]
39  ixor^l=ixol^l+kr(idims,^d); !ixOR=[iMmin-1,ixMmax+2]
40  ixl^l=ixo^l-kr(idims,^d); !ixL[ixMmin-2,ixMmax]
41  ixr^l=ixo^l+kr(idims,^d); !ixR=[iMmin,ixMmax+2]
42 
43  hxcmin^d=ixomin^d;hxcmax^d=ixmax^d; ! hxC = [ixMmin-1,ixMmax]
44  hxl^l=hxc^l-kr(idims,^d); ! hxL = [ixMmin-2,ixMmax-1]
45  hxr^l=hxc^l+kr(idims,^d); ! hxR = [ixMmin,ixMmax+1]
46 
47  kxcmin^d=ixlmin^d-1; kxcmax^d=ixrmax^d; ! kxC=[iMmin-3,ixMmax+2]
48  kxr^l=kxc^l+kr(idims,^d); ! kxR=[iMmin-2,ixMmax+3]
49 
50  lxcmin^d=ixomin^d-kr(idims,^d);lxcmax^d=ixomax^d+kr(idims,^d);! lxC=[iMmin-2,ixMmax+2]
51  lxl^l=lxc^l-kr(idims,^d); ! lxL=[iMmin-3,ixMmax+1]
52  lxr^l=lxc^l+kr(idims,^d); ! lxR=[iMmin-1,ixMmax+3]
53 
54  dqc(kxc^s)=q(kxr^s)-q(kxc^s)
55  ! Eq. 64, Miller and Colella 2002, JCP 183, 26
56  d2qc(kxc^s)=half*(q(lxr^s)-q(lxl^s))
57  where(dqc(lxc^s)*dqc(lxl^s)>zero)
58  ! Store the sign of dwC in wMin
59  qmin(kxc^s)= sign(one,d2qc(lxc^s))
60  ! Eq. 65, Miller and Colella 2002, JCP 183, 26
61  ldq(lxc^s)= qmin(lxc^s)*min(dabs(d2qc(lxc^s)),&
62  2.0d0*dabs(dqc(lxl^s)),&
63  2.0d0*dabs(dqc(lxc^s)))
64  else where
65  ldq(lxc^s)=zero
66  end where
67 
68  ! Eq. 66, Miller and Colella 2002, JCP 183, 26
69  qlc(ixol^s)=qlc(ixol^s)+half*dqc(ixol^s)&
70  +(ldq(ixol^s)-ldq(ixor^s))/6.0d0
71  qrc(ixl^s)=qlc(ixl^s)
72 
73  ! make sure that min wCT(i)<wLC(i)<wCT(i+1) same for wRC(i)
74  call extremaq(ixi^l,ixo^l,qct,1,qmax,qmin)
75 
76  ! Eq. B8, page 217, Mignone et al 2005, ApJS
77  qrc(ixl^s)=max(qmin(ixo^s),min(qmax(ixo^s),qrc(ixl^s)))
78  qlc(ixo^s)=max(qmin(ixo^s),min(qmax(ixo^s),qlc(ixo^s)))
79 
80  ! Eq. B9, page 217, Mignone et al 2005, ApJS
81  where((qrc(ixl^s)-qct(ixo^s))*(qct(ixo^s)-qlc(ixo^s))<=zero)
82  qrc(ixl^s)=qct(ixo^s)
83  qlc(ixo^s)=qct(ixo^s)
84  end where
85 
86  qmax(ixo^s)=(qlc(ixo^s)-qrc(ixl^s))&
87  *(qct(ixo^s)-half*(qlc(ixo^s)+qrc(ixl^s)))
88  qmin(ixo^s)=(qlc(ixo^s)-qrc(ixl^s))**2/6.0d0
89 
90  tmp(hxl^s)=qrc(hxl^s)
91  ! Eq. B10, page 218, Mignone et al 2005, ApJS
92  where(qmax(hxr^s)>qmin(hxr^s))
93  qrc(hxc^s)= 3.0d0*qct(hxr^s)-2.0d0*qlc(hxr^s)
94  end where
95  ! Eq. B11, page 218, Mignone et al 2005, ApJS
96  where(qmax(hxc^s)<-qmin(hxc^s))
97  qlc(hxc^s)= 3.0d0*qct(hxc^s)-2.0d0*tmp(hxl^s)
98  end where
99 
100  end subroutine ppmlimitervar
101 
102  subroutine ppmlimiter(ixI^L,ix^L,idims,w,wCT,wLC,wRC)
103 
104  ! references:
105  ! Mignone et al 2005, ApJS 160, 199,
106  ! Miller and Colella 2002, JCP 183, 26
107  ! Fryxell et al. 2000 ApJ, 131, 273 (Flash)
108  ! baciotti Phd (http://www.aei.mpg.de/~baiotti/Baiotti_PhD.pdf)
109  ! old version : april 2009
110  ! author: zakaria.meliani@wis.kuleuven.be
111  ! current version : March 2023 by Chun Xia
113 
114  integer, intent(in) :: ixi^l, ix^l, idims
115  double precision, intent(in) :: w(ixi^s,1:nw),wct(ixi^s,1:nw)
116 
117  double precision, intent(inout) :: wrc(ixi^s,1:nw),wlc(ixi^s,1:nw)
118 
119  double precision,dimension(ixI^S,1:nwflux) :: dwc,d2wc,ldw
120  double precision,dimension(ixI^S,1:nwflux) :: wmin,wmax,tmp
121  double precision,dimension(ixI^S) :: aa, ab, ac, ki
122 
123  integer :: lxc^l,lxl^l,lxr^l
124  integer :: ixll^l,ixl^l,ixo^l,ixr^l,ixrr^l,ixol^l,ixor^l
125  integer :: hxl^l,hxc^l,hxr^l
126  integer :: kxll^l,kxl^l,kxc^l,kxr^l,kxrr^l
127  integer :: iw, idimss
128 
129  double precision, parameter :: betamin=0.75d0, betamax=0.85d0,&
130  zmin=0.25d0, zmax=0.75d0,&
131  eta1=20.0d0,eta2=0.05d0,eps=0.01d0,kappa=0.1d0
132 
133  ixomin^d=ixmin^d-kr(idims,^d);ixomax^d=ixmax^d+kr(idims,^d);!ixO[ixMmin-1,ixMmax+1]
134  ixolmin^d=ixomin^d-kr(idims,^d);ixolmax^d=ixomax^d; !ixOL[ixMmin-2,ixMmax+1]
135  ixor^l=ixol^l+kr(idims,^d); !ixOR=[iMmin-1,ixMmax+2]
136  ixl^l=ixo^l-kr(idims,^d); !ixL[ixMmin-2,ixMmax]
137  ixr^l=ixo^l+kr(idims,^d); !ixR=[iMmin,ixMmax+2]
138 
139  hxcmin^d=ixomin^d;hxcmax^d=ixmax^d; ! hxC = [ixMmin-1,ixMmax]
140  hxl^l=hxc^l-kr(idims,^d); ! hxL = [ixMmin-2,ixMmax-1]
141  hxr^l=hxc^l+kr(idims,^d); ! hxR = [ixMmin,ixMmax+1]
142 
143  kxcmin^d=ixlmin^d-1; kxcmax^d=ixrmax^d; ! kxC=[iMmin-3,ixMmax+2]
144  kxr^l=kxc^l+kr(idims,^d); ! kxR=[iMmin-2,ixMmax+3]
145 
146  lxcmin^d=ixomin^d-kr(idims,^d);lxcmax^d=ixomax^d+kr(idims,^d);! lxC=[iMmin-2,ixMmax+2]
147  lxl^l=lxc^l-kr(idims,^d); ! lxL=[iMmin-3,ixMmax+1]
148  lxr^l=lxc^l+kr(idims,^d); ! lxR=[iMmin-1,ixMmax+3]
149 
150  dwc(kxc^s,1:nwflux)=w(kxr^s,1:nwflux)-w(kxc^s,1:nwflux)
151  ! Eq. 64, Miller and Colella 2002, JCP 183, 26
152  d2wc(lxc^s,1:nwflux)=half*(w(lxr^s,1:nwflux)-w(lxl^s,1:nwflux))
153  where(dwc(lxc^s,1:nwflux)*dwc(lxl^s,1:nwflux)>zero)
154  ! Store the sign of dwC in wMin
155  wmin(lxc^s,1:nwflux)= sign(one,d2wc(lxc^s,1:nwflux))
156  ! Eq. 65, Miller and Colella 2002, JCP 183, 26
157  ldw(lxc^s,1:nwflux)= wmin(lxc^s,1:nwflux)*min(dabs(d2wc(lxc^s,1:nwflux)),&
158  2.0d0*dabs(dwc(lxl^s,1:nwflux)),&
159  2.0d0*dabs(dwc(lxc^s,1:nwflux)))
160  else where
161  ldw(lxc^s,1:nwflux)=zero
162  end where
163 
164  ! Eq. 66, Miller and Colella 2002, JCP 183, 26
165  wlc(ixol^s,1:nwflux)=wlc(ixol^s,1:nwflux)+half*dwc(ixol^s,1:nwflux)&
166  +(ldw(ixol^s,1:nwflux)-ldw(ixor^s,1:nwflux))/6.0d0
167  wrc(ixl^s,1:nwflux)=wlc(ixl^s,1:nwflux)
168 
169  ! make sure that min w(i)<wLC(i)<w(i+1) same for wRC(i)
170  call extremaw(ixi^l,ixo^l,w,1,wmax,wmin)
171 
172  ! Eq. B8, page 217, Mignone et al 2005, ApJS
173  wrc(ixl^s,1:nwflux)=max(wmin(ixo^s,1:nwflux)&
174  ,min(wmax(ixo^s,1:nwflux),wrc(ixl^s,1:nwflux)))
175  wlc(ixo^s,1:nwflux)=max(wmin(ixo^s,1:nwflux)&
176  ,min(wmax(ixo^s,1:nwflux),wlc(ixo^s,1:nwflux)))
177 
178  ! Eq. B9, page 217, Mignone et al 2005, ApJS
179  where((wrc(ixl^s,1:nwflux)-wct(ixo^s,1:nwflux))&
180  *(wct(ixo^s,1:nwflux)-wlc(ixo^s,1:nwflux))<=zero)
181  wrc(ixl^s,1:nwflux)=wct(ixo^s,1:nwflux)
182  wlc(ixo^s,1:nwflux)=wct(ixo^s,1:nwflux)
183  end where
184 
185  wmax(ixo^s,1:nwflux)=(wlc(ixo^s,1:nwflux)-wrc(ixl^s,1:nwflux))*&
186  (wct(ixo^s,1:nwflux)-half*(wlc(ixo^s,1:nwflux)+wrc(ixl^s,1:nwflux)))
187  wmin(ixo^s,1:nwflux)=(wlc(ixo^s,1:nwflux)-wrc(ixl^s,1:nwflux))**2/6.0d0
188  tmp(hxl^s,1:nwflux)=wrc(hxl^s,1:nwflux)
189  ! Eq. B10, page 218, Mignone et al 2005, ApJS
190  where(wmax(hxr^s,1:nwflux)>wmin(hxr^s,1:nwflux))
191  wrc(hxc^s,1:nwflux)= 3.0d0*wct(hxr^s,1:nwflux)&
192  -2.0d0*wlc(hxr^s,1:nwflux)
193  end where
194  ! Eq. B11, page 218, Mignone et al 2005, ApJS
195  where(wmax(hxc^s,1:nwflux)<-wmin(hxc^s,1:nwflux))
196  wlc(hxc^s,1:nwflux)= 3.0d0*wct(hxc^s,1:nwflux)&
197  -2.0d0*tmp(hxl^s,1:nwflux)
198  end where
199 
200  ! flattening at the contact discontinuities
201  if(flatcd)then
202  ixrr^l=ixr^l+kr(idims,^d); !ixRR=[iMmin+1,ixMmax+3]
203  kxl^l=kxc^l-kr(idims,^d); ! kxL=[iMmin-4,ixMmax+1]
204  call ppm_flatcd(ixi^l,kxc^l,kxl^l,kxr^l,wct,d2wc,aa,ab)
205  if(any(kappa*aa(kxc^s)>=ab(kxc^s)))then
206  do iw=1,nwflux
207  where(kappa*aa(kxc^s)>=ab(kxc^s).and. dabs(dwc(kxc^s,iw))>smalldouble)
208  wmax(kxc^s,iw) = wct(kxr^s,iw)-2.0d0*wct(kxc^s,iw)+wct(kxl^s,iw)
209  end where
210 
211  where(wmax(ixr^s,iw)*wmax(ixl^s,iw)<zero .and.&
212  dabs(wct(ixr^s,iw)-wct(ixl^s,iw))&
213  -eps*min(dabs(wct(ixr^s,iw)),dabs(wct(ixl^s,iw)))>zero &
214  .and. kappa*aa(ixo^s)>=ab(ixo^s)&
215  .and. dabs(dwc(ixo^s,iw))>smalldouble)
216 
217  ac(ixo^s)=(wct(ixll^s,iw)-wct(ixrr^s,iw)+4.0d0*dwc(ixo^s,iw))&
218  /(12.0d0*dwc(ixo^s,iw))
219  wmin(ixo^s,iw)=max(zero,min(eta1*(ac(ixo^s)-eta2),one))
220  else where
221  wmin(ixo^s,iw)=zero
222  end where
223 
224  where(wmin(hxc^s,iw)>zero)
225  wlc(hxc^s,iw) = wlc(hxc^s,iw)*(one-wmin(hxc^s,iw))&
226  +(wct(hxc^s,iw)+half*ldw(hxc^s,iw))*wmin(hxc^s,iw)
227  end where
228  where(wmin(hxr^s,iw)>zero)
229  wrc(hxc^s,iw) = wrc(hxc^s,iw)*(one-wmin(hxr^s,iw))&
230  +(wct(hxr^s,iw)-half*ldw(hxr^s,iw))*wmin(hxr^s,iw)
231  end where
232  end do
233  end if
234  end if
235 
236  ! flattening at the shocks
237  if(flatsh)then
238  ! following MILLER and COLELLA 2002 JCP 183, 26
239  kxcmin^d=ixmin^d-2; kxcmax^d=ixmax^d+2; ! kxC=[ixMmin-2,ixMmax+2]
240  ki=bigdouble
241  do idimss=1,ndim
242  kxl^l=kxc^l-kr(idimss,^d); ! kxL=[ixMmin-3,ixMmax+1]
243  kxr^l=kxc^l+kr(idimss,^d); ! kxR=[ixMmin-1,ixMmax+3]
244  kxll^l=kxl^l-kr(idimss,^d);! kxLL=[ixMmin-4,ixMmax]
245  kxrr^l=kxr^l+kr(idimss,^d);! kxRR=[ixMmin,ixMmax+4]
246 
247  call ppm_flatsh(ixi^l,kxc^l,kxll^l,kxl^l,kxr^l,kxrr^l,idimss,wct,aa,ab)
248 
249  ! eq. B17, page 218, Mignone et al 2005, ApJS (Xi1 min)
250  ac(kxc^s) = max(zero,min(one,(betamax-aa(kxc^s))/(betamax-betamin)))
251  ! eq. B18, page 218, Mignone et al 2005, ApJS (Xi1)
252  ! recycling aa(ixL^S)
253  where(wct(kxr^s,iw_mom(idimss))<wct(kxl^s,iw_mom(idimss)))
254  aa(kxc^s) = max(ac(kxc^s), min(one,(zmax-ab(kxc^s))/(zmax-zmin)))
255  else where
256  aa(kxc^s) = one
257  end where
258  ixl^l=ixo^l-kr(idimss,^d); ! ixL=[ixMmin-2,ixMmax]
259  ixr^l=ixo^l+kr(idimss,^d); ! ixR=[ixMmin,ixMmax+2]
260  ki(ixo^s)=min(ki(ixo^s),aa(ixl^s),aa(ixo^s),aa(ixr^s))
261  end do
262  ! recycling wMax
263  do iw=1,nwflux
264  where(dabs(ab(ixo^s)-one)>smalldouble)
265  wmax(ixo^s,iw) = (one-ab(ixo^s))*wct(ixo^s,iw)
266  end where
267 
268  where(dabs(ab(hxc^s)-one)>smalldouble)
269  wlc(hxc^s,iw) = ab(hxc^s)*wlc(hxc^s,iw)+wmax(hxc^s,iw)
270  end where
271 
272  where(dabs(ab(hxr^s)-one)>smalldouble)
273  wrc(hxc^s,iw) = ab(hxr^s)*wrc(hxc^s,iw)+wmax(hxr^s,iw)
274  end where
275  end do
276  end if
277 
278  end subroutine ppmlimiter
279 
280  subroutine ppm_flatcd(ixI^L,ixO^L,ixL^L,ixR^L,w,d2w,drho,dp)
282  use mod_physics, only: phys_gamma
283 
284  integer, intent(in) :: ixI^L, ixO^L, ixL^L, ixR^L
285  double precision, intent(in) :: w(ixI^S, nw), d2w(ixG^T, 1:nwflux)
286  double precision, intent(inout) :: drho(ixG^T), dp(ixG^T)
287 
288  drho(ixo^s) = phys_gamma*abs(d2w(ixo^s, iw_rho))&
289  /min(w(ixl^s, iw_rho), w(ixr^s, iw_rho))
290  dp(ixo^s) = abs(d2w(ixo^s, iw_e))/min(w(ixl^s, iw_e), w(ixr^s, iw_e))
291 
292  end subroutine ppm_flatcd
293 
294  subroutine ppm_flatsh(ixI^L,ixO^L,ixLL^L,ixL^L,ixR^L,ixRR^L,idims,w,drho,dp)
296  use mod_physics, only: phys_gamma
297 
298  integer, intent(in) :: ixI^L, ixO^L, ixLL^L, ixL^L, ixR^L, ixRR^L
299  integer, intent(in) :: idims
300  double precision, intent(in) :: w(ixI^S, nw)
301  double precision, intent(inout) :: drho(ixI^S), dp(ixI^S)
302 
303  ! eq. B15, page 218, Mignone and Bodo 2005, ApJS (beta1)
304  where (abs(w(ixrr^s, iw_e)-w(ixll^s, iw_e))>smalldouble)
305  drho(ixo^s) = abs((w(ixr^s, iw_e)-w(ixl^s, iw_e))&
306  /(w(ixrr^s, iw_e)-w(ixll^s, iw_e)))
307  else where
308  drho(ixo^s) = zero
309  end where
310 
311  ! eq. 76, page 48, Miller and Colella 2002, JCoPh, adjusted
312  dp(ixo^s) = abs(w(ixr^s, iw_e)-w(ixl^s, iw_e))&
313  /(phys_gamma*(w(ixr^s, iw_e)+w(ixl^s, iw_e)))
314 
315  end subroutine ppm_flatsh
316 
317  subroutine extremaq(ixI^L,ixO^L,q,nshift,qMax,qMin)
318 
320 
321  integer,intent(in) :: ixI^L,ixO^L
322  double precision, intent(in) :: q(ixI^S)
323  integer,intent(in) :: nshift
324 
325  double precision, intent(out) :: qMax(ixI^S),qMin(ixI^S)
326 
327  integer :: ixs^L,ixsR^L,ixsL^L,idims,jdims,kdims,ishift,i,j
328 
329  do ishift=1,nshift
330  idims=1
331  ixsr^l=ixo^l+ishift*kr(idims,^d);
332  ixsl^l=ixo^l-ishift*kr(idims,^d);
333  if (ishift==1) then
334  qmax(ixo^s)=max(q(ixo^s),q(ixsr^s),q(ixsl^s))
335  qmin(ixo^s)=min(q(ixo^s),q(ixsr^s),q(ixsl^s))
336  else
337  qmax(ixo^s)=max(qmax(ixo^s),q(ixsr^s),q(ixsl^s))
338  qmin(ixo^s)=min(qmin(ixo^s),q(ixsr^s),q(ixsl^s))
339  end if
340  {^nooned
341  idims=1
342  jdims=idims+1
343  do i=-1,1
344  ixs^l=ixo^l+i*ishift*kr(idims,^d);
345  ixsr^l=ixs^l+ishift*kr(jdims,^d);
346  ixsl^l=ixs^l-ishift*kr(jdims,^d);
347  qmax(ixo^s)=max(qmax(ixo^s),q(ixsr^s),q(ixsl^s))
348  qmin(ixo^s)=min(qmin(ixo^s),q(ixsr^s),q(ixsl^s))
349  end do
350  }
351  {^ifthreed
352  idims=1
353  jdims=idims+1
354  kdims=jdims+1
355  do i=-1,1
356  ixs^l=ixo^l+i*ishift*kr(idims,^d);
357  do j=-1,1
358  ixs^l=ixo^l+j*ishift*kr(jdims,^d);
359  ixsr^l=ixs^l+ishift*kr(kdims,^d);
360  ixsl^l=ixs^l-ishift*kr(kdims,^d);
361  qmax(ixo^s)=max(qmax(ixo^s),q(ixsr^s),q(ixsl^s))
362  qmin(ixo^s)=min(qmin(ixo^s),q(ixsr^s),q(ixsl^s))
363  end do
364  end do
365  }
366  enddo
367 
368  end subroutine extremaq
369 
370  subroutine extremaw(ixI^L,ixO^L,w,nshift,wMax,wMin)
372 
373  integer,intent(in) :: ixI^L,ixO^L
374  double precision, intent(in) :: w(ixI^S,1:nw)
375  integer,intent(in) :: nshift
376 
377  double precision, intent(out) :: wMax(ixI^S,1:nwflux),wMin(ixI^S,1:nwflux)
378 
379  integer :: ixs^L,ixsR^L,ixsL^L,idims,jdims,kdims,ishift,i,j
380 
381  do ishift=1,nshift
382  idims=1
383  ixsr^l=ixo^l+ishift*kr(idims,^d);
384  ixsl^l=ixo^l-ishift*kr(idims,^d);
385  if (ishift==1) then
386  wmax(ixo^s,1:nwflux)= &
387  max(w(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
388  wmin(ixo^s,1:nwflux)= &
389  min(w(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
390  else
391  wmax(ixo^s,1:nwflux)= &
392  max(wmax(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
393  wmin(ixo^s,1:nwflux)= &
394  min(wmin(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
395  end if
396  {^nooned
397  idims=1
398  jdims=idims+1
399  do i=-1,1
400  ixs^l=ixo^l+i*ishift*kr(idims,^d);
401  ixsr^l=ixs^l+ishift*kr(jdims,^d);
402  ixsl^l=ixs^l-ishift*kr(jdims,^d);
403  wmax(ixo^s,1:nwflux)= &
404  max(wmax(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
405  wmin(ixo^s,1:nwflux)= &
406  min(wmin(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
407  end do
408  }
409  {^ifthreed
410  idims=1
411  jdims=idims+1
412  kdims=jdims+1
413  do i=-1,1
414  ixs^l=ixo^l+i*ishift*kr(idims,^d);
415  do j=-1,1
416  ixs^l=ixo^l+j*ishift*kr(jdims,^d);
417  ixsr^l=ixs^l+ishift*kr(kdims,^d);
418  ixsl^l=ixs^l-ishift*kr(kdims,^d);
419  wmax(ixo^s,1:nwflux)= &
420  max(wmax(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
421  wmin(ixo^s,1:nwflux)= &
422  min(wmin(ixo^s,1:nwflux),w(ixsr^s,1:nwflux),w(ixsl^s,1:nwflux))
423  end do
424  end do
425  }
426  enddo
427 
428  end subroutine extremaw
429 
430 end module mod_ppm
This module contains definitions of global parameters and variables and some generic functions/subrou...
integer, dimension(3, 3) kr
Kronecker delta tensor.
integer, parameter ndim
Number of spatial dimensions for grid variables.
integer, dimension(:), allocatable, parameter d
This module defines the procedures of a physics module. It contains function pointers for the various...
Definition: mod_physics.t:4
double precision phys_gamma
Definition: mod_physics.t:13
Definition: mod_ppm.t:1
subroutine, public ppmlimitervar(ixIL, ixL, idims, q, qCT, qLC, qRC)
Definition: mod_ppm.t:12
subroutine extremaq(ixIL, ixOL, q, nshift, qMax, qMin)
Definition: mod_ppm.t:318
subroutine extremaw(ixIL, ixOL, w, nshift, wMax, wMin)
Definition: mod_ppm.t:371
subroutine ppm_flatcd(ixIL, ixOL, ixLL, ixRL, w, d2w, drho, dp)
Definition: mod_ppm.t:281
subroutine ppm_flatsh(ixIL, ixOL, ixLLL, ixLL, ixRL, ixRRL, idims, w, drho, dp)
Definition: mod_ppm.t:295
subroutine, public ppmlimiter(ixIL, ixL, idims, w, wCT, wLC, wRC)
Definition: mod_ppm.t:103