gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

EQUATIONS: Rewrite a bit esystem_roe_mhd_iso().

Browse Source 
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
1 changed files with 102 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

201
sources/equations.F90
View File

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