EQUATIONS: Rewrite a bit esystem_roe_mhd_iso().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-12-15 16:22:37 -03:00
parent 94b54723b7
commit e0f11b9b21

View File

@ -2717,12 +2717,11 @@ module equations
real(kind=8), dimension(8,8), save :: lvec, rvec real(kind=8), dimension(8,8), save :: lvec, rvec
!$omp threadprivate(first, lvec, rvec) !$omp threadprivate(first, lvec, rvec)
real(kind=8) :: di, btsq, bt_starsq, casq, twid_csq real(kind=8) :: ca, ca2, ct2, cf, cf2, cs, cs2, cf2_cs2
real(kind=8) :: ct2, tsum, tdif, cf2_cs2, cfsq, cf, cssq, cs, ca real(kind=8) :: br, br2, brs, br2s, tsum, tdif, twid_c2, twid_c
real(kind=8) :: bt, bt_star, bet2, bet3, bet2_star, bet3_star, bet_starsq real(kind=8) :: bty, btz, btys, btzs, bt2s, alf, als, norm
real(kind=8) :: alpha_f, alpha_s real(kind=8) :: sqrtd, sgn, qf, qs, af_prime, as_prime
real(kind=8) :: sqrtd, s, twid_c, qf, qs, af_prime, as_prime real(kind=8) :: cff, css, af, as, afpb, aspb, q2s, q3s, vqstr
real(kind=8) :: norm, cff, css, af, as, afpb, aspb, q2_star, q3_star, vqstr
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
@ -2733,22 +2732,22 @@ module equations
first = .false. first = .false.
end if end if
! coefficients ! coefficients for eigenvalues
! !
di = 1.0d+00 / q(idn) ca2 = q(ibx) * q(ibx) / q(idn)
casq = q(ibx) * q(ibx) * di ca = sqrt(ca2)
ca = sqrt(casq) br2 = sum(q(iby:ibz)**2)
btsq = q(iby) * q(iby) + q(ibz) * q(ibz) br2s = br2 * y
bt_starsq = btsq * y ct2 = br2s / q(idn)
twid_csq = csnd2 + x
ct2 = bt_starsq * di twid_c2 = csnd2 + x
tsum = casq + ct2 + twid_csq tsum = ca2 + ct2 + twid_c2
tdif = casq + ct2 - twid_csq tdif = ca2 + ct2 - twid_c2
cf2_cs2 = sqrt(tdif * tdif + 4.0d+00 * twid_csq * ct2) cf2_cs2 = sqrt(tdif * tdif + 4.0d+00 * twid_c2 * ct2)
cfsq = 0.5d+00 * (tsum + cf2_cs2) cf2 = 0.5d+00 * (tsum + cf2_cs2)
cf = sqrt(cfsq) cf = sqrt(cf2)
cssq = twid_csq * casq / cfsq cs2 = twid_c2 * ca2 / cf2
cs = sqrt(cssq) cs = sqrt(cs2)
! eigenvalues ! eigenvalues
! !
@ -2767,134 +2766,134 @@ module equations
! remaining coefficients ! remaining coefficients
! !
bt = sqrt(btsq) br = sqrt(br2)
bt_star = sqrt(bt_starsq) brs = sqrt(br2s)
if (abs(bt) > 0.0d+00) then if (abs(br) > 0.0d+00) then
bet2 = q(iby) / bt bty = q(iby) / br
bet3 = q(ibz) / bt btz = q(ibz) / br
else else
bet2 = 1.0d+00 bty = 1.0d+00
bet3 = 0.0d+00 btz = 0.0d+00
end if end if
bet2_star = bet2 / sqrt(y) btys = bty / sqrt(y)
bet3_star = bet3 / sqrt(y) btzs = btz / sqrt(y)
bet_starsq = bet2_star * bet2_star + bet3_star * bet3_star bt2s = btys * btys + btzs * btzs
if (.not. abs(cfsq - cssq) > 0.0d+00) then if (.not. abs(cf2 - cs2) > 0.0d+00) then
alpha_f = 1.0d+00 alf = 1.0d+00
alpha_s = 0.0d+00 als = 0.0d+00
else if ((twid_csq - cssq) <= 0.0d+00) then else if ((twid_c2 - cs2) <= 0.0d+00) then
alpha_f = 0.0d+00 alf = 0.0d+00
alpha_s = 1.0d+00 als = 1.0d+00
else if ((cfsq - twid_csq) <= 0.0d+00) then else if ((cf2 - twid_c2) <= 0.0d+00) then
alpha_f = 1.0d+00 alf = 1.0d+00
alpha_s = 0.0d+00 als = 0.0d+00
else else
alpha_f = sqrt((twid_csq - cssq) / (cfsq - cssq)) alf = sqrt((twid_c2 - cs2) / (cf2 - cs2))
alpha_s = sqrt((cfsq - twid_csq) / (cfsq - cssq)) als = sqrt((cf2 - twid_c2) / (cf2 - cs2))
end if end if
sqrtd = sqrt(q(idn)) sqrtd = sqrt(q(idn))
s = sign(1.0d+00, q(ibx)) sgn = sign(1.0d+00, q(ibx))
twid_c = sqrt(twid_csq) twid_c = sqrt(twid_c2)
qf = cf * alpha_f * s qf = cf * alf * sgn
qs = cs * alpha_s * s qs = cs * als * sgn
af_prime = twid_c * alpha_f / sqrtd af_prime = twid_c * alf / sqrtd
as_prime = twid_c * alpha_s / sqrtd as_prime = twid_c * als / sqrtd
! update the varying elements of the matrix of right eigenvectors ! === update the varying elements of the right eigenvectors matrix
! !
! left-going fast wave ! left-going fast wave
! !
rvec(1,idn) = alpha_f rvec(1,idn) = alf
rvec(1,ivx) = alpha_f * c(1) rvec(1,ivx) = alf * c(1)
rvec(1,ivy) = alpha_f * q(ivy) + qs * bet2_star rvec(1,ivy) = alf * q(ivy) + qs * btys
rvec(1,ivz) = alpha_f * q(ivz) + qs * bet3_star rvec(1,ivz) = alf * q(ivz) + qs * btzs
rvec(1,iby) = as_prime * bet2_star rvec(1,iby) = as_prime * btys
rvec(1,ibz) = as_prime * bet3_star rvec(1,ibz) = as_prime * btzs
! left-going Alfvèn wave ! left-going Alfvèn wave
! !
rvec(2,ivy) = - bet3 rvec(2,ivy) = - btz
rvec(2,ivz) = bet2 rvec(2,ivz) = bty
rvec(2,iby) = - bet3 * s / sqrtd rvec(2,iby) = - btz * sgn / sqrtd
rvec(2,ibz) = bet2 * s / sqrtd rvec(2,ibz) = bty * sgn / sqrtd
! left-going slow wave ! left-going slow wave
! !
rvec(3,idn) = alpha_s rvec(3,idn) = als
rvec(3,ivx) = alpha_s * c(3) rvec(3,ivx) = als * c(3)
rvec(3,ivy) = alpha_s * q(ivy) - qf * bet2_star rvec(3,ivy) = als * q(ivy) - qf * btys
rvec(3,ivz) = alpha_s * q(ivz) - qf * bet3_star rvec(3,ivz) = als * q(ivz) - qf * btzs
rvec(3,iby) = - af_prime * bet2_star rvec(3,iby) = - af_prime * btys
rvec(3,ibz) = - af_prime * bet3_star rvec(3,ibz) = - af_prime * btzs
! right-going slow wave ! right-going slow wave
! !
rvec(5,idn) = alpha_s rvec(5,idn) = als
rvec(5,ivx) = alpha_s * c(5) rvec(5,ivx) = als * c(5)
rvec(5,ivy) = alpha_s * q(ivy) + qf * bet2_star rvec(5,ivy) = als * q(ivy) + qf * btys
rvec(5,ivz) = alpha_s * q(ivz) + qf * bet3_star rvec(5,ivz) = als * q(ivz) + qf * btzs
rvec(5,iby) = rvec(3,iby) rvec(5,iby) = rvec(3,iby)
rvec(5,ibz) = rvec(3,ibz) rvec(5,ibz) = rvec(3,ibz)
! right-going Alfvèn wave ! right-going Alfvèn wave
! !
rvec(6,ivy) = bet3 rvec(6,ivy) = btz
rvec(6,ivz) = - bet2 rvec(6,ivz) = - bty
rvec(6,iby) = rvec(2,iby) rvec(6,iby) = rvec(2,iby)
rvec(6,ibz) = rvec(2,ibz) rvec(6,ibz) = rvec(2,ibz)
! right-going fast wave ! right-going fast wave
! !
rvec(7,idn) = alpha_f rvec(7,idn) = alf
rvec(7,ivx) = alpha_f * c(7) rvec(7,ivx) = alf * c(7)
rvec(7,ivy) = alpha_f * q(ivy) - qs * bet2_star rvec(7,ivy) = alf * q(ivy) - qs * btys
rvec(7,ivz) = alpha_f * q(ivz) - qs * bet3_star rvec(7,ivz) = alf * q(ivz) - qs * btzs
rvec(7,iby) = rvec(1,iby) rvec(7,iby) = rvec(1,iby)
rvec(7,ibz) = rvec(1,ibz) rvec(7,ibz) = rvec(1,ibz)
! update the varying elements of the matrix of left eigenvectors ! === update the varying elements of the left eigenvectors matrix
! !
norm = 0.5d+00 / twid_csq norm = 2.0d+00 * twid_c2
cff = norm * alpha_f * cf cff = alf * cf / norm
css = norm * alpha_s * cs css = als * cs / norm
qf = qf * norm qf = qf / norm
qs = qs * norm qs = qs / norm
af = norm * af_prime * q(idn) af = af_prime * q(idn) / norm
as = norm * as_prime * q(idn) as = as_prime * q(idn) / norm
afpb = norm * af_prime * bt_star afpb = af_prime * brs / norm
aspb = norm * as_prime * bt_star aspb = as_prime * brs / norm
q2_star = bet2_star / bet_starsq q2s = btys / bt2s
q3_star = bet3_star / bet_starsq q3s = btzs / bt2s
vqstr = q(ivy) * q2_star + q(ivz) * q3_star vqstr = q(ivy) * q2s + q(ivz) * q3s
! left-going fast wave ! left-going fast wave
! !
lvec(idn,1) = cff * c(7) - qs * vqstr - aspb lvec(idn,1) = cff * c(7) - qs * vqstr - aspb
lvec(ivx,1) = - cff lvec(ivx,1) = - cff
lvec(ivy,1) = qs * q2_star lvec(ivy,1) = qs * q2s
lvec(ivz,1) = qs * q3_star lvec(ivz,1) = qs * q3s
lvec(iby,1) = as * q2_star lvec(iby,1) = as * q2s
lvec(ibz,1) = as * q3_star lvec(ibz,1) = as * q3s
! left-going Alfvèn wave ! left-going Alfvèn wave
! !
lvec(idn,2) = 0.5d+00 * (q(ivy) * bet3 - q(ivz) * bet2) lvec(idn,2) = 0.5d+00 * (q(ivy) * btz - q(ivz) * bty)
lvec(ivy,2) = - 0.5d+00 * bet3 lvec(ivy,2) = - 0.5d+00 * btz
lvec(ivz,2) = 0.5d+00 * bet2 lvec(ivz,2) = 0.5d+00 * bty
lvec(iby,2) = - 0.5d+00 * sqrtd * bet3 * s lvec(iby,2) = - 0.5d+00 * sqrtd * btz * sgn
lvec(ibz,2) = 0.5d+00 * sqrtd * bet2 * s lvec(ibz,2) = 0.5d+00 * sqrtd * bty * sgn
! left-going slow wave ! left-going slow wave
! !
lvec(idn,3) = css * c(5) + qf * vqstr + afpb lvec(idn,3) = css * c(5) + qf * vqstr + afpb
lvec(ivx,3) = - css lvec(ivx,3) = - css
lvec(ivy,3) = - qf * q2_star lvec(ivy,3) = - qf * q2s
lvec(ivz,3) = - qf * q3_star lvec(ivz,3) = - qf * q3s
lvec(iby,3) = - af * q2_star lvec(iby,3) = - af * q2s
lvec(ibz,3) = - af * q3_star lvec(ibz,3) = - af * q3s
! right-going slow wave ! right-going slow wave
! !