19 subroutine hancock(qdt,dtfactor,ixI^L,ixO^L,idims^LIM,qtC,sCT,qt,snew,dxs,x)
25 integer,
intent(in) :: ixi^
l, ixo^
l, idims^lim
26 double precision,
intent(in) :: qdt, dtfactor,qtc, qt, dxs(
ndim), x(ixi^s,1:
ndim)
27 type(state) :: sct, snew
29 double precision,
dimension(ixI^S,1:nw) :: wprim, wlc, wrc
31 double precision,
dimension(ixI^S,1:nw) :: wlp, wrp
32 double precision,
dimension(ixO^S) :: inv_volume
33 double precision :: flc(ixi^s, nwflux), frc(ixi^s, nwflux)
34 double precision :: dxinv(1:
ndim)
35 integer :: idims, iw, ix^
l, hxo^
l
38 associate(wct=>sct%w,wnew=>snew%w)
42 ix^
l=ix^
l^laddkr(idims,^
d);
44 if (ixi^
l^ltix^
l|.or.|.or.) &
45 call mpistop(
"Error in Hancock: Nonconforming input limits")
57 hxo^
l=ixo^
l-
kr(idims,^
d);
59 wrp(hxo^s,1:nwflux)=wprim(ixo^s,1:nwflux)
60 wlp(ixo^s,1:nwflux)=wprim(ixo^s,1:nwflux)
63 call reconstruct_lr(ixi^
l,ixo^
l,hxo^
l,idims,wprim,wlc,wrc,wlp,wrp,x,dxs(idims))
73 wnew(ixo^s,iw)=wnew(ixo^s,iw)-
block%dt(ixo^s)*dtfactor/dxs(idims)* &
74 (flc(ixo^s, iw)-frc(hxo^s, iw))
78 wnew(ixo^s,iw)=wnew(ixo^s,iw)+dxinv(idims)* &
79 (flc(ixo^s, iw)-frc(hxo^s, iw))
85 wnew(ixo^s,iw)=wnew(ixo^s,iw) -
block%dt(ixo^s)*dtfactor * inv_volume &
86 *(
block%surfaceC(ixo^s,idims)*flc(ixo^s, iw) &
87 -
block%surfaceC(hxo^s,idims)*frc(hxo^s, iw))
91 wnew(ixo^s,iw)=wnew(ixo^s,iw) - qdt * inv_volume &
92 *(
block%surfaceC(ixo^s,idims)*flc(ixo^s, iw) &
93 -
block%surfaceC(hxo^s,idims)*frc(hxo^s, iw))
103 dtfactor*dble(idimsmax-idimsmin+1)/dble(
ndim),&
104 ixi^
l,ixo^
l,1,nw,qtc,wct,wprim,qt,wnew,x,.false.,active)
115 qtC,sCT,qt,snew,fC,fE,dxs,x)
124 integer,
intent(in) :: method
125 double precision,
intent(in) :: qdt, dtfactor, qtc, qt, dxs(
ndim)
126 integer,
intent(in) :: ixi^
l, ixo^
l, idims^lim
127 double precision,
dimension(ixI^S,1:ndim),
intent(in) :: x
128 type(state) :: sct, snew
129 double precision,
dimension(ixI^S,1:nwflux,1:ndim) :: fc
130 double precision,
dimension(ixI^S,sdim:3) :: fe
133 double precision,
dimension(ixI^S,1:nw) :: wprim
135 double precision,
dimension(ixI^S,1:nw) :: wlc, wrc
137 double precision,
dimension(ixI^S,1:nw) :: wlp, wrp
138 double precision,
dimension(ixI^S,1:nwflux) :: flc, frc
139 double precision,
dimension(ixI^S,1:number_species) :: cmaxc
140 double precision,
dimension(ixI^S,1:number_species) :: cminc
141 double precision,
dimension(ixI^S) :: hspeed
142 double precision,
dimension(ixO^S) :: inv_volume
143 double precision,
dimension(1:ndim) :: dxinv
144 integer,
dimension(ixI^S) :: patchf
145 integer :: idims, iw, ix^
l, hxo^
l, ixc^
l, ixcr^
l, kxc^
l, kxr^
l, ii
147 type(ct_velocity) :: vcts
149 associate(wct=>sct%w, wnew=>snew%w)
159 ix^
l=ix^
l^ladd2*
kr(idims,^
d);
161 if (ixi^
l^ltix^
l|.or.|.or.) &
162 call mpistop(
"Error in fv : Nonconforming input limits")
171 hxo^
l=ixo^
l-
kr(idims,^
d);
173 kxcmin^
d=iximin^
d; kxcmax^
d=iximax^
d-
kr(idims,^
d);
174 kxr^
l=kxc^
l+
kr(idims,^
d);
182 ixcmax^
d=ixomax^
d; ixcmin^
d=hxomin^
d;
189 wrp(kxc^s,1:
nw)=wprim(kxr^s,1:
nw)
190 wlp(kxc^s,1:
nw)=wprim(kxc^s,1:
nw)
197 call reconstruct_lr(ixi^
l,ixcr^
l,ixcr^
l,idims,wprim,wlc,wrc,wlp,wrp,x,dxs(idims))
215 call phys_get_cbounds(wlc,wrc,wlp,wrp,x,ixi^
l,ixc^
l,idims,hspeed,cmaxc,cminc)
244 call mpistop(
'unkown Riemann flux in finite volume')
253 hxo^
l=ixo^
l-
kr(idims,^
d);
258 fc(ixi^s,iw,idims)=-
block%dt(ixi^s)*dtfactor/dxs(idims)*fc(ixi^s,iw,idims)
262 fc(ixi^s,1:
nwflux,idims)=dxinv(idims)*fc(ixi^s,1:
nwflux,idims)
270 call tvdlimit2(method,qdt,ixi^
l,ixc^
l,ixo^
l,idims,wlc,wrc,wnew,x,fc,dxs)
274 inv_volume = 1.d0/
block%dvolume(ixo^s)
276 hxo^
l=ixo^
l-
kr(idims,^
d);
280 fc(ixi^s,iw,idims)=-
block%dt(ixi^s)*dtfactor*fc(ixi^s,iw,idims)*
block%surfaceC(ixi^s,idims)
281 wnew(ixo^s,iw)=wnew(ixo^s,iw) + (fc(ixo^s,iw,idims)-fc(hxo^s,iw,idims)) * &
286 fc(ixi^s,iw,idims)=-qdt*fc(ixi^s,iw,idims)*
block%surfaceC(ixi^s,idims)
287 wnew(ixo^s,iw)=wnew(ixo^s,iw) + (fc(ixo^s,iw,idims)-fc(hxo^s,iw,idims)) * &
293 call tvdlimit2(method,qdt,ixi^
l,ixc^
l,ixo^
l,idims,wlc,wrc,wnew,x,fc,dxs)
298 if (.not.
slab.and.idimsmin==1) &
314 dtfactor*dble(idimsmax-idimsmin+1)/dble(
ndim),&
315 ixi^
l,ixo^
l,1,
nw,qtc,wct,wprim,qt,wnew,x,.false.,active)
323 flc(ixc^s, iw)=half*(flc(ixc^s, iw)+frc(ixc^s, iw))
324 fc(ixc^s,iw,idims)=flc(ixc^s, iw)
328 subroutine get_riemann_flux_tvdlf(iws,iwe)
329 integer,
intent(in) :: iws,iwe
330 double precision :: fac(ixC^S)
332 fac(ixc^s) = -0.5d0*tvdlfeps*cmaxc(ixc^s,ii)
336 flc(ixc^s, iw)=0.5d0*(flc(ixc^s, iw)+frc(ixc^s, iw))
338 if (flux_type(idims, iw) /= flux_no_dissipation)
then
339 flc(ixc^s, iw)=flc(ixc^s, iw) + fac(ixc^s)*(wrc(ixc^s,iw)-wlc(ixc^s,iw))
341 fc(ixc^s,iw,idims)=flc(ixc^s, iw)
344 end subroutine get_riemann_flux_tvdlf
346 subroutine get_riemann_flux_hll(iws,iwe)
347 integer,
intent(in) :: iws,iwe
351 if(flux_type(idims, iw) == flux_tvdlf)
then
353 if(stagger_grid) cycle
354 fc(ixc^s,iw,idims) = -tvdlfeps*half*max(cmaxc(ixc^s,ii),dabs(cminc(ixc^s,ii))) * &
355 (wrc(ixc^s,iw)-wlc(ixc^s,iw))
357 {
do ix^db=ixcmin^db,ixcmax^db\}
358 if(cminc(ix^d,ii) >= zero)
then
359 fc(ix^d,iw,idims)=flc(ix^d,iw)
360 else if(cmaxc(ix^d,ii) <= zero)
then
361 fc(ix^d,iw,idims)=frc(ix^d,iw)
364 fc(ix^d,iw,idims)=(cmaxc(ix^d,ii)*flc(ix^d, iw)-cminc(ix^d,ii)*frc(ix^d,iw)&
365 +cminc(ix^d,ii)*cmaxc(ix^d,ii)*(wrc(ix^d,iw)-wlc(ix^d,iw)))&
366 /(cmaxc(ix^d,ii)-cminc(ix^d,ii))
372 end subroutine get_riemann_flux_hll
374 subroutine get_riemann_flux_hllc(iws,iwe)
375 integer,
intent(in) :: iws, iwe
376 double precision,
dimension(ixI^S,1:nwflux) :: whll, Fhll, fCD
377 double precision,
dimension(ixI^S) :: lambdaCD
379 integer :: rho_, p_, e_, mom(1:ndir)
382 if (
allocated(iw_mom)) mom(:) = iw_mom(:)
385 if(
associated(phys_hllc_init_species))
then
386 call phys_hllc_init_species(ii, rho_, mom(:), e_)
392 where(cminc(ixc^s,1) >= zero)
394 elsewhere(cmaxc(ixc^s,1) <= zero)
398 if(method==fs_hllcd) &
399 call phys_diffuse_hllcd(ixi^l,ixc^l,idims,wlc,wrc,flc,frc,patchf)
402 if(any(patchf(ixc^s)==1)) &
403 call phys_get_lcd(wlc,wrc,flc,frc,cminc(ixi^s,ii),cmaxc(ixi^s,ii),idims,ixi^l,ixc^l, &
404 whll,fhll,lambdacd,patchf)
407 if(any(abs(patchf(ixc^s))== 1))
then
409 call phys_get_wcd(wlc,wrc,whll,frc,flc,fhll,patchf,lambdacd,&
410 cminc(ixi^s,ii),cmaxc(ixi^s,ii),ixi^l,ixc^l,idims,fcd)
414 if (flux_type(idims, iw) == flux_tvdlf)
then
415 flc(ixc^s,iw)=-tvdlfeps*half*max(cmaxc(ixc^s,ii),abs(cminc(ixc^s,ii))) * &
416 (wrc(ixc^s,iw) - wlc(ixc^s,iw))
418 where(patchf(ixc^s)==-2)
419 flc(ixc^s,iw)=flc(ixc^s,iw)
420 elsewhere(abs(patchf(ixc^s))==1)
421 flc(ixc^s,iw)=fcd(ixc^s,iw)
422 elsewhere(patchf(ixc^s)==2)
423 flc(ixc^s,iw)=frc(ixc^s,iw)
424 elsewhere(patchf(ixc^s)==3)
426 flc(ixc^s,iw)=fhll(ixc^s,iw)
427 elsewhere(patchf(ixc^s)==4)
429 flc(ixc^s,iw) = half*((flc(ixc^s,iw)+frc(ixc^s,iw)) &
430 -tvdlfeps * max(cmaxc(ixc^s,ii), dabs(cminc(ixc^s,ii))) * &
431 (wrc(ixc^s,iw)-wlc(ixc^s,iw)))
435 fc(ixc^s,iw,idims)=flc(ixc^s,iw)
438 end subroutine get_riemann_flux_hllc
441 subroutine get_riemann_flux_hlld(iws,iwe)
442 integer,
intent(in) :: iws, iwe
443 double precision,
dimension(ixI^S,1:nwflux) :: w1R,w1L,f1R,f1L,f2R,f2L
444 double precision,
dimension(ixI^S,1:nwflux) :: w2R,w2L
445 double precision,
dimension(ixI^S) :: sm,s1R,s1L,suR,suL,Bx
446 double precision,
dimension(ixI^S) :: pts,ptR,ptL,signBx,r1L,r1R,tmp
448 double precision,
dimension(ixI^S,ndir) :: vRC, vLC
450 double precision,
dimension(ixI^S,ndir) :: BR, BL
451 integer :: ip1,ip2,ip3,idir,ix^D
452 integer :: rho_, p_, e_, mom(1:ndir), mag(1:ndir)
454 associate(sr=>cmaxc,sl=>cminc)
472 vrc(ixc^s,:)=wrp(ixc^s,mom(:))
473 vlc(ixc^s,:)=wlp(ixc^s,mom(:))
475 br(ixc^s,:)=wrc(ixc^s,mag(:))+block%B0(ixc^s,:,ip1)
476 bl(ixc^s,:)=wlc(ixc^s,mag(:))+block%B0(ixc^s,:,ip1)
478 br(ixc^s,:)=wrc(ixc^s,mag(:))
479 bl(ixc^s,:)=wlc(ixc^s,mag(:))
481 if(stagger_grid)
then
482 bx(ixc^s)=block%ws(ixc^s,ip1)
486 bx(ixc^s)=(sr(ixc^s,ii)*br(ixc^s,ip1)-sl(ixc^s,ii)*bl(ixc^s,ip1))/(sr(ixc^s,ii)-sl(ixc^s,ii))
488 ptr(ixc^s)=wrp(ixc^s,p_)+0.5d0*sum(br(ixc^s,:)**2,dim=ndim+1)
489 ptl(ixc^s)=wlp(ixc^s,p_)+0.5d0*sum(bl(ixc^s,:)**2,dim=ndim+1)
490 if(iw_equi_rho>0)
then
491 sur(ixc^s) = wrc(ixc^s,rho_)+ block%equi_vars(ixc^s,iw_equi_rho,ip1)
493 sur(ixc^s) = wrc(ixc^s,rho_)
495 sur(ixc^s)=(sr(ixc^s,ii)-vrc(ixc^s,ip1))*sur(ixc^s)
496 if(iw_equi_rho>0)
then
497 sul(ixc^s) = wlc(ixc^s,rho_)+ block%equi_vars(ixc^s,iw_equi_rho,ip1)
499 sul(ixc^s) = wlc(ixc^s,rho_)
501 sul(ixc^s)=(sl(ixc^s,ii)-vlc(ixc^s,ip1))*sul(ixc^s)
503 sm(ixc^s)=(sur(ixc^s)*vrc(ixc^s,ip1)-sul(ixc^s)*vlc(ixc^s,ip1)-&
504 ptr(ixc^s)+ptl(ixc^s))/(sur(ixc^s)-sul(ixc^s))
506 w1r(ixc^s,mom(ip1))=sm(ixc^s)
507 w1l(ixc^s,mom(ip1))=sm(ixc^s)
508 w2r(ixc^s,mom(ip1))=sm(ixc^s)
509 w2l(ixc^s,mom(ip1))=sm(ixc^s)
511 w1r(ixc^s,mag(ip1))=bx(ixc^s)
512 w1l(ixc^s,mag(ip1))=bx(ixc^s)
514 ptr(ixc^s)=wrp(ixc^s,p_)+0.5d0*sum(wrc(ixc^s,mag(:))**2,dim=ndim+1)
515 ptl(ixc^s)=wlp(ixc^s,p_)+0.5d0*sum(wlc(ixc^s,mag(:))**2,dim=ndim+1)
519 w1r(ixc^s,rho_)=sur(ixc^s)/(sr(ixc^s,ii)-sm(ixc^s))
520 w1l(ixc^s,rho_)=sul(ixc^s)/(sl(ixc^s,ii)-sm(ixc^s))
524 r1r(ixc^s)=sur(ixc^s)*(sr(ixc^s,ii)-sm(ixc^s))-bx(ixc^s)**2
525 where(abs(r1r(ixc^s))>smalldouble)
526 r1r(ixc^s)=1.d0/r1r(ixc^s)
530 r1l(ixc^s)=sul(ixc^s)*(sl(ixc^s,ii)-sm(ixc^s))-bx(ixc^s)**2
531 where(abs(r1l(ixc^s))>smalldouble)
532 r1l(ixc^s)=1.d0/r1l(ixc^s)
537 w1r(ixc^s,mom(ip2))=vrc(ixc^s,ip2)-bx(ixc^s)*br(ixc^s,ip2)*&
538 (sm(ixc^s)-vrc(ixc^s,ip1))*r1r(ixc^s)
539 w1l(ixc^s,mom(ip2))=vlc(ixc^s,ip2)-bx(ixc^s)*bl(ixc^s,ip2)*&
540 (sm(ixc^s)-vlc(ixc^s,ip1))*r1l(ixc^s)
542 w1r(ixc^s,mag(ip2))=(sur(ixc^s)*(sr(ixc^s,ii)-vrc(ixc^s,ip1))-bx(ixc^s)**2)*r1r(ixc^s)
543 w1l(ixc^s,mag(ip2))=(sul(ixc^s)*(sl(ixc^s,ii)-vlc(ixc^s,ip1))-bx(ixc^s)**2)*r1l(ixc^s)
548 w1r(ixc^s,mom(ip3))=vrc(ixc^s,ip3)-bx(ixc^s)*br(ixc^s,ip3)*&
549 (sm(ixc^s)-vrc(ixc^s,ip1))*r1r(ixc^s)
550 w1l(ixc^s,mom(ip3))=vlc(ixc^s,ip3)-bx(ixc^s)*bl(ixc^s,ip3)*&
551 (sm(ixc^s)-vlc(ixc^s,ip1))*r1l(ixc^s)
553 w1r(ixc^s,mag(ip3))=br(ixc^s,ip3)*w1r(ixc^s,mag(ip2))
554 w1l(ixc^s,mag(ip3))=bl(ixc^s,ip3)*w1l(ixc^s,mag(ip2))
557 w1r(ixc^s,mag(ip2))=br(ixc^s,ip2)*w1r(ixc^s,mag(ip2))
558 w1l(ixc^s,mag(ip2))=bl(ixc^s,ip2)*w1l(ixc^s,mag(ip2))
561 w1r(ixc^s,mag(:))=w1r(ixc^s,mag(:))-block%B0(ixc^s,:,ip1)
562 w1l(ixc^s,mag(:))=w1l(ixc^s,mag(:))-block%B0(ixc^s,:,ip1)
567 w1r(ixc^s,p_)=sur(ixc^s)*(sm(ixc^s)-vrc(ixc^s,ip1))+ptr(ixc^s)
569 w1l(ixc^s,p_)=w1r(ixc^s,p_)
572 w1r(ixc^s,p_)=w1r(ixc^s,p_)+sum(block%B0(ixc^s,:,ip1)*(wrc(ixc^s,mag(:))-w1r(ixc^s,mag(:))),dim=ndim+1)
573 w1l(ixc^s,p_)=w1l(ixc^s,p_)+sum(block%B0(ixc^s,:,ip1)*(wlc(ixc^s,mag(:))-w1l(ixc^s,mag(:))),dim=ndim+1)
576 w1r(ixc^s,e_)=((sr(ixc^s,ii)-vrc(ixc^s,ip1))*wrc(ixc^s,e_)-ptr(ixc^s)*vrc(ixc^s,ip1)+&
577 w1r(ixc^s,p_)*sm(ixc^s)+bx(ixc^s)*(sum(vrc(ixc^s,:)*wrc(ixc^s,mag(:)),dim=ndim+1)-&
578 sum(w1r(ixc^s,mom(:))*w1r(ixc^s,mag(:)),dim=ndim+1)))/(sr(ixc^s,ii)-sm(ixc^s))
579 w1l(ixc^s,e_)=((sl(ixc^s,ii)-vlc(ixc^s,ip1))*wlc(ixc^s,e_)-ptl(ixc^s)*vlc(ixc^s,ip1)+&
580 w1l(ixc^s,p_)*sm(ixc^s)+bx(ixc^s)*(sum(vlc(ixc^s,:)*wlc(ixc^s,mag(:)),dim=ndim+1)-&
581 sum(w1l(ixc^s,mom(:))*w1l(ixc^s,mag(:)),dim=ndim+1)))/(sl(ixc^s,ii)-sm(ixc^s))
584 w1r(ixc^s,e_)=w1r(ixc^s,e_)+(sum(w1r(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*sm(ixc^s)-&
585 sum(wrc(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*vrc(ixc^s,ip1))/(sr(ixc^s,ii)-sm(ixc^s))
586 w1l(ixc^s,e_)=w1l(ixc^s,e_)+(sum(w1l(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*sm(ixc^s)-&
587 sum(wlc(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*vlc(ixc^s,ip1))/(sl(ixc^s,ii)-sm(ixc^s))
590 #if !defined(E_RM_W0) || E_RM_W0 == 1
591 w1r(ixc^s,e_)= w1r(ixc^s,e_) + 1d0/(phys_gamma - 1) * block%equi_vars(ixc^s,iw_equi_p,ip1) * &
592 (sm(ixc^s)-vrc(ixc^s,ip1))/(sr(ixc^s,ii)-sm(ixc^s))
593 w1l(ixc^s,e_)= w1l(ixc^s,e_) + 1d0/(phys_gamma - 1) * block%equi_vars(ixc^s,iw_equi_p,ip1) * &
594 (sm(ixc^s)-vlc(ixc^s,ip1))/(sl(ixc^s,ii)-sm(ixc^s))
596 w1r(ixc^s,e_)= w1r(ixc^s,e_) + phys_gamma /(phys_gamma - 1) * block%equi_vars(ixc^s,iw_equi_p,ip1) * &
597 (sm(ixc^s)-vrc(ixc^s,ip1))/(sr(ixc^s,ii)-sm(ixc^s))
598 w1l(ixc^s,e_)= w1l(ixc^s,e_) + phys_gamma /(phys_gamma - 1) * block%equi_vars(ixc^s,iw_equi_p,ip1) * &
599 (sm(ixc^s)-vlc(ixc^s,ip1))/(sl(ixc^s,ii)-sm(ixc^s))
605 w2r(ixc^s,rho_)=w1r(ixc^s,rho_)
606 w2l(ixc^s,rho_)=w1l(ixc^s,rho_)
607 w2r(ixc^s,mag(ip1))=w1r(ixc^s,mag(ip1))
608 w2l(ixc^s,mag(ip1))=w1l(ixc^s,mag(ip1))
610 r1r(ixc^s)=sqrt(w1r(ixc^s,rho_))
611 r1l(ixc^s)=sqrt(w1l(ixc^s,rho_))
612 tmp(ixc^s)=1.d0/(r1r(ixc^s)+r1l(ixc^s))
613 signbx(ixc^s)=sign(1.d0,bx(ixc^s))
615 s1r(ixc^s)=sm(ixc^s)+abs(bx(ixc^s))/r1r(ixc^s)
616 s1l(ixc^s)=sm(ixc^s)-abs(bx(ixc^s))/r1l(ixc^s)
618 w2r(ixc^s,mom(ip2))=(r1l(ixc^s)*w1l(ixc^s,mom(ip2))+r1r(ixc^s)*w1r(ixc^s,mom(ip2))+&
619 (w1r(ixc^s,mag(ip2))-w1l(ixc^s,mag(ip2)))*signbx(ixc^s))*tmp(ixc^s)
620 w2l(ixc^s,mom(ip2))=w2r(ixc^s,mom(ip2))
622 w2r(ixc^s,mag(ip2))=(r1l(ixc^s)*w1r(ixc^s,mag(ip2))+r1r(ixc^s)*w1l(ixc^s,mag(ip2))+&
623 r1l(ixc^s)*r1r(ixc^s)*(w1r(ixc^s,mom(ip2))-w1l(ixc^s,mom(ip2)))*signbx(ixc^s))*tmp(ixc^s)
624 w2l(ixc^s,mag(ip2))=w2r(ixc^s,mag(ip2))
627 w2r(ixc^s,mom(ip3))=(r1l(ixc^s)*w1l(ixc^s,mom(ip3))+r1r(ixc^s)*w1r(ixc^s,mom(ip3))+&
628 (w1r(ixc^s,mag(ip3))-w1l(ixc^s,mag(ip3)))*signbx(ixc^s))*tmp(ixc^s)
629 w2l(ixc^s,mom(ip3))=w2r(ixc^s,mom(ip3))
631 w2r(ixc^s,mag(ip3))=(r1l(ixc^s)*w1r(ixc^s,mag(ip3))+r1r(ixc^s)*w1l(ixc^s,mag(ip3))+&
632 r1l(ixc^s)*r1r(ixc^s)*(w1r(ixc^s,mom(ip3))-w1l(ixc^s,mom(ip3)))*signbx(ixc^s))*tmp(ixc^s)
633 w2l(ixc^s,mag(ip3))=w2r(ixc^s,mag(ip3))
637 w2r(ixc^s,e_)=w1r(ixc^s,e_)+r1r(ixc^s)*(sum(w1r(ixc^s,mom(:))*w1r(ixc^s,mag(:)),dim=ndim+1)-&
638 sum(w2r(ixc^s,mom(:))*w2r(ixc^s,mag(:)),dim=ndim+1))*signbx(ixc^s)
639 w2l(ixc^s,e_)=w1l(ixc^s,e_)-r1l(ixc^s)*(sum(w1l(ixc^s,mom(:))*w1l(ixc^s,mag(:)),dim=ndim+1)-&
640 sum(w2l(ixc^s,mom(:))*w2l(ixc^s,mag(:)),dim=ndim+1))*signbx(ixc^s)
645 w1r(ixc^s,mom(idir))=w1r(ixc^s,mom(idir))*w1r(ixc^s,rho_)
646 w1l(ixc^s,mom(idir))=w1l(ixc^s,mom(idir))*w1l(ixc^s,rho_)
647 w2r(ixc^s,mom(idir))=w2r(ixc^s,mom(idir))*w2r(ixc^s,rho_)
648 w2l(ixc^s,mom(idir))=w2l(ixc^s,mom(idir))*w2l(ixc^s,rho_)
650 if(iw_equi_rho>0)
then
651 w1r(ixc^s,rho_) = w1r(ixc^s,rho_) - block%equi_vars(ixc^s,iw_equi_rho,ip1)
652 w1l(ixc^s,rho_) = w1l(ixc^s,rho_) - block%equi_vars(ixc^s,iw_equi_rho,ip1)
653 w2r(ixc^s,rho_) = w2r(ixc^s,rho_) - block%equi_vars(ixc^s,iw_equi_rho,ip1)
654 w2l(ixc^s,rho_) = w2l(ixc^s,rho_) - block%equi_vars(ixc^s,iw_equi_rho,ip1)
658 if(flux_type(idims, iw) == flux_special)
then
660 f1l(ixc^s,iw)=flc(ixc^s,iw)
661 f1r(ixc^s,iw)=f1l(ixc^s,iw)
662 f2l(ixc^s,iw)=f1l(ixc^s,iw)
663 f2r(ixc^s,iw)=f1l(ixc^s,iw)
664 else if(flux_type(idims, iw) == flux_hll)
then
666 f1l(ixc^s,iw)=(sr(ixc^s,ii)*flc(ixc^s, iw)-sl(ixc^s,ii)*frc(ixc^s, iw) &
667 +sr(ixc^s,ii)*sl(ixc^s,ii)*(wrc(ixc^s,iw)-wlc(ixc^s,iw)))/(sr(ixc^s,ii)-sl(ixc^s,ii))
668 f1r(ixc^s,iw)=f1l(ixc^s,iw)
669 f2l(ixc^s,iw)=f1l(ixc^s,iw)
670 f2r(ixc^s,iw)=f1l(ixc^s,iw)
673 f1l(ixc^s,iw)=flc(ixc^s,iw)+sl(ixc^s,ii)*(w1l(ixc^s,iw)-wlc(ixc^s,iw))
674 f1r(ixc^s,iw)=frc(ixc^s,iw)+sr(ixc^s,ii)*(w1r(ixc^s,iw)-wrc(ixc^s,iw))
675 f2l(ixc^s,iw)=f1l(ixc^s,iw)+s1l(ixc^s)*(w2l(ixc^s,iw)-w1l(ixc^s,iw))
676 f2r(ixc^s,iw)=f1r(ixc^s,iw)+s1r(ixc^s)*(w2r(ixc^s,iw)-w1r(ixc^s,iw))
681 {
do ix^db=ixcmin^db,ixcmax^db\}
682 if(sl(ix^d,ii)>0.d0)
then
683 fc(ix^d,iws:iwe,ip1)=flc(ix^d,iws:iwe)
684 else if(s1l(ix^d)>=0.d0)
then
685 fc(ix^d,iws:iwe,ip1)=f1l(ix^d,iws:iwe)
686 else if(sm(ix^d)>=0.d0)
then
687 fc(ix^d,iws:iwe,ip1)=f2l(ix^d,iws:iwe)
688 else if(s1r(ix^d)>=0.d0)
then
689 fc(ix^d,iws:iwe,ip1)=f2r(ix^d,iws:iwe)
690 else if(sr(ix^d,ii)>=0.d0)
then
691 fc(ix^d,iws:iwe,ip1)=f1r(ix^d,iws:iwe)
692 else if(sr(ix^d,ii)<0.d0)
then
693 fc(ix^d,iws:iwe,ip1)=frc(ix^d,iws:iwe)
698 end subroutine get_riemann_flux_hlld
702 subroutine get_riemann_flux_hlld_mag2()
707 double precision,
dimension(ixI^S,1:nwflux) :: w1R,w1L,f1R,f1L,f2R,f2L
708 double precision,
dimension(ixI^S,1:nwflux) :: w2R,w2L
709 double precision,
dimension(ixI^S) :: sm,s1R,s1L,suR,suL,Bx
710 double precision,
dimension(ixI^S) :: pts,ptR,ptL,signBx,r1L,r1R,tmp
712 double precision,
dimension(ixI^S,ndir) :: vRC, vLC
714 double precision,
dimension(ixI^S,ndir) :: BR, BL
715 integer :: ip1,ip2,ip3,idir,ix^D
716 double precision :: phiPres, thetaSM, du, dv, dw
717 integer :: ixV^L, ixVb^L, ixVc^L, ixVd^L, ixVe^L, ixVf^L
718 integer :: rho_, p_, e_, mom(1:ndir), mag(1:ndir)
719 double precision,
parameter :: aParam = 4d0
727 associate(sr=>cmaxc,sl=>cminc)
734 vrc(ixc^s,:)=wrp(ixc^s,mom(:))
735 vlc(ixc^s,:)=wlp(ixc^s,mom(:))
741 phipres = min(1d0, maxval(max(s1l(ixo^s),s1r(ixo^s)))/maxval(cmaxc(ixo^s,1)))
742 phipres = phipres*(2d0 - phipres)
749 du = minval(wprim(ixv^s,mom(1))-wprim(ixo^s,mom(1)))
785 dv = minval(min(wprim(ixo^s,mom(2))-wprim(ixv^s,mom(2)),&
786 wprim(ixvb^s,mom(2))-wprim(ixo^s,mom(2)),&
787 wprim(ixvc^s,mom(2))-wprim(ixvd^s,mom(2)),&
788 wprim(ixve^s,mom(2))-wprim(ixvc^s,mom(2))&
822 dw = minval(min(wprim(ixo^s,mom(3))-wprim(ixv^s,mom(3)),&
823 wprim(ixvb^s,mom(3))-wprim(ixo^s,mom(3)),&
824 wprim(ixvc^s,mom(3))-wprim(ixvd^s,mom(3)),&
825 wprim(ixve^s,mom(3))-wprim(ixvc^s,mom(3))&
828 thetasm = maxval(cmaxc(ixo^s,1))
830 thetasm = (min(1d0, (thetasm-du)/(thetasm-min(dv,dw))))**aparam
834 br(ixc^s,:)=wrc(ixc^s,mag(:))+block%B0(ixc^s,:,ip1)
835 bl(ixc^s,:)=wlc(ixc^s,mag(:))+block%B0(ixc^s,:,ip1)
837 br(ixc^s,:)=wrc(ixc^s,mag(:))
838 bl(ixc^s,:)=wlc(ixc^s,mag(:))
843 ptr(ixc^s)=wrp(ixc^s,p_)+0.5d0*sum(br(ixc^s,:)**2,dim=ndim+1)
844 ptl(ixc^s)=wlp(ixc^s,p_)+0.5d0*sum(bl(ixc^s,:)**2,dim=ndim+1)
845 sur(ixc^s)=(sr(ixc^s,
index_v_mag)-vrc(ixc^s,ip1))*wrc(ixc^s,rho_)
846 sul(ixc^s)=(sl(ixc^s,
index_v_mag)-vlc(ixc^s,ip1))*wlc(ixc^s,rho_)
848 sm(ixc^s)=(sur(ixc^s)*vrc(ixc^s,ip1)-sul(ixc^s)*vlc(ixc^s,ip1)-&
849 thetasm*(ptr(ixc^s)-ptl(ixc^s)) )/(sur(ixc^s)-sul(ixc^s))
851 w1r(ixc^s,mom(ip1))=sm(ixc^s)
852 w1l(ixc^s,mom(ip1))=sm(ixc^s)
853 w2r(ixc^s,mom(ip1))=sm(ixc^s)
854 w2l(ixc^s,mom(ip1))=sm(ixc^s)
856 w1r(ixc^s,mag(ip1))=bx(ixc^s)
857 w1l(ixc^s,mag(ip1))=bx(ixc^s)
859 ptr(ixc^s)=wrp(ixc^s,p_)+0.5d0*sum(wrc(ixc^s,mag(:))**2,dim=ndim+1)
860 ptl(ixc^s)=wlp(ixc^s,p_)+0.5d0*sum(wlc(ixc^s,mag(:))**2,dim=ndim+1)
864 w1r(ixc^s,rho_)=sur(ixc^s)/(sr(ixc^s,
index_v_mag)-sm(ixc^s))
865 w1l(ixc^s,rho_)=sul(ixc^s)/(sl(ixc^s,
index_v_mag)-sm(ixc^s))
869 r1r(ixc^s)=sur(ixc^s)*(sr(ixc^s,
index_v_mag)-sm(ixc^s))-bx(ixc^s)**2
870 where(r1r(ixc^s)/=0.d0)
871 r1r(ixc^s)=1.d0/r1r(ixc^s)
873 r1l(ixc^s)=sul(ixc^s)*(sl(ixc^s,
index_v_mag)-sm(ixc^s))-bx(ixc^s)**2
874 where(r1l(ixc^s)/=0.d0)
875 r1l(ixc^s)=1.d0/r1l(ixc^s)
878 w1r(ixc^s,mom(ip2))=vrc(ixc^s,ip2)-bx(ixc^s)*br(ixc^s,ip2)*&
879 (sm(ixc^s)-vrc(ixc^s,ip1))*r1r(ixc^s)
880 w1l(ixc^s,mom(ip2))=vlc(ixc^s,ip2)-bx(ixc^s)*bl(ixc^s,ip2)*&
881 (sm(ixc^s)-vlc(ixc^s,ip1))*r1l(ixc^s)
883 w1r(ixc^s,mag(ip2))=(sur(ixc^s)*(sr(ixc^s,
index_v_mag)-vrc(ixc^s,ip1))-bx(ixc^s)**2)*r1r(ixc^s)
884 w1l(ixc^s,mag(ip2))=(sul(ixc^s)*(sl(ixc^s,
index_v_mag)-vlc(ixc^s,ip1))-bx(ixc^s)**2)*r1l(ixc^s)
889 w1r(ixc^s,mom(ip3))=vrc(ixc^s,ip3)-bx(ixc^s)*br(ixc^s,ip3)*&
890 (sm(ixc^s)-vrc(ixc^s,ip1))*r1r(ixc^s)
891 w1l(ixc^s,mom(ip3))=vlc(ixc^s,ip3)-bx(ixc^s)*bl(ixc^s,ip3)*&
892 (sm(ixc^s)-vlc(ixc^s,ip1))*r1l(ixc^s)
894 w1r(ixc^s,mag(ip3))=br(ixc^s,ip3)*w1r(ixc^s,mag(ip2))
895 w1l(ixc^s,mag(ip3))=bl(ixc^s,ip3)*w1l(ixc^s,mag(ip2))
898 w1r(ixc^s,mag(ip2))=br(ixc^s,ip2)*w1r(ixc^s,mag(ip2))
899 w1l(ixc^s,mag(ip2))=bl(ixc^s,ip2)*w1l(ixc^s,mag(ip2))
902 w1r(ixc^s,mag(:))=w1r(ixc^s,mag(:))-block%B0(ixc^s,:,ip1)
903 w1l(ixc^s,mag(:))=w1l(ixc^s,mag(:))-block%B0(ixc^s,:,ip1)
908 w1r(ixc^s,p_)=(sur(ixc^s)*ptl(ixc^s) - sul(ixc^s)*ptr(ixc^s) +&
909 phipres * sur(ixc^s)*sul(ixc^s)*(vrc(ixc^s,ip1)-vlc(ixc^s,ip1)))/&
910 (sur(ixc^s)-sul(ixc^s))
911 w1l(ixc^s,p_)=w1r(ixc^s,p_)
914 w1r(ixc^s,p_)=w1r(ixc^s,p_)+sum(block%B0(ixc^s,:,ip1)*(wrc(ixc^s,mag(:))-w1r(ixc^s,mag(:))),dim=ndim+1)
915 w1l(ixc^s,p_)=w1l(ixc^s,p_)+sum(block%B0(ixc^s,:,ip1)*(wlc(ixc^s,mag(:))-w1l(ixc^s,mag(:))),dim=ndim+1)
918 w1r(ixc^s,e_)=((sr(ixc^s,
index_v_mag)-vrc(ixc^s,ip1))*wrc(ixc^s,e_)-ptr(ixc^s)*vrc(ixc^s,ip1)+&
919 w1r(ixc^s,p_)*sm(ixc^s)+bx(ixc^s)*(sum(vrc(ixc^s,:)*wrc(ixc^s,mag(:)),dim=ndim+1)-&
920 sum(w1r(ixc^s,mom(:))*w1r(ixc^s,mag(:)),dim=ndim+1)))/(sr(ixc^s,
index_v_mag)-sm(ixc^s))
921 w1l(ixc^s,e_)=((sl(ixc^s,
index_v_mag)-vlc(ixc^s,ip1))*wlc(ixc^s,e_)-ptl(ixc^s)*vlc(ixc^s,ip1)+&
922 w1l(ixc^s,p_)*sm(ixc^s)+bx(ixc^s)*(sum(vlc(ixc^s,:)*wlc(ixc^s,mag(:)),dim=ndim+1)-&
923 sum(w1l(ixc^s,mom(:))*w1l(ixc^s,mag(:)),dim=ndim+1)))/(sl(ixc^s,
index_v_mag)-sm(ixc^s))
926 w1r(ixc^s,e_)=w1r(ixc^s,e_)+(sum(w1r(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*sm(ixc^s)-&
927 sum(wrc(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*vrc(ixc^s,ip1))/(sr(ixc^s,
index_v_mag)-sm(ixc^s))
928 w1l(ixc^s,e_)=w1l(ixc^s,e_)+(sum(w1l(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*sm(ixc^s)-&
929 sum(wlc(ixc^s,mag(:))*block%B0(ixc^s,:,ip1),dim=ndim+1)*vlc(ixc^s,ip1))/(sl(ixc^s,
index_v_mag)-sm(ixc^s))
934 w2r(ixc^s,rho_)=w1r(ixc^s,rho_)
935 w2l(ixc^s,rho_)=w1l(ixc^s,rho_)
936 w2r(ixc^s,mag(ip1))=w1r(ixc^s,mag(ip1))
937 w2l(ixc^s,mag(ip1))=w1l(ixc^s,mag(ip1))
939 r1r(ixc^s)=sqrt(w1r(ixc^s,rho_))
940 r1l(ixc^s)=sqrt(w1l(ixc^s,rho_))
941 tmp(ixc^s)=1.d0/(r1r(ixc^s)+r1l(ixc^s))
942 signbx(ixc^s)=sign(1.d0,bx(ixc^s))
944 s1r(ixc^s)=sm(ixc^s)+abs(bx(ixc^s))/r1r(ixc^s)
945 s1l(ixc^s)=sm(ixc^s)-abs(bx(ixc^s))/r1l(ixc^s)
947 w2r(ixc^s,mom(ip2))=(r1l(ixc^s)*w1l(ixc^s,mom(ip2))+r1r(ixc^s)*w1r(ixc^s,mom(ip2))+&
948 (w1r(ixc^s,mag(ip2))-w1l(ixc^s,mag(ip2)))*signbx(ixc^s))*tmp(ixc^s)
949 w2l(ixc^s,mom(ip2))=w2r(ixc^s,mom(ip2))
951 w2r(ixc^s,mag(ip2))=(r1l(ixc^s)*w1r(ixc^s,mag(ip2))+r1r(ixc^s)*w1l(ixc^s,mag(ip2))+&
952 r1l(ixc^s)*r1r(ixc^s)*(w1r(ixc^s,mom(ip2))-w1l(ixc^s,mom(ip2)))*signbx(ixc^s))*tmp(ixc^s)
953 w2l(ixc^s,mag(ip2))=w2r(ixc^s,mag(ip2))
956 w2r(ixc^s,mom(ip3))=(r1l(ixc^s)*w1l(ixc^s,mom(ip3))+r1r(ixc^s)*w1r(ixc^s,mom(ip3))+&
957 (w1r(ixc^s,mag(ip3))-w1l(ixc^s,mag(ip3)))*signbx(ixc^s))*tmp(ixc^s)
958 w2l(ixc^s,mom(ip3))=w2r(ixc^s,mom(ip3))
960 w2r(ixc^s,mag(ip3))=(r1l(ixc^s)*w1r(ixc^s,mag(ip3))+r1r(ixc^s)*w1l(ixc^s,mag(ip3))+&
961 r1l(ixc^s)*r1r(ixc^s)*(w1r(ixc^s,mom(ip3))-w1l(ixc^s,mom(ip3)))*signbx(ixc^s))*tmp(ixc^s)
962 w2l(ixc^s,mag(ip3))=w2r(ixc^s,mag(ip3))
966 w2r(ixc^s,e_)=w1r(ixc^s,e_)+r1r(ixc^s)*(sum(w1r(ixc^s,mom(:))*w1r(ixc^s,mag(:)),dim=ndim+1)-&
967 sum(w2r(ixc^s,mom(:))*w2r(ixc^s,mag(:)),dim=ndim+1))*signbx(ixc^s)
968 w2l(ixc^s,e_)=w1l(ixc^s,e_)-r1l(ixc^s)*(sum(w1l(ixc^s,mom(:))*w1l(ixc^s,mag(:)),dim=ndim+1)-&
969 sum(w2l(ixc^s,mom(:))*w2l(ixc^s,mag(:)),dim=ndim+1))*signbx(ixc^s)
974 w1r(ixc^s,mom(idir))=w1r(ixc^s,mom(idir))*w1r(ixc^s,rho_)
975 w1l(ixc^s,mom(idir))=w1l(ixc^s,mom(idir))*w1l(ixc^s,rho_)
976 w2r(ixc^s,mom(idir))=w2r(ixc^s,mom(idir))*w2r(ixc^s,rho_)
977 w2l(ixc^s,mom(idir))=w2l(ixc^s,mom(idir))*w2l(ixc^s,rho_)
986 f1l(ixc^s,iw)=flc(ixc^s,iw)
987 f1r(ixc^s,iw)=f1l(ixc^s,iw)
988 f2l(ixc^s,iw)=f1l(ixc^s,iw)
989 f2r(ixc^s,iw)=f1l(ixc^s,iw)
994 f1r(ixc^s,iw)=f1l(ixc^s,iw)
995 f2l(ixc^s,iw)=f1l(ixc^s,iw)
996 f2r(ixc^s,iw)=f1l(ixc^s,iw)
998 f1l(ixc^s,iw)=flc(ixc^s,iw)+sl(ixc^s,
index_v_mag)*(w1l(ixc^s,iw)-wlc(ixc^s,iw))
999 f1r(ixc^s,iw)=frc(ixc^s,iw)+sr(ixc^s,
index_v_mag)*(w1r(ixc^s,iw)-wrc(ixc^s,iw))
1000 f2l(ixc^s,iw)=f1l(ixc^s,iw)+s1l(ixc^s)*(w2l(ixc^s,iw)-w1l(ixc^s,iw))
1001 f2r(ixc^s,iw)=f1r(ixc^s,iw)+s1r(ixc^s)*(w2r(ixc^s,iw)-w1r(ixc^s,iw))
1006 {
do ix^db=ixcmin^db,ixcmax^db\}
1009 else if(s1l(ix^d)>=0.d0)
then
1011 else if(sm(ix^d)>=0.d0)
then
1013 else if(s1r(ix^d)>=0.d0)
then
1023 end subroutine get_riemann_flux_hlld_mag2
1029 integer,
intent(in) :: ixI^L, ixO^L
1030 double precision,
intent(in) :: w(ixI^S, nw), x(ixI^S,1:ndim)
1031 double precision,
intent(out):: csound(ixI^S)
1032 double precision :: cfast2(ixI^S), AvMinCs2(ixI^S), b2(ixI^S), kmax
1033 double precision :: inv_rho(ixO^S), gamma_A2(ixO^S)
1034 integer :: rho_, p_, e_, mom(1:ndir), mag(1:ndir)
1042 inv_rho=1.d0/w(ixo^s,rho_)
1047 b2(ixo^s) = sum((w(ixo^s, mag(:))+
block%B0(ixo^s,:,
b0i))**2, dim=ndim+1)
1049 b2(ixo^s) = sum(w(ixo^s, mag(:))**2, dim=ndim+1)
1054 avmincs2= w(ixo^s, mag(idims))+
block%B0(ixo^s,idims,
b0i)
1056 avmincs2= w(ixo^s, mag(idims))
1060 csound(ixo^s) = sum(w(ixo^s, mom(:))**2, dim=ndim+1)
1062 cfast2(ixo^s) = b2(ixo^s) * inv_rho+csound(ixo^s)
1063 avmincs2(ixo^s) = cfast2(ixo^s)**2-4.0d0*csound(ixo^s) &
1064 * avmincs2(ixo^s)**2 &
1067 where(avmincs2(ixo^s)<zero)
1068 avmincs2(ixo^s)=zero
1071 avmincs2(ixo^s)=sqrt(avmincs2(ixo^s))
1073 csound(ixo^s) = sqrt(half*(cfast2(ixo^s)+avmincs2(ixo^s)))
1081 subroutine reconstruct_lr(ixI^L,ixL^L,ixR^L,idims,w,wLC,wRC,wLp,wRp,x,dxdim)
1087 integer,
intent(in) :: ixi^
l, ixl^
l, ixr^
l, idims
1088 double precision,
intent(in) :: dxdim
1090 double precision,
dimension(ixI^S,1:nw) :: w
1092 double precision,
dimension(ixI^S,1:nw) :: wlc, wrc
1094 double precision,
dimension(ixI^S,1:nw) :: wlp, wrp
1095 double precision,
dimension(ixI^S,1:ndim) :: x
1097 integer :: jxr^
l, ixc^
l, jxc^
l, iw
1098 double precision :: ldw(ixi^s), rdw(ixi^s), dwc(ixi^s)
1099 double precision :: a2max
1103 call mp5limiter(ixi^
l,ixl^
l,idims,w,wlp,wrp)
1105 call weno3limiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,1)
1107 call weno3limiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,2)
1109 call weno5limiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,1)
1111 call weno5nmlimiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,1)
1113 call weno5limiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,2)
1115 call weno5nmlimiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,2)
1117 call weno5limiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,3)
1119 call weno5nmlimiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp,3)
1121 call weno5cu6limiter(ixi^
l,ixl^
l,idims,w,wlp,wrp)
1123 call teno5adlimiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp)
1125 call weno7limiter(ixi^
l,ixl^
l,idims,w,wlp,wrp,1)
1127 call weno7limiter(ixi^
l,ixl^
l,idims,w,wlp,wrp,2)
1129 call venklimiter(ixi^
l,ixl^
l,idims,dxdim,w,wlp,wrp)
1135 call ppmlimiter(ixi^
l,
ixm^
ll,idims,w,w,wlp,wrp)
1141 jxr^
l=ixr^
l+
kr(idims,^
d);
1142 ixcmax^
d=jxrmax^
d; ixcmin^
d=ixlmin^
d-
kr(idims,^
d);
1143 jxc^
l=ixc^
l+
kr(idims,^
d);
1146 w(ixcmin^
d:jxcmax^
d,iw)=dlog10(w(ixcmin^
d:jxcmax^
d,iw))
1147 wlp(ixl^s,iw)=dlog10(wlp(ixl^s,iw))
1148 wrp(ixr^s,iw)=dlog10(wrp(ixr^s,iw))
1151 dwc(ixc^s)=w(jxc^s,iw)-w(ixc^s,iw)
1167 call mpistop(
"idims is wrong in mod_limiter")
1173 wlp(ixl^s,iw)=wlp(ixl^s,iw)+half*ldw(ixl^s)
1174 wrp(ixr^s,iw)=wrp(ixr^s,iw)-half*rdw(jxr^s)
1177 w(ixcmin^
d:jxcmax^
d,iw)=10.0d0**w(ixcmin^
d:jxcmax^
d,iw)
1178 wlp(ixl^s,iw)=10.0d0**wlp(ixl^s,iw)
1179 wrp(ixr^s,iw)=10.0d0**wrp(ixr^s,iw)
1188 wlc(ixl^s,1:nwflux) = wlp(ixl^s,1:nwflux)
1189 wrc(ixr^s,1:nwflux) = wrp(ixr^s,1:nwflux)
1193 wlp(ixl^s,nwflux+1:nwflux+nwaux) = wlc(ixl^s,nwflux+1:nwflux+nwaux)
1194 wrp(ixr^s,nwflux+1:nwflux+nwaux) = wrc(ixr^s,nwflux+1:nwflux+nwaux)
subroutine get_hlld2_modif_c(w, x, ixIL, ixOL, csound)
Calculate fast magnetosonic wave speed.
subroutine get_riemann_flux_tvdmu()
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Module with finite volume methods for fluxes.
subroutine, public finite_volume(method, qdt, dtfactor, ixIL, ixOL, idimsLIM, qtC, sCT, qt, snew, fC, fE, dxs, x)
finite volume method
subroutine, public reconstruct_lr(ixIL, ixLL, ixRL, idims, w, wLC, wRC, wLp, wRp, x, dxdim)
Determine the upwinded wLC(ixL) and wRC(ixR) from w. the wCT is only used when PPM is exploited.
subroutine, public hancock(qdt, dtfactor, ixIL, ixOL, idimsLIM, qtC, sCT, qt, snew, dxs, x)
The non-conservative Hancock predictor for TVDLF.
This module contains definitions of global parameters and variables and some generic functions/subrou...
type(state), pointer block
Block pointer for using one block and its previous state.
logical h_correction
If true, do H-correction to fix the carbuncle problem at grid-aligned shocks.
integer, parameter fs_tvdlf
integer ixghi
Upper index of grid block arrays.
integer, parameter fs_hlld
integer, dimension(3, 3) kr
Kronecker delta tensor.
logical, dimension(:), allocatable loglimit
integer, parameter fs_hllcd
integer, parameter ndim
Number of spatial dimensions for grid variables.
logical stagger_grid
True for using stagger grid.
integer, parameter fs_tvdmu
integer b0i
background magnetic field location indicator
integer, dimension(:), allocatable, parameter d
logical local_timestep
each cell has its own timestep or not
logical need_global_a2max
global value for schmid scheme
integer ixm
the mesh range of a physical block without ghost cells
logical slab
Cartesian geometry or not.
integer, parameter fs_hll
flux schemes
logical b0field
split magnetic field as background B0 field
integer, dimension(:), allocatable type_limiter
Type of slope limiter used for reconstructing variables on cell edges.
integer nghostcells
Number of ghost cells surrounding a grid.
logical crash
Save a snapshot before crash a run met unphysical values.
logical slab_uniform
uniform Cartesian geometry or not (stretched Cartesian)
integer, parameter fs_hllc
double precision, dimension(ndim) a2max_global
global largest a2 for schmid scheme
integer, parameter ixglo
Lower index of grid block arrays (always 1)
Module with slope/flux limiters.
integer, parameter limiter_weno5cu6
integer, parameter limiter_mpweno7
integer, parameter limiter_teno5ad
integer, parameter limiter_weno3
integer, parameter limiter_ppm
subroutine dwlimiter2(dwC, ixIL, ixCL, idims, typelim, ldw, rdw, a2max)
Limit the centered dwC differences within ixC for iw in direction idim. The limiter is chosen accordi...
integer, parameter limiter_wenozp5
integer, parameter limiter_weno5
integer, parameter limiter_wenoz5
integer, parameter limiter_wenoz5nm
integer, parameter limiter_weno7
integer, parameter limiter_wenozp5nm
integer, parameter limiter_mp5
integer, parameter limiter_venk
integer, parameter limiter_weno5nm
integer, parameter limiter_wenoyc3
This module defines the procedures of a physics module. It contains function pointers for the various...
procedure(sub_get_ct_velocity), pointer phys_get_ct_velocity
procedure(sub_convert), pointer phys_to_primitive
integer, parameter flux_tvdlf
Indicates the flux should be treated with tvdlf.
procedure(sub_small_values), pointer phys_handle_small_values
procedure(sub_get_flux), pointer phys_get_flux
procedure(sub_get_cbounds), pointer phys_get_cbounds
integer, parameter flux_hll
Indicates the flux should be treated with hll.
procedure(sub_add_source_geom), pointer phys_add_source_geom
integer, parameter flux_special
Indicates the flux should be specially treated.
integer, dimension(:, :), allocatable flux_type
Array per direction per variable, which can be used to specify that certain fluxes have to be treated...
integer phys_wider_stencil
To use wider stencils in flux calculations. A value of 1 will extend it by one cell in both direction...
procedure(sub_update_faces), pointer phys_update_faces
procedure(sub_convert), pointer phys_to_conserved
procedure(sub_face_to_center), pointer phys_face_to_center
procedure(sub_modify_wlr), pointer phys_modify_wlr
procedure(sub_get_h_speed), pointer phys_get_h_speed
logical phys_energy
Solve energy equation or not.
Module for handling split source terms (split from the fluxes)
subroutine, public addsource2(qdt, dtfactor, ixIL, ixOL, iwLIM, qtC, wCT, wCTprim, qt, w, x, qsourcesplit, src_active)
Add source within ixO for iws: w=w+qdt*S[wCT].
Subroutines for TVD-MUSCL schemes.
subroutine, public tvdlimit2(method, qdt, ixIL, ixICL, ixOL, idims, wL, wR, wnew, x, fC, dxs)
Module with all the methods that users can customize in AMRVAC.
integer nw
Total number of variables.
integer number_species
number of species: each species has different characterictic speeds and should be used accordingly in...
integer, dimension(:), allocatable iw_mom
Indices of the momentum density.
integer, dimension(:), allocatable start_indices
the indices in 1:nwflux array are assumed consecutive for each species this array should be of size n...
integer, dimension(:), allocatable stop_indices
the indices in 1:nwflux array are assumed consecutive for each species this array should be of size n...
integer, dimension(:), allocatable, protected iw_mag
Indices of the magnetic field components.
integer iw_rho
Index of the (gas) density.
integer nwflux
Number of flux variables.
integer index_v_mag
index of the var whose velocity appears in the induction eq.
integer iw_e
Index of the energy density.