!!****************************************************************************** !! !! This file is part of the AMUN source code, a program to perform !! Newtonian or relativistic magnetohydrodynamical simulations on uniform or !! adaptive mesh. !! !! Copyright (C) 2008-2012 Grzegorz Kowal !! !! This program is free software: you can redistribute it and/or modify !! it under the terms of the GNU General Public License as published by !! the Free Software Foundation, either version 3 of the License, or !! (at your option) any later version. !! !! This program is distributed in the hope that it will be useful, !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! GNU General Public License for more details. !! !! You should have received a copy of the GNU General Public License !! along with this program. If not, see . !! !!****************************************************************************** !! !! module: SCHEMES !! !! The module handles numerical schemes, subroutines to calculate variable !! increment and one dimensional Riemann solvers. !! !!****************************************************************************** ! module schemes ! module variables are not implicit by default ! implicit none ! by default everything is private ! private ! declare public subroutines ! public :: update_flux, update_increment !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! contains ! !=============================================================================== !! !!*** PUBLIC SUBROUTINES ***************************************************** !! !=============================================================================== ! ! subroutine UPDATE_FLUX: ! ---------------------- ! ! Subroutine solves the Riemann problem along each direction and calculates ! the numerical fluxes, which are used later to calculate the conserved ! variable increment. ! ! Arguments: ! ! idir - direction along which the flux is calculated; ! dx - the spatial step; ! q - the array of primitive variables; ! f - the array of numerical fluxes; ! ! !=============================================================================== ! subroutine update_flux(idir, dx, q, f) ! include external variables ! use coordinates , only : im, jm, km use variables , only : idn, ivx, ivy, ivz, imx, imy, imz #ifdef ADI use variables , only : ipr, ien #endif /* ADI */ #ifdef MHD use variables , only : ibx, iby, ibz #ifdef GLM use variables , only : iph #endif /* GLM */ #endif /* MHD */ use variables , only : nt ! local variables are not implicit by default ! implicit none ! input arguments ! integer , intent(in) :: idir real , intent(in) :: dx real, dimension(nt,im,jm,km), intent(in) :: q real, dimension(nt,im,jm,km), intent(inout) :: f ! local variables ! integer :: i, j, k ! local temporary arrays ! real, dimension(nt,im) :: qx, fx real, dimension(nt,jm) :: qy, fy #if NDIMS == 3 real, dimension(nt,km) :: qz, fz #endif /* NDIMS == 3 */ ! !------------------------------------------------------------------------------- ! ! reset the flux array ! f(:,:,:,:) = 0.0d0 ! select the directional flux to compute ! select case(idir) case(1) ! calculate the flux along the X-direction ! do k = 1, km do j = 1, jm ! copy directional variable vectors to pass to the one dimensional solver ! qx(idn,1:im) = q(idn,1:im,j,k) qx(imx,1:im) = q(ivx,1:im,j,k) qx(imy,1:im) = q(ivy,1:im,j,k) qx(imz,1:im) = q(ivz,1:im,j,k) #ifdef ADI qx(ien,1:im) = q(ien,1:im,j,k) #endif /* ADI */ #ifdef MHD qx(ibx,1:im) = q(ibx,1:im,j,k) qx(iby,1:im) = q(iby,1:im,j,k) qx(ibz,1:im) = q(ibz,1:im,j,k) #ifdef GLM qx(iph,1:im) = q(iph,1:im,j,k) #endif /* GLM */ #endif /* MHD */ ! call one dimensional Riemann solver in order to obtain numerical fluxes ! call riemann(im, dx, qx(1:nt,1:im), fx(1:nt,1:im)) ! update the array of fluxes ! f(idn,1:im,j,k) = fx(idn,1:im) f(imx,1:im,j,k) = fx(imx,1:im) f(imy,1:im,j,k) = fx(imy,1:im) f(imz,1:im,j,k) = fx(imz,1:im) #ifdef ADI f(ien,1:im,j,k) = fx(ien,1:im) #endif /* ADI */ #ifdef MHD f(ibx,1:im,j,k) = fx(ibx,1:im) f(iby,1:im,j,k) = fx(iby,1:im) f(ibz,1:im,j,k) = fx(ibz,1:im) #ifdef GLM f(iph,1:im,j,k) = fx(iph,1:im) #endif /* GLM */ #endif /* MHD */ end do end do case(2) ! calculate the flux along the Y direction ! do k = 1, km do i = 1, im ! copy directional variable vectors to pass to the one dimensional solver ! qy(idn,1:jm) = q(idn,i,1:jm,k) qy(ivx,1:jm) = q(ivy,i,1:jm,k) qy(ivy,1:jm) = q(ivz,i,1:jm,k) qy(ivz,1:jm) = q(ivx,i,1:jm,k) #ifdef ADI qy(ien,1:jm) = q(ien,i,1:jm,k) #endif /* ADI */ #ifdef MHD qy(ibx,1:jm) = q(iby,i,1:jm,k) qy(iby,1:jm) = q(ibz,i,1:jm,k) qy(ibz,1:jm) = q(ibx,i,1:jm,k) #ifdef GLM qy(iph,1:jm) = q(iph,i,1:jm,k) #endif /* GLM */ #endif /* MHD */ ! call one dimensional Riemann solver in order to obtain numerical fluxes ! call riemann(jm, dx, qy(1:nt,1:jm), fy(1:nt,1:jm)) ! update the array of fluxes ! f(idn,i,1:jm,k) = fy(idn,1:jm) f(imx,i,1:jm,k) = fy(imz,1:jm) f(imy,i,1:jm,k) = fy(imx,1:jm) f(imz,i,1:jm,k) = fy(imy,1:jm) #ifdef ADI f(ien,i,1:jm,k) = fy(ien,1:jm) #endif /* ADI */ #ifdef MHD f(ibx,i,1:jm,k) = fy(ibz,1:jm) f(iby,i,1:jm,k) = fy(ibx,1:jm) f(ibz,i,1:jm,k) = fy(iby,1:jm) #ifdef GLM f(iph,i,1:jm,k) = fy(iph,1:jm) #endif /* GLM */ #endif /* MHD */ end do end do #if NDIMS == 3 case(3) ! calculate the flux along the Z direction ! do j = 1, jm do i = 1, im ! copy directional variable vectors to pass to the one dimensional solver ! qz(idn,1:km) = q(idn,i,j,1:km) qz(ivx,1:km) = q(ivz,i,j,1:km) qz(ivy,1:km) = q(ivx,i,j,1:km) qz(ivz,1:km) = q(ivy,i,j,1:km) #ifdef ADI qz(ien,1:km) = q(ien,i,j,1:km) #endif /* ADI */ #ifdef MHD qz(ibx,1:km) = q(ibz,i,j,1:km) qz(iby,1:km) = q(ibx,i,j,1:km) qz(ibz,1:km) = q(iby,i,j,1:km) #ifdef GLM qz(iph,1:km) = q(iph,i,j,1:km) #endif /* GLM */ #endif /* MHD */ ! call one dimensional Riemann solver in order to obtain numerical fluxes ! call riemann(km, dx, qz(1:nt,1:km), fz(1:nt,1:km)) ! update the array of fluxes ! f(idn,i,j,1:km) = fz(idn,1:km) f(imx,i,j,1:km) = fz(imy,1:km) f(imy,i,j,1:km) = fz(imz,1:km) f(imz,i,j,1:km) = fz(imx,1:km) #ifdef ADI f(ien,i,j,1:km) = fz(ien,1:km) #endif /* ADI */ #ifdef MHD f(ibx,i,j,1:km) = fz(iby,1:km) f(iby,i,j,1:km) = fz(ibz,1:km) f(ibz,i,j,1:km) = fz(ibx,1:km) #ifdef GLM f(iph,i,j,k) = fz(iph,k) #endif /* GLM */ #endif /* MHD */ end do end do #endif /* NDIMS == 3 */ end select !------------------------------------------------------------------------------- ! end subroutine update_flux ! !=============================================================================== ! ! subroutine UPDATE_INCREMENT: ! --------------------------- ! ! Subroutine calculate the conservative variable increment from the fluxes. ! ! Arguments: ! ! dh - the ratio of the time step to the spatial step; ! f - the array of numerical fluxes; ! du - the array of variable increment; ! ! !=============================================================================== ! subroutine update_increment(dh, f, du) ! include external variables ! use coordinates , only : im, jm, km use variables , only : nfl ! local variables are not implicit by default ! implicit none ! subroutine arguments ! real, dimension(3) , intent(in) :: dh real, dimension(NDIMS,nfl,im,jm,km), intent(in) :: f real, dimension( nfl,im,jm,km), intent(inout) :: du ! local variables ! integer :: i, j, k ! !------------------------------------------------------------------------------- ! ! reset the increment array du ! du(:,:,:,:) = 0.0d0 ! perform update along the X direction ! do i = 2, im du(:,i,:,:) = du(:,i,:,:) - dh(1) * (f(1,:,i,:,:) - f(1,:,i-1,:,:)) end do du(:,1,:,:) = du(:,1,:,:) - dh(1) * f(1,:,1,:,:) ! perform update along the Y direction ! do j = 2, jm du(:,:,j,:) = du(:,:,j,:) - dh(2) * (f(2,:,:,j,:) - f(2,:,:,j-1,:)) end do du(:,:,1,:) = du(:,:,1,:) - dh(2) * f(2,:,:,1,:) #if NDIMS == 3 ! perform update along the Z direction ! do k = 2, km du(:,:,:,k) = du(:,:,:,k) - dh(3) * (f(3,:,:,:,k) - f(3,:,:,:,k-1)) end do du(:,:,:,1) = du(:,:,:,1) - dh(3) * f(3,:,:,:,1) #endif /* NDIMS == 3 */ !------------------------------------------------------------------------------- ! end subroutine update_increment ! !=============================================================================== !! !!*** PRIVATE SUBROUTINES **************************************************** !! !=============================================================================== ! #ifdef HYDRO #ifdef HLL !=============================================================================== ! ! subroutine RIEMANN: ! ================== ! ! Subroutine solves one dimensional Riemann problem using the HLL method. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! f - the output array of fluxes; ! ! References: ! ! [1] Harten, A., Lax, P. D. & Van Leer, B. ! "On Upstream Differencing and Godunov-Type Schemes for Hyperbolic ! Conservation Laws", ! SIAM Review, 1983, Volume 25, Number 1, pp. 35-61 ! !=============================================================================== ! subroutine riemann(n, h, q, f) ! include external procedures ! use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct #ifdef FIX_POSITIVITY use interpolations, only : fix_positivity #endif /* FIX_POSITIVITY */ ! include external variables ! use variables , only : nt use variables , only : ivx, ivy, ivz #ifdef ADI use variables , only : ien #endif /* ADI */ ! local variables are not implicit by default ! implicit none ! subroutine arguments ! integer , intent(in) :: n real , intent(in) :: h real, dimension(nt,n), intent(in) :: q real, dimension(nt,n), intent(out) :: f ! local variables ! integer :: p, i real :: sl, sr, srl, srml ! local arrays to store the states ! real, dimension(nt,n) :: ql, qr, ul, ur, fl, fr real, dimension(n) :: cl, cr ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states of primitive variables ! do p = 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:)) end do #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) #ifdef ADI call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* ADI */ #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLL flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! prepare coefficients for the intermediate state calculation ! srl = sr * sl srml = sr - sl ! calculate the fluxes for the intermediate state ! f(:,i) = ((sr * fl(:,i) - sl * fr(:,i)) & + srl * (ur(:,i) - ul(:,i))) / srml end if end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* HLL */ #ifdef HLLC ! !=============================================================================== ! ! subroutine RIEMANN: ! ------------------ ! ! Subroutine solves one dimensional Riemann problem using the HLLC method, ! by Toro. In the HLLC method the tangential components of the velocity are ! discontinuous, which in the HLLCC method they are continuous and calculated ! from the HLL average. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! f - the output array of fluxes; ! ! References: ! ! [1] Toro, E. F., Spruce, M., & Speares, W. ! "Restoration of the contact surface in the HLL-Riemann solver", ! Shock Waves, 1994, Volume 4, Issue 1, pp. 25-34 ! !=============================================================================== ! subroutine riemann(n, h, q, f) ! include external procedures ! use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct #ifdef FIX_POSITIVITY use interpolations, only : fix_positivity #endif /* FIX_POSITIVITY */ ! include external variables ! use variables , only : nt use variables , only : idn, ivx, ivy, ivz, imx, imy, imz #ifdef ADI use variables , only : ipr, ien #endif /* ADI */ ! local variables are not implicit by default ! implicit none ! subroutine arguments ! integer , intent(in) :: n real , intent(in) :: h real, dimension(nt,n), intent(in) :: q real, dimension(nt,n), intent(out) :: f ! local variables ! integer :: p, i real :: dn, mx, pr real :: sl, sr, sm real :: slmv, srmv, slmm, srmm, smvl, smvr ! local arrays to store the states ! real, dimension(nt,n) :: ql, qr, ul, ur, fl, fr real, dimension(n) :: cl, cr real, dimension(nt) :: q1l, q1r, u1l, u1r ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states of primitive variables ! do p = 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:)) end do #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLLC flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! sl < 0 < sr ! the speed of contact discontinuity (eq. 34 [1], 14 [2]) ! dn = (sr * ur(idn,i) - sl * ul(idn,i)) - (fr(idn,i) - fl(idn,i)) mx = (sr * ur(imx,i) - sl * ul(imx,i)) - (fr(imx,i) - fl(imx,i)) sm = mx / dn ! compute speed differences ! slmv = sl - ql(ivx,i) srmv = sr - qr(ivx,i) slmm = sl - sm srmm = sr - sm smvl = sm - ql(ivx,i) smvr = sm - qr(ivx,i) ! pressure of intermediate states (eq. 36 [1], 16 [2]) ! pr = 0.5d0 * ((ql(ipr,i) + ql(idn,i) * slmv * smvl) & + (qr(ipr,i) + qr(idn,i) * srmv * smvr)) ! intermediate discontinuities ! if (sm > 0.0d0) then ! calculate the left intermediate state ! u1l(idn) = ql(idn,i) * slmv / slmm u1l(imx) = u1l(idn) * sm u1l(imy) = u1l(idn) * ql(ivy,i) u1l(imz) = u1l(idn) * ql(ivz,i) u1l(ien) = (slmv * ul(ien,i) - ql(ipr,i) * ql(ivx,i) & + pr * sm) / slmm ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (sm < 0.0d0) then ! calculate the right intermediate state ! u1r(idn) = qr(idn,i) * srmv / srmm u1r(imx) = u1r(idn) * sm u1r(imy) = u1r(idn) * qr(ivy,i) u1r(imz) = u1r(idn) * qr(ivz,i) u1r(ien) = (srmv * ur(ien,i) - qr(ipr,i) * qr(ivx,i) & + pr * sm) / srmm ! calculate right intermediate flux ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sm = 0 ! calculate the left intermediate state ! u1l(idn) = ql(idn,i) * slmv / sl u1l(imx) = 0.0d0 u1l(imy) = u1l(idn) * ql(ivy,i) u1l(imz) = u1l(idn) * ql(ivz,i) u1l(ien) = (slmv * ul(ien,i) - ql(ipr,i) * ql(ivx,i)) / sl ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) ! calculate the right intermediate state ! u1r(idn) = qr(idn,i) * srmv / sr u1r(imx) = 0.0d0 u1r(imy) = u1r(idn) * qr(ivy,i) u1r(imz) = u1r(idn) * qr(ivz,i) u1r(ien) = (srmv * ur(ien,i) - qr(ipr,i) * qr(ivx,i)) / sr ! calculate right intermediate flux ! f(:,i) = 0.5d0 * (f(:,i) + (fr(:,i) + sr * (u1r(:) - ur(:,i)))) end if ! sm = 0 end if ! sl < 0.0 & sr > 0.0 end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* HLLC */ #ifdef ROE ! !=============================================================================== ! ! subroutine RIEMANN: ! ------------------ ! ! Subroutine solves one dimensional Riemann problem using the HLLC method, ! by Toro. In the HLLC method the tangential components of the velocity are ! discontinuous, which in the HLLCC method they are continuous and calculated ! from the HLL average. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! f - the output array of fluxes; ! ! References: ! ! [1] Roe, P. L., 1981, Journal of Computational Physics, 43, 357 ! [2] Toro, E. F., Spruce, M., & Speares, W. ! "Restoration of the contact surface in the HLL-Riemann solver", ! Shock Waves, 1994, Volume 4, Issue 1, pp. 25-34 ! !=============================================================================== ! subroutine riemann(n, h, q, f) ! include external procedures ! use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct #ifdef FIX_POSITIVITY use interpolations, only : fix_positivity #endif /* FIX_POSITIVITY */ ! include external variables ! use equations , only : gamma use variables , only : nt use variables , only : idn, ivx, ivy, ivz #ifdef ADI use variables , only : ipr, ien #endif /* ADI */ ! local variables are not implicit by default ! implicit none ! subroutine arguments ! integer , intent(in) :: n real , intent(in) :: h real, dimension(nt,n), intent(in) :: q real, dimension(nt,n), intent(out) :: f ! local variables ! integer :: p, i real :: al, ar, ap, div real :: sdl, sdr, sds, sfl, sfr ! local arrays to store the states ! real, dimension(nt,n) :: ql, qr, ul, ur, fl, fr real, dimension(n) :: cl, cr real, dimension(nt,nt) :: li, ri real, dimension(nt) :: qi, ci, et, du ! !------------------------------------------------------------------------------- ! ! reset the eigensystem values ! ci(:) = 0.0d0 li(:,:) = 0.0d0 ri(:,:) = 0.0d0 ! reconstruct the left and right states of primitive variables ! do p = 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:)) end do #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! calculate conserved states difference ! du(:) = ur(:,i) - ul(:,i) ! calculate Roe variables for the eigenproblem solution ! sdl = sqrt(ql(idn,i)) sdr = sqrt(qr(idn,i)) sds = sdl + sdr sfl = sdl / sds sfr = sdr / sds ! prepare the Roe intermediate state ! qi(idn) = sdl * sdr qi(ivx) = sfl * ql(ivx,i) + sfr * qr(ivx,i) qi(ivy) = sfl * ql(ivy,i) + sfr * qr(ivy,i) qi(ivz) = sfl * ql(ivz,i) + sfr * qr(ivz,i) #ifdef ADI qi(ipr) = sfl * (ul(ien,i) + ql(ipr,i)) / ql(idn,i) & + sfr * (ur(ien,i) + qr(ipr,i)) / qr(idn,i) #endif /* ADI */ ! obtain eigenvalues and eigenvectors ! call eigensystem(qi(:), ci(:), ri(:,:), li(:,:)) ! calculate vector (Ur - Ul).L ! et(:) = 0.0d0 do p = 1, nt et(:) = et(:) + du(p) * li(p,:) end do ! calculate the flux average ! f(:,i) = 0.5d0 * (fl(:,i) + fr(:,i)) ! correct the flux by adding the term abs(lambda) R.(Ur - Ul).L ! do p = 1, nt f(:,i) = f(:,i) - 0.5d0 * abs(ci(p)) * et(p) * ri(p,:) end do end do !------------------------------------------------------------------------------- ! end subroutine riemann ! !=============================================================================== ! ! eigensystem: subroutine computes eigenvalues and eigenmatrices for a given ! set of equations and input variables ! !=============================================================================== ! #ifdef ADI subroutine eigensystem(q, c, r, l) use equations, only : gamma use variables, only : nqt use variables, only : idn, ivx, ivy, ivz use variables, only : ien implicit none ! input/output arguments ! real, dimension(nqt) , intent(in) :: q real, dimension(nqt) , intent(inout) :: c real, dimension(nqt,nqt), intent(inout) :: l, r ! local variables ! real :: gm, vv, vh, c2, na, cc, vc, ng, nd, nv, nh, nc ! !------------------------------------------------------------------------------- ! ! calculate characteristic speeds and useful variables ! gm = gamma - 1.0d0 vv = sum(q(ivx:ivz)**2) vh = 0.5d0 * vv c2 = gm * (q(ien) - vh) na = 0.5d0 / c2 cc = sqrt(c2) vc = q(ivx) * cc ng = na * gm nd = 2.0 * ng nv = na * vc nh = na * gm * vh nc = na * cc ! prepare eigenvalues ! c(1) = q(ivx) - cc c(2) = q(ivx) c(3) = q(ivx) c(4) = q(ivx) c(5) = q(ivx) + cc ! prepare the right eigenmatrix ! r(1,idn) = 1.0d0 r(1,ivx) = q(ivx) - cc r(1,ivy) = q(ivy) r(1,ivz) = q(ivz) r(1,ien) = q(ien) - vc r(2,ivy) = 1.0d0 r(2,ien) = q(ivy) r(3,ivz) = 1.0d0 r(3,ien) = q(ivz) r(4,idn) = 1.0d0 r(4,ivx) = q(ivx) r(4,ivy) = q(ivy) r(4,ivz) = q(ivz) r(4,ien) = vh r(5,idn) = 1.0d0 r(5,ivx) = q(ivx) + cc r(5,ivy) = q(ivy) r(5,ivz) = q(ivz) r(5,ien) = q(ien) + vc ! prepare the left eigenmatrix ! l(idn,1) = nh + nv l(ivx,1) = - ng * q(ivx) - nc l(ivy,1) = - ng * q(ivy) l(ivz,1) = - ng * q(ivz) l(ien,1) = ng l(idn,2) = - q(ivy) l(ivy,2) = 1.0d0 l(idn,3) = - q(ivz) l(ivz,3) = 1.0d0 l(idn,4) = 1.0d0 - ng * vv l(ivx,4) = nd * q(ivx) l(ivy,4) = nd * q(ivy) l(ivz,4) = nd * q(ivz) l(ien,4) = - nd l(idn,5) = nh - nv l(ivx,5) = - ng * q(ivx) + nc l(ivy,5) = - ng * q(ivy) l(ivz,5) = - ng * q(ivz) l(ien,5) = ng !------------------------------------------------------------------------------- ! end subroutine eigensystem #endif /* ADI */ #ifdef ISO subroutine eigensystem(q, c, r, l) use equations, only : csnd use variables, only : nqt use variables, only : idn, ivx, ivy, ivz implicit none ! input/output arguments ! real, dimension(nqt) , intent(in) :: q real, dimension(nqt) , intent(inout) :: c real, dimension(nqt,nqt), intent(inout) :: l, r ! local variables ! real :: ch, vc ! !------------------------------------------------------------------------------- ! ! calculate useful variables ! ch = 0.5d0 / csnd vc = ch * q(ivx) ! prepare eigenvalues ! c(1) = q(ivx) - csnd c(2) = q(ivx) c(3) = q(ivx) c(4) = q(ivx) + csnd ! prepare the right eigenmatrix ! r(1,idn) = 1.0d0 r(1,ivx) = q(ivx) - csnd r(1,ivy) = q(ivy) r(1,ivz) = q(ivz) r(2,ivy) = 1.0d0 r(3,ivz) = 1.0d0 r(4,idn) = 1.0d0 r(4,ivx) = q(ivx) + csnd r(4,ivy) = q(ivy) r(4,ivz) = q(ivz) ! prepare the left eigenmatrix ! l(idn,1) = 0.5d0 + vc l(ivx,1) = - ch l(idn,2) = - q(ivy) l(ivy,2) = 1.0d0 l(idn,3) = - q(ivz) l(ivz,3) = 1.0d0 l(idn,4) = 0.5d0 - vc l(ivx,4) = ch !------------------------------------------------------------------------------- ! end subroutine eigensystem #endif /* ISO */ #endif /* ROE */ #endif /* HYDRO */ #ifdef MHD #ifdef HLL !=============================================================================== ! ! subroutine RIEMANN: ! ================== ! ! Subroutine solves one dimensional Riemann problem using the HLL method. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! f - the output array of fluxes; ! ! References: ! ! [1] Harten, A., Lax, P. D. & Van Leer, B. ! "On Upstream Differencing and Godunov-Type Schemes for Hyperbolic ! Conservation Laws", ! SIAM Review, 1983, Volume 25, Number 1, pp. 35-61 ! !=============================================================================== ! subroutine riemann(n, h, q, f) ! include external procedures ! use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct #ifdef FIX_POSITIVITY use interpolations, only : fix_positivity #endif /* FIX_POSITIVITY */ ! include external variables ! use variables , only : nt use variables , only : ivx, ivy, ivz #ifdef ADI use variables , only : ien #endif /* ADI */ use variables , only : ibx, iby, ibz #ifdef GLM use variables , only : iph use variables , only : cmax #endif /* GLM */ ! local variables are not implicit by default ! implicit none ! subroutine arguments ! integer , intent(in) :: n real , intent(in) :: h real, dimension(nt,n), intent(in) :: q real, dimension(nt,n), intent(out) :: f ! local variables ! integer :: p, i real :: sl, sr, srl, srml ! local arrays to store the states ! real, dimension(nt,n) :: ql, qr, ul, ur, fl, fr real, dimension(n) :: cl, cr ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states of primitive variables ! do p = 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:)) end do ! reconstruct the left and right states of the magnetic field components ! do p = ibx, ibz call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:)) end do #ifdef GLM ! reconstruct the left and right states of the scalar potential ! call reconstruct(n, h, q(iph,:), ql(iph,:), qr(iph,:)) ! obtain the state values for Bx and Psi for the GLM-MHD equations ! cl(:) = 0.5d0 * ((qr(ibx,:) + ql(ibx,:)) - (qr(iph,:) - ql(iph,:)) / cmax) cr(:) = 0.5d0 * ((qr(iph,:) + ql(iph,:)) - (qr(ibx,:) - ql(ibx,:)) * cmax) ql(ibx,:) = cl(:) qr(ibx,:) = cl(:) ql(iph,:) = cr(:) qr(iph,:) = cr(:) #endif /* GLM */ #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) #ifdef ADI call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* ADI */ #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLL flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! prepare coefficients for the intermediate state calculation ! srl = sr * sl srml = sr - sl ! calculate the fluxes for the intermediate state ! f(:,i) = ((sr * fl(:,i) - sl * fr(:,i)) & + srl * (ur(:,i) - ul(:,i))) / srml end if end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* HLL */ #if defined HLLC || defined HLLCC || defined HLLCL ! !=============================================================================== ! ! subroutine RIEMANN: ! ================== ! ! Subroutine solves one dimensional Riemann problem using the HLLC method ! by Gurski or Li. The HLLC, HLLCC, and HLLC-L differs by the definitions of ! the tangential components of the velocity and magnetic field. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! b - the input vector of the normal magnetic field component; ! f - the output array of fluxes; ! s - the input array of shock indicators; ! ! References: ! ! [1] Gurski, K. F., ! "An HLLC-Type Approximate Riemann Solver for Ideal ! Magnetohydrodynamics", ! SIAM Journal on Scientific Computing, 2004, Volume 25, Issue 6, ! pp. 2165–2187 ! [2] Li, S., ! "An HLLC Riemann solver for magneto-hydrodynamics", ! Journal of Computational Physics, 2005, Volume 203, Issue 1, ! pp. 344-357 ! !=============================================================================== ! subroutine riemann(n, h, q, b, f, s) ! include external procedures and variables ! use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct, fix_positivity use variables , only : nt use variables , only : idn, imx, imy, imz, ien use variables , only : ivx, ivy, ivz, ipr use variables , only : ibx, iby, ibz ! local variables are not implicit by default ! implicit none ! input / output arguments ! integer , intent(in) :: n real , intent(in) :: h real , dimension(nt,n), intent(in) :: q real , dimension( n), intent(in) :: b real , dimension(nt,n), intent(out) :: f logical, dimension(n) , intent(in) :: s ! local variables ! integer :: p, i #ifdef SHOCK_DETECTION integer :: ip1 #endif /* SHOCK_DETECTION */ real :: dn, mx, vy, vz, by, bz, pt, pm real :: sl, sr, srl, sm real :: slmv, srmv, slmm, srmm, smvl, smvr, srml real :: pml, pmr, ptl, ptr real :: fc ! local arrays to store the states ! real, dimension(nt,n) :: ul, ur, ql, qr, fl, fr real, dimension(n) :: cl, cr real, dimension(nt) :: q1l, q1r, u1l, u1r ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states of primitive variables ! do p = 1, ibx - 1 call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do do p = ibx + 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do ! copy normal component to the left and right states ! ql(ibx,:) = b(:) qr(ibx,:) = b(:) #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLLC flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! sl < 0 < sr #ifdef SHOCK_DETECTION ! calculate the next index ! ip1 = min(n, i + 1) ! check if we are in the vicinity of a shock ! if (s(i) .or. s(ip1)) then ! prepare coefficients for the intermediate state calculation ! srl = sr * sl srml = sr - sl ! calculate the fluxes for the intermediate state ! f(:,i) = ((sr * fl(:,i) - sl * fr(:,i)) & + srl * (ur(:,i) - ul(:,i))) / srml else #endif /* SHOCK_DETECTION */ ! the speed of contact discontinuity (eq. 34 [1], 14 [2]) ! dn = (sr * ur(idn,i) - sl * ul(idn,i)) - (fr(idn,i) - fl(idn,i)) mx = (sr * ur(imx,i) - sl * ul(imx,i)) - (fr(imx,i) - fl(imx,i)) sm = mx / dn ! compute speed differences ! slmv = sl - ql(ivx,i) srmv = sr - qr(ivx,i) slmm = sl - sm srmm = sr - sm smvl = sm - ql(ivx,i) smvr = sm - qr(ivx,i) ! calculate magnetic pressure ! pml = 0.5d0 * sum(ql(ibx:ibz,i) * ql(ibx:ibz,i)) pmr = 0.5d0 * sum(qr(ibx:ibz,i) * qr(ibx:ibz,i)) ! calculate total pressures ! ptl = ql(ipr,i) + pml ptr = qr(ipr,i) + pmr ! pressure of intermediate states (eq. 36 [1], 16 [2]) ! pt = 0.5d0 * ((ptl + ql(idn,i) * slmv * smvl) & + (ptr + qr(idn,i) * srmv * smvr)) #if defined HLLC || defined HLLCL ! separate cases when Bx = 0 and Bx ≠ 0 ! if (b(i) == 0.0d0) then ! intermediate discontinuities ! if (sm > 0.0d0) then ! calculate the ratio of speed differences ! fc = slmv / slmm ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = dn * sm u1l(imy) = dn * ql(ivy,i) u1l(imz) = dn * ql(ivz,i) u1l(ibx) = b(i) u1l(iby) = ql(iby,i) * fc u1l(ibz) = ql(ibz,i) * fc u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i) + pt * sm) / slmm ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (sm < 0.0d0) then ! calculate the ratio of speed differences ! fc = srmv / srmm ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = dn * sm u1r(imy) = dn * qr(ivy,i) u1r(imz) = dn * qr(ivz,i) u1r(ibx) = b(i) u1r(iby) = qr(iby,i) * fc u1r(ibz) = qr(ibz,i) * fc u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i) + pt * sm) / srmm ! calculate right intermediate flux ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sm = 0 ! calculate the ratio of speed differences ! fc = slmv / sl ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = 0.0d0 u1l(imy) = dn * ql(ivy,i) u1l(imz) = dn * ql(ivz,i) u1l(ibx) = b(i) u1l(iby) = ql(iby,i) * fc u1l(ibz) = ql(ibz,i) * fc u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i)) / sl ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) ! calculate the ratio of speed differences ! fc = srmv / sr ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = 0.0d0 u1r(imy) = dn * qr(ivy,i) u1r(imz) = dn * qr(ivz,i) u1r(ibx) = b(i) u1r(iby) = qr(iby,i) * fc u1r(ibz) = qr(ibz,i) * fc u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i)) / sr ! calculate right intermediate flux ! f(:,i) = 0.5d0 * (f(:,i) + (fr(:,i) + sr * (u1r(:) - ur(:,i)))) end if ! sm = 0 else ! Bx ≠ 0 ! prepare the difference between the fastests speeds ! srml = sr - sl ! when Bx ≠ 0 the tangential components of velocity and magnetic field are ! calculated from the HLL state ! #ifdef HLLC vy = ((sr * ur(imy,i) - sl * ul(imy,i)) & - (fr(imy,i) - fl(imy,i))) / dn vz = ((sr * ur(imz,i) - sl * ul(imz,i)) & - (fr(imz,i) - fl(imz,i))) / dn #endif /* HLLC */ by = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml bz = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml ! intermediate discontinuities ! if (sm > 0.0d0) then ! calculate the ratio of speed differences ! fc = slmv / slmm ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = dn * sm #ifdef HLLC u1l(imy) = dn * vy u1l(imz) = dn * vz #endif /* HLLC */ #ifdef HLLCL fc = b(i) / (ql(idn,i) * slmv) u1l(imy) = dn * (ql(ivy,i) + fc * (ql(iby,i) - by)) u1l(imz) = dn * (ql(ivz,i) + fc * (ql(ibz,i) - bz)) #endif /* HLLCL */ u1l(ibx) = b(i) u1l(iby) = by u1l(ibz) = bz u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i) + pt * sm) / slmm ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (sm < 0.0d0) then ! calculate the ratio of speed differences ! fc = srmv / srmm ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = dn * sm #ifdef HLLC u1r(imy) = dn * vy u1r(imz) = dn * vz #endif /* HLLC */ #ifdef HLLCL fc = b(i) / (qr(idn,i) * srmv) u1r(imy) = dn * (qr(ivy,i) + fc * (qr(iby,i) - by)) u1r(imz) = dn * (qr(ivz,i) + fc * (qr(ibz,i) - bz)) #endif /* HLLCL */ u1r(ibx) = b(i) u1r(iby) = by u1r(ibz) = bz u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i) + pt * sm) / srmm ! calculate right intermediate flux ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sm = 0 ! calculate the ratio of speed differences ! fc = slmv / sl ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = 0.0d0 #ifdef HLLC u1l(imy) = dn * vy u1l(imz) = dn * vz #endif /* HLLC */ #ifdef HLLCL fc = b(i) / (ql(idn,i) * slmv) u1l(imy) = dn * (ql(ivy,i) + fc * (ql(iby,i) - by)) u1l(imz) = dn * (ql(ivz,i) + fc * (ql(ibz,i) - bz)) #endif /* HLLCL */ u1l(ibx) = b(i) u1l(iby) = by u1l(ibz) = bz u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i)) / sl ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) ! calculate the ratio of speed differences ! fc = srmv / sr ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = 0.0d0 #ifdef HLLC u1r(imy) = dn * vy u1r(imz) = dn * vz #endif /* HLLC */ #ifdef HLLCL fc = b(i) / (qr(idn,i) * srmv) u1r(imy) = dn * (qr(ivy,i) + fc * (qr(iby,i) - by)) u1r(imz) = dn * (qr(ivz,i) + fc * (qr(ibz,i) - bz)) #endif /* HLLCL */ u1r(ibx) = b(i) u1r(iby) = by u1r(ibz) = bz u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i)) / sr ! calculate right intermediate flux ! f(:,i) = 0.5d0 * (f(:,i) + (fr(:,i) + sr * (u1r(:) - ur(:,i)))) end if ! sm = 0 end if ! Bx ≠ 0 #endif /* HLLC | HLLCL */ #ifdef HLLCC ! prepare the difference between the fastests speeds ! srml = sr - sl ! when Bx ≠ 0 the tangential components of velocity and magnetic field are ! calculated from the HLL state ! vy = ((sr * ur(imy,i) - sl * ul(imy,i)) & - (fr(imy,i) - fl(imy,i))) / dn vz = ((sr * ur(imz,i) - sl * ul(imz,i)) & - (fr(imz,i) - fl(imz,i))) / dn by = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml bz = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml ! intermediate discontinuities ! if (sm > 0.0d0) then ! calculate the ratio of speed differences ! fc = slmv / slmm ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = dn * sm u1l(imy) = dn * vy u1l(imz) = dn * vz u1l(ibx) = b(i) u1l(iby) = by u1l(ibz) = bz u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i) + pt * sm) / slmm ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (sm < 0.0d0) then ! calculate the ratio of speed differences ! fc = srmv / srmm ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = dn * sm u1r(imy) = dn * vy u1r(imz) = dn * vz u1r(ibx) = b(i) u1r(iby) = by u1r(ibz) = bz u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i) + pt * sm) / srmm ! calculate right intermediate flux ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sm = 0 ! calculate the ratio of speed differences ! fc = slmv / sl ! calculate density ! dn = ql(idn,i) * fc ! calculate the left intermediate state ! u1l(idn) = dn u1l(imx) = 0.0d0 u1l(imy) = dn * vy u1l(imz) = dn * vz u1l(ibx) = b(i) u1l(iby) = by u1l(ibz) = bz u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i)) / sl ! calculate the left intermediate flux ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) ! calculate the ratio of speed differences ! fc = srmv / sr ! calculate density ! dn = qr(idn,i) * fc ! calculate the right intermediate state ! u1r(idn) = dn u1r(imx) = 0.0d0 u1r(imy) = dn * vy u1r(imz) = dn * vz u1r(ibx) = b(i) u1r(iby) = by u1r(ibz) = bz u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i)) / sr ! calculate right intermediate flux ! f(:,i) = 0.5d0 * (f(:,i) + (fr(:,i) + sr * (u1r(:) - ur(:,i)))) end if ! sm = 0 #endif /* HLLCC */ #ifdef SHOCK_DETECTION end if ! shock vicinity #endif /* SHOCK_DETECTION */ end if ! sl < 0.0 & sr > 0.0 end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* HLLC | HLLCC | HLLCL */ #ifdef HLLD #ifdef ADI ! !=============================================================================== ! ! subroutine RIEMANN: ! ------------------ ! ! Subroutine solves one dimensional Riemann problem using the adiabatic HLLD ! method described by Miyoshi & Kusano. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! b - the input vector of the normal magnetic field component; ! f - the output array of fluxes; ! s - the input array of shock indicators; ! ! References: ! ! [1] Miyoshi, T. & Kusano, K., ! "A multi-state HLL approximate Riemann solver for ideal ! magnetohydrodynamics", ! Journal of Computational Physics, 2005, 208, pp. 315-344 ! !=============================================================================== ! subroutine riemann(n, h, q, b, f, s) ! include external procedures and variables ! use equations , only : gamma use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct, fix_positivity use variables , only : nt use variables , only : idn, imx, imy, imz, ien use variables , only : ivx, ivy, ivz, ipr use variables , only : ibx, iby, ibz ! local variables are not implicit by default ! implicit none ! input / output arguments ! integer , intent(in) :: n real , intent(in) :: h real , dimension(nt,n), intent(in) :: q real , dimension( n), intent(in) :: b real , dimension(nt,n), intent(out) :: f logical, dimension(n) , intent(in) :: s ! local variables ! integer :: p, i #ifdef SHOCK_DETECTION integer :: ip1 #endif /* SHOCK_DETECTION */ real :: sl, sr, sm, sml, smr real :: srl, srml, slmv, srmv, slmm, srmm, smvl, smvr real :: dn, dnl, dnr, dlsq, drsq real :: mx, dv, fc, b2, bs, ds, vbl, vbr, vb1l, vb1r, vb2 real :: pml, pmr, ptl, ptr, pt, pm ! local arrays to store the states ! real, dimension(nt,n) :: ul, ur, ql, qr, fl, fr real, dimension(n) :: cl, cr real, dimension(nt) :: q1l, q1r, u1l, u1r, q2, u2 ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states of primitive variables ! do p = 1, ibx - 1 call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do do p = ibx + 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do ! copy normal component to the left and right states ! ql(ibx,:) = b(:) qr(ibx,:) = b(:) #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give the negative density or pressure, ! if so, correct the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) call fix_positivity(n, q(ipr,:), ql(ipr,:), qr(ipr,:)) #endif /* FIX_POSITIVITY */ ! calculate corresponding conserved variables of the left and right states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate the physical fluxes and speeds at the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLLD flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! sl < 0 < sr #ifdef SHOCK_DETECTION ! calculate the next index ! ip1 = min(n, i + 1) ! check if we are in the vicinity of a shock ! if (s(i) .or. s(ip1)) then ! prepare coefficients for the intermediate state calculation ! srl = sr * sl srml = sr - sl ! calculate the fluxes for the intermediate state ! f(:,i) = ((sr * fl(:,i) - sl * fr(:,i)) & + srl * (ur(:,i) - ul(:,i))) / srml else #endif /* SHOCK_DETECTION */ ! the speed of contact discontinuity (eq. 38) ! dn = (sr * ur(idn,i) - sl * ul(idn,i)) - (fr(idn,i) - fl(idn,i)) mx = (sr * ur(imx,i) - sl * ul(imx,i)) - (fr(imx,i) - fl(imx,i)) sm = mx / dn ! prepare speed differences ! slmv = sl - ql(ivx,i) srmv = sr - qr(ivx,i) slmm = sl - sm srmm = sr - sm smvl = sm - ql(ivx,i) smvr = sm - qr(ivx,i) srml = sr - sl ! prepare some coefficients ! dnl = ql(idn,i) * slmv dnr = qr(idn,i) * srmv b2 = b(i) * b(i) bs = b2 / gamma ! calculate magnetic pressure ! pml = 0.5d0 * sum(ql(ibx:ibz,i) * ql(ibx:ibz,i)) pmr = 0.5d0 * sum(qr(ibx:ibz,i) * qr(ibx:ibz,i)) ! calculate total pressures ! ptl = ql(ipr,i) + pml ptr = qr(ipr,i) + pmr ! the pressure of the intermediate state (eq. 23) ! pt = 0.5d0 * ((ptl + dnl * smvl) + (ptr + dnr * smvr)) ! calculate densities for the left and right intermediate states (eq. 43) ! q1l(idn) = dnl / slmm q1r(idn) = dnr / srmm ! substitute the normal components of velocity and magnetic field ! q1l(ivx) = sm q1r(ivx) = sm q1l(ibx) = b(i) q1r(ibx) = b(i) ! calculate transversal components of magnetic field for the left state ! (eq. 45 & 47); take into account the B² > γp degeneracy ! dv = dnl * slmm - b2 if (dv /= 0.0d0 .and. bs <= ql(ipr,i)) then fc = (dnl * slmv - b2) / dv q1l(iby) = ql(iby,i) * fc q1l(ibz) = ql(ibz,i) * fc else ! in the case of degeneracy, calculate transversal components of magnetic field ! from the HLL states ! q1l(iby) = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml q1l(ibz) = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml end if ! calculate transversal components of velocity (eq. 42) ! dv = b(i) / dnl q1l(ivy) = ql(ivy,i) + dv * (ql(iby,i) - q1l(iby)) q1l(ivz) = ql(ivz,i) + dv * (ql(ibz,i) - q1l(ibz)) ! calculate transversal components of magnetic field for the left state ! (eq. 45 & 47); take into account the B² > γp degeneracy ! dv = dnr * srmm - b2 if (dv /= 0.0d0 .and. bs <= qr(ipr,i)) then fc = (dnr * srmv - b2) / dv q1r(iby) = qr(iby,i) * fc q1r(ibz) = qr(ibz,i) * fc else ! in the case of degeneracy, calculate transversal components of magnetic field ! from the HLL states ! q1r(iby) = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml q1r(ibz) = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml end if ! calculate transversal components of velocity (eq. 42) ! dv = b(i) / dnr q1r(ivy) = qr(ivy,i) + dv * (qr(iby,i) - q1r(iby)) q1r(ivz) = qr(ivz,i) + dv * (qr(ibz,i) - q1r(ibz)) ! calculate scalar products of the velocity and magnetic field ! vbl = sum(ql (ivx:ivz,i) * ql (ibx:ibz,i)) vbr = sum(qr (ivx:ivz,i) * qr (ibx:ibz,i)) vb1l = sum(q1l(ivx:ivz) * q1l(ibx:ibz)) vb1r = sum(q1r(ivx:ivz) * q1r(ibx:ibz)) ! convert the left intermediate state to conservative form ! u1l(idn) = q1l(idn) u1l(imx) = q1l(idn) * q1l(ivx) u1l(imy) = q1l(idn) * q1l(ivy) u1l(imz) = q1l(idn) * q1l(ivz) u1l(ibx) = q1l(ibx) u1l(iby) = q1l(iby) u1l(ibz) = q1l(ibz) ! convert the right intermediate state to conservative form ! u1r(idn) = q1r(idn) u1r(imx) = q1r(idn) * q1r(ivx) u1r(imy) = q1r(idn) * q1r(ivy) u1r(imz) = q1r(idn) * q1r(ivz) u1r(ibx) = q1r(ibx) u1r(iby) = q1r(iby) u1r(ibz) = q1r(ibz) ! calculate the total energy of the left intermediate state (eq. 48) ! u1l(ien) = (slmv * ul(ien,i) - ptl * ql(ivx,i) + pt * sm & + b(i) * (vbl - vb1l)) / slmm ! calculate the total energy of the right intermediate state (eq. 48) ! u1r(ien) = (srmv * ur(ien,i) - ptr * qr(ivx,i) + pt * sm & + b(i) * (vbr - vb1r)) / srmm ! separate cases Bx ≠ 0 and Bx = 0 ! if (abs(b(i)) > 0.0d0) then ! calculate the square root of the left and right intermediate densities ! dlsq = sqrt(q1l(idn)) drsq = sqrt(q1r(idn)) ! calculate the left and right going sound plus Alfvén speeds (eq. 51) ! sml = sm - abs(b(i)) / dlsq smr = sm + abs(b(i)) / drsq ! intermediate discontinuities ! if (sml > 0.0d0) then ! calculate the left intermediate flux, eq. (64) ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (smr < 0.0d0) then ! calculate the right intermediate flux, eq. (64) ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sml ≤ 0 ≤ smr ! prepare the sign of the normal component of magnetic field ! if (b(i) >= 0.0d0) then bs = 1.0d0 else bs = - 1.0d0 end if ! calculate the sum and product of density root squares ! dv = dlsq + drsq ds = dlsq * drsq ! calculate velocity components, (eq. 39, and 59, 60) ! q2(ivx) = sm q2(ivy) = ((dlsq * q1l(ivy) + drsq * q1r(ivy)) & + bs * (q1r(iby) - q1l(iby))) / dv q2(ivz) = ((dlsq * q1l(ivz) + drsq * q1r(ivz)) & + bs * (q1r(ibz) - q1l(ibz))) / dv ! calculate magnetic field components, (eq. 61, 62) ! q2(ibx) = b(i) q2(iby) = ((dlsq * q1r(iby) + drsq * q1l(iby)) & + bs * ds * (q1r(ivy) - q1l(ivy))) / dv q2(ibz) = ((dlsq * q1r(ibz) + drsq * q1l(ibz)) & + bs * ds * (q1r(ivz) - q1l(ivz))) / dv ! calculate the scalar product of velocity and magnetic field ! vb2 = sum(q2(ivx:ivz) * q2(ibx:ibz)) ! depending on the contact discontinuity speed chose the right Alfvén state ! if (sm > 0.0d0) then ! prepare the conservative variables for the left Alfvén intermediate state ! u2(idn) = u1l(idn) u2(imx) = u2(idn) * q2(ivx) u2(imy) = u2(idn) * q2(ivy) u2(imz) = u2(idn) * q2(ivz) u2(ibx) = q2(ibx) u2(iby) = q2(iby) u2(ibz) = q2(ibz) ! calculate the energy for the Alfvén intermediate state (eq. 63) ! u2(ien) = u1l(ien) - bs * dlsq * (vb1l - vb2) ! calculate the left Alfvén intermediate flux (eq. 65) ! f(:,i) = fl(:,i) & + sml * u2(:) - (sml - sl) * u1l(:) - sl * ul(:,i) else if (sm < 0.0d0) then ! prepare the conservative variables for the right Alfvén intermediate state ! u2(idn) = u1r(idn) u2(imx) = u2(idn) * q2(ivx) u2(imy) = u2(idn) * q2(ivy) u2(imz) = u2(idn) * q2(ivz) u2(ibx) = q2(ibx) u2(iby) = q2(iby) u2(ibz) = q2(ibz) ! calculate the energy for the Alfvén intermediate state (eq. 63) ! u2(ien) = u1r(ien) + bs * drsq * (vb1r - vb2) ! calculate the right Alfvén intermediate flux (eq. 65) ! f(:,i) = fr(:,i) & + smr * u2(:) - (smr - sr) * u1r(:) - sr * ur(:,i) else ! sm = 0 ! prepare the conservative variables for the left Alfvén intermediate state ! u2(idn) = u1l(idn) u2(imx) = u2(idn) * q2(ivx) u2(imy) = u2(idn) * q2(ivy) u2(imz) = u2(idn) * q2(ivz) u2(ibx) = q2(ibx) u2(iby) = q2(iby) u2(ibz) = q2(ibz) ! calculate the energy for the Alfvén intermediate state (eq. 63) ! u2(ien) = u1l(ien) - bs * dlsq * (vb1l - vb2) ! calculate the left Alfvén intermediate flux (eq. 65) ! f(:,i) = fl(:,i) & + sml * u2(:) - (sml - sl) * u1l(:) - sl * ul(:,i) ! prepare the conservative variables for the right Alfvén intermediate state ! u2(idn) = u1r(idn) u2(imx) = u2(idn) * q2(ivx) u2(imy) = u2(idn) * q2(ivy) u2(imz) = u2(idn) * q2(ivz) u2(ibx) = q2(ibx) u2(iby) = q2(iby) u2(ibz) = q2(ibz) ! calculate the energy for the Alfvén intermediate state (eq. 63) ! u2(ien) = u1r(ien) + bs * drsq * (vb1r - vb2) ! calculate the right Alfvén intermediate flux (eq. 65) ! f(:,i) = 0.5d0 * (f(:,i) + (fr(:,i) & + smr * u2(:) - (smr - sr) * u1r(:) - sr * ur(:,i))) end if ! sm = 0 end if ! sml ≤ 0 and smr ≥ 0 else ! Bx = 0 ! intermediate state for the case of Bx = 0 ! if (sm > 0.0d0) then ! calculate the left intermediate flux, eq. (64) ! f(:,i) = fl(:,i) + sl * (u1l(:) - ul(:,i)) else if (sm < 0.0d0) then ! calculate the right intermediate flux, eq. (64) ! f(:,i) = fr(:,i) + sr * (u1r(:) - ur(:,i)) else ! sm = 0 ! average the left and right fluxes if both Sm = 0, and Bx = 0 ! f(:,i) = 0.5d0 * ((fl(:,i) + sl * (u1l(:) - ul(:,i))) & + (fr(:,i) + sr * (u1r(:) - ur(:,i)))) end if ! sm = 0 end if ! Bx = 0 #ifdef SHOCK_DETECTION end if ! shock vicinity #endif /* SHOCK_DETECTION */ end if ! sl < 0 < sr end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* ADI */ #ifdef ISO ! !=============================================================================== ! ! subroutine RIEMANN: ! ------------------ ! ! Subroutine solves one dimensional Riemann problem using the isothermal HLLD ! method described by Mignone. ! ! Arguments: ! ! n - the length of input vectors; ! h - the spatial step; ! q - the input array of primitive variables; ! b - the input vector of the normal magnetic field component; ! f - the output array of fluxes; ! s - the input array of shock indicators; ! ! References: ! ! [1] Mignone, A., ! "A simple and accurate Riemann solver for isothermal MHD", ! Journal of Computational Physics, 2007, 225, pp. 1427-1441 ! !=============================================================================== ! subroutine riemann(n, h, q, b, f, s) ! include external procedures and variables ! use equations , only : csnd use equations , only : prim2cons, fluxspeed use interpolations, only : reconstruct, fix_positivity use variables , only : nt use variables , only : idn, imx, imy, imz use variables , only : ivx, ivy, ivz use variables , only : ibx, iby, ibz ! local variables are not implicit by default ! implicit none ! input / output arguments ! integer , intent(in) :: n real , intent(in) :: h real , dimension(nt,n), intent(in) :: q real , dimension( n), intent(in) :: b real , dimension(nt,n), intent(out) :: f logical, dimension(n) , intent(in) :: s ! local variables ! integer :: p, i #ifdef SHOCK_DETECTION integer :: ip1 #endif /* SHOCK_DETECTION */ real :: dv, dn, mx, sq, fc, bs, b2, ca, dnl, dnr real :: sl, sr, srl, srml, sm, sml, smr, slmv, srmv, slmm, srmm ! local arrays to store the states ! real, dimension(nt,n) :: ul, ur, ql, qr, fl, fr real, dimension(n) :: cl, cr real, dimension(nt) :: u1l, u1r, u2 ! !------------------------------------------------------------------------------- ! ! reconstruct the left and right states from primitive variables ! do p = 1, ibx - 1 call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do do p = ibx + 1, nt call reconstruct(n, h, q(p,:), ql(p,:), qr(p,:), s(:)) end do ! copy the normal component of magnetic field to the left and right states ! ql(ibx,:) = b(:) qr(ibx,:) = b(:) #ifdef FIX_POSITIVITY ! check if the reconstruction doesn't give negative densities, if so, correct ! the states ! call fix_positivity(n, q(idn,:), ql(idn,:), qr(idn,:)) #endif /* FIX_POSITIVITY */ ! prepare conservative variables of both states ! call prim2cons(n, ql(:,:), ul(:,:)) call prim2cons(n, qr(:,:), ur(:,:)) ! calculate physical fluxes and speeds for the states ! call fluxspeed(n, ql(:,:), ul(:,:), fl(:,:), cl(:)) call fluxspeed(n, qr(:,:), ur(:,:), fr(:,:), cr(:)) ! iterate over all points ! do i = 1, n ! estimate the minimum and maximum speeds ! sl = min(ql(ivx,i) - cl(i), qr(ivx,i) - cr(i)) sr = max(ql(ivx,i) + cl(i), qr(ivx,i) + cr(i)) ! calculate the HLLD flux ! if (sl >= 0.0d0) then f(:,i) = fl(:,i) else if (sr <= 0.0d0) then f(:,i) = fr(:,i) else ! sl < 0 < sr ! prepare some coefficients ! srl = sr * sl srml = sr - sl #ifdef SHOCK_DETECTION ! calculate the next index ! ip1 = min(n, i + 1) ! check if we are in the vicinity of a shock ! if (s(i) .or. s(ip1)) then ! calculate the fluxes for the intermediate state ! f(:,i) = ((sr * fl(:,i) - sl * fr(:,i)) & + srl * (ur(:,i) - ul(:,i))) / srml else #endif /* SHOCK_DETECTION */ ! density and normal momentum are constant acros the intermediate states ! (eq. 20 and 21) ! dn = ((sr * ur(idn,i) - sl * ul(idn,i)) & - (fr(idn,i) - fl(idn,i))) / srml mx = ((sr * ur(imx,i) - sl * ul(imx,i)) & - (fr(imx,i) - fl(imx,i))) / srml ! calculate corresponding fluxes for density and normal momentum for ! the intermediate states (eq. 22 and 23) ! f(idn,i) = ((sr * fl(idn,i) - sl * fr(idn,i)) & + srl * (ur(idn,i) - ul(idn,i))) / srml f(imx,i) = ((sr * fl(imx,i) - sl * fr(imx,i)) & + srl * (ur(imx,i) - ul(imx,i))) / srml f(ibx,i) = ((sr * fl(ibx,i) - sl * fr(ibx,i)) & + srl * (ur(ibx,i) - ul(ibx,i))) / srml ! the speed of advection in the intermediate states (calculated from eq. 15 ! and eq. 17) ! sm = f(idn,i) / dn ! calculate speed differences ! slmv = sl - ql(ivx,i) srmv = sr - qr(ivx,i) slmm = sl - sm srmm = sr - sm ! prepare some coefficients ! dnl = ql(idn,i) * slmv dnr = qr(idn,i) * srmv sq = sqrt(dn) b2 = b(i) * b(i) ! calculate Alfvén speed (eq. 29) ! ca = abs(b(i)) / sq ! calculate speeds of left and right going Alfvén waves ! sml = sm - ca smr = sm + ca ! calculate the density and normal component of the momentum and magnetic ! field for the left and right intermediate states ! u1l(idn) = dn u1l(imx) = mx u1l(ibx) = b(i) u1r(idn) = dn u1r(imx) = mx u1r(ibx) = b(i) ! calculate tangential components of the magnetic field for the left and right ! intermediate states (like eq. 32-33, but use expressions as in the adabatic ! case and in the degeneracy takes place, revert tangential components to ! the HLL averages) ! dv = dnl * slmm - b2 if (dv /= 0.0d0 .and. ca <= csnd) then fc = (dnl * slmv - b2) / dv u1l(iby) = ul(iby,i) * fc u1l(ibz) = ul(ibz,i) * fc else u1l(iby) = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml u1l(ibz) = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml end if dv = dnr * srmm - b2 if (dv /= 0.0d0 .and. ca <= csnd) then fc = (dnr * srmv - b2) / dv u1r(iby) = ur(iby,i) * fc u1r(ibz) = ur(ibz,i) * fc else u1r(iby) = ((sr * ur(iby,i) - sl * ul(iby,i)) & - (fr(iby,i) - fl(iby,i))) / srml u1r(ibz) = ((sr * ur(ibz,i) - sl * ul(ibz,i)) & - (fr(ibz,i) - fl(ibz,i))) / srml end if ! calculate tangential components of the momentum for the left and right ! intermediate states (like eqs. 30-31, but using already calculated magnetic ! field components for these states) ! u1l(imy) = (ul(imy,i) * slmv + b(i) * (ul(iby,i) - u1l(iby))) / slmm u1l(imz) = (ul(imz,i) * slmv + b(i) * (ul(ibz,i) - u1l(ibz))) / slmm u1r(imy) = (ur(imy,i) * srmv + b(i) * (ur(iby,i) - u1r(iby))) / srmm u1r(imz) = (ur(imz,i) * srmv + b(i) * (ur(ibz,i) - u1r(ibz))) / srmm ! calculate fluxes for the intermediate states ! if (sml > 0.0d0) then ! calculate the left intermediate flux, eq. (38) ! f(imy,i) = fl(imy,i) + sl * (u1l(imy) - ul(imy,i)) f(imz,i) = fl(imz,i) + sl * (u1l(imz) - ul(imz,i)) f(iby,i) = fl(iby,i) + sl * (u1l(iby) - ul(iby,i)) f(ibz,i) = fl(ibz,i) + sl * (u1l(ibz) - ul(ibz,i)) else if (smr < 0.0d0) then ! calculate the right intermediate flux, eq. (38) ! f(imy,i) = fr(imy,i) + sr * (u1r(imy) - ur(imy,i)) f(imz,i) = fr(imz,i) + sr * (u1r(imz) - ur(imz,i)) f(iby,i) = fr(iby,i) + sr * (u1r(iby) - ur(iby,i)) f(ibz,i) = fr(ibz,i) + sr * (u1r(ibz) - ur(ibz,i)) else ! sml ≤ 0 ≤ smr ! calculate the intermediate state (eq. 34-37) ! if (b(i) > 0.0d0) then u2(imy) = 0.5d0 * ((u1l(imy) + u1r(imy)) & + sq * (u1r(iby) - u1l(iby))) u2(imz) = 0.5d0 * ((u1l(imz) + u1r(imz)) & + sq * (u1r(ibz) - u1l(ibz))) u2(iby) = 0.5d0 * ((u1l(iby) + u1r(iby)) & + (u1r(imy) - u1l(imy)) / sq) u2(ibz) = 0.5d0 * ((u1l(ibz) + u1r(ibz)) & + (u1r(imz) - u1l(imz)) / sq) else if (b(i) < 0.0d0) then u2(imy) = 0.5d0 * ((u1l(imy) + u1r(imy)) & - sq * (u1r(iby) - u1l(iby))) u2(imz) = 0.5d0 * ((u1l(imz) + u1r(imz)) & - sq * (u1r(ibz) - u1l(ibz))) u2(iby) = 0.5d0 * ((u1l(iby) + u1r(iby)) & - (u1r(imy) - u1l(imy)) / sq) u2(ibz) = 0.5d0 * ((u1l(ibz) + u1r(ibz)) & - (u1r(imz) - u1l(imz)) / sq) else u2(imy) = 0.5d0 * (u1l(imy) + u1r(imy)) u2(imz) = 0.5d0 * (u1l(imz) + u1r(imz)) u2(iby) = 0.5d0 * (u1l(iby) + u1r(iby)) u2(ibz) = 0.5d0 * (u1l(ibz) + u1r(ibz)) end if ! calculate the intermediate flux (eq. 24) ! f(imy,i) = sm * u2(imy) - b(i) * u2(iby) f(imz,i) = sm * u2(imz) - b(i) * u2(ibz) f(iby,i) = sm * u2(iby) - b(i) * u2(imy) / dn f(ibz,i) = sm * u2(ibz) - b(i) * u2(imz) / dn end if ! sml ≤ 0 ≤ smr #ifdef SHOCK_DETECTION end if ! shock vicinity #endif /* SHOCK_DETECTION */ end if ! sl < 0 < sr end do !------------------------------------------------------------------------------- ! end subroutine riemann #endif /* ISO */ #endif /* HLLD */ #endif /* MHD */ !=============================================================================== ! end module schemes