Add modular precision update #632
Merged
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
sbryngelson
approved these changes
Sep 21, 2024
|
If this works, we will need to test that it works on NVIDIA and AMD GPUs in single precision mode. |
Codecov ReportAttention: Patch coverage is
Additional details and impacted files@@ Coverage Diff @@
## master #632 +/- ##
==========================================
- Coverage 45.86% 45.81% -0.06%
==========================================
Files 61 61
Lines 16898 16911 +13
Branches 1961 1969 +8
==========================================
- Hits 7751 7748 -3
- Misses 7934 7944 +10
- Partials 1213 1219 +6 ☔ View full report in Codecov by Sentry. |
|
What are the next steps for me? |
|
@aricer123 CodeCov fails randomly all the time, and it isn't because of the 'diff hit'. So don't worry about that. I'm cloning your repo now to have a look. The good news is in double precision your code maintains performance on NVIDIA GPU and regular CPU (the benchmark CI tests). It would indeed be useful to switch to single precision via a commit so we see what benchmark CI reports. |
|
you have a slight problem here in integer, parameter :: wp = double_precision
#ifdef MFC_MPI
integer, parameter :: mpi_p = MPI_DOUBLE_PRECISIONnotice that one has to declare the precision twice. Ideally, you would "pick it" once, and that variable would then determine what |
|
Requesting some amount of review from @wilfonba and @henryleberre |
|
Single precision doesn't work because you have many double precision intrinsics left, like You will also need to address the c-types: shb-m1pro-3: MFC/src $ grep -iR 'c_double' ./*
./simulation/m_fftw.fpp: real(c_double), pointer :: data_real(:) !< Real data
./simulation/m_fftw.fpp: complex(c_double_complex), pointer :: data_cmplx(:) !<
./simulation/m_fftw.fpp: complex(c_double_complex), pointer :: data_fltr_cmplx(:) !<
./simulation/m_fftw.fpp: real(c_double), pointer :: p_real(:)
./simulation/m_fftw.fpp: complex(c_double_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:)The code builds and seems to run with the below patch in single precision (it did not build w/ single precision @ current commit). However, the grind time appears to be the same for single vs. double. Update: Even if I add the line diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp
index a8ef8697..fa6fba51 100644
--- a/src/common/m_constants.fpp
+++ b/src/common/m_constants.fpp
@@ -9,10 +9,10 @@ module m_constants
character, parameter :: dflt_char = ' ' !< Default string value
real(wp), parameter :: dflt_real = -1d6 !< Default real value
- real(wp), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance
- real(wp), parameter :: small_alf = 1d-11 !< Small alf tolerance
+ real(wp), parameter :: sgm_eps = 1e-16 !< Segmentation tolerance
+ real(wp), parameter :: small_alf = 1e-11 !< Small alf tolerance
real(wp), parameter :: pi = 3.141592653589793_wp !< Pi
- real(wp), parameter :: verysmall = 1.d-12 !< Very small number
+ real(wp), parameter :: verysmall = 1.e-12 !< Very small number
integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils
integer, parameter :: path_len = 400 !< Maximum path length
diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90
index 80198afb..c460ae30 100644
--- a/src/common/m_eigen_solver.f90
+++ b/src/common/m_eigen_solver.f90
@@ -163,8 +163,8 @@ contains
do 200 j = k, l
if (j == i) go to 200
- c = c + dabs(ar(j, i)) + dabs(ai(j, i))
- r = r + dabs(ar(i, j)) + dabs(ai(i, j))
+ c = c + abs(ar(j, i)) + abs(ai(j, i))
+ r = r + abs(ar(i, j)) + abs(ai(i, j))
200 end do
! .......... guard against zero c or r due to underflow ..........
if (c == 0.0_wp .or. r == 0.0_wp) go to 270
@@ -243,7 +243,7 @@ contains
scale = 0.0_wp
! .......... scale column (algol tol then not needed) ..........
do 90 i = ml, igh
- scale = scale + dabs(ar(i, ml - 1)) + dabs(ai(i, ml - 1))
+ scale = scale + abs(ar(i, ml - 1)) + abs(ai(i, ml - 1))
90 end do
if (scale == 0._wp) go to 180
mp = ml + igh
@@ -255,7 +255,7 @@ contains
h = h + ortr(i)*ortr(i) + orti(i)*orti(i)
100 end do
!
- g = dsqrt(h)
+ g = sqrt(h)
call pythag(ortr(ml), orti(ml), f)
if (f == 0._wp) go to 103
h = h + f*g
@@ -375,8 +375,8 @@ contains
! .......... for i=igh-1 step -1 until low+1 do -- ..........
105 do 140 ii = 1, iend
i = igh - ii
- if (dabs(ortr(i)) == 0._wp .and. dabs(orti(i)) == 0._wp) go to 140
- if (dabs(hr(i, i - 1)) == 0._wp .and. dabs(hi(i, i - 1)) == 0._wp) go to 140
+ if (abs(ortr(i)) == 0._wp .and. abs(orti(i)) == 0._wp) go to 140
+ if (abs(hr(i, i - 1)) == 0._wp .and. abs(hi(i, i - 1)) == 0._wp) go to 140
! .......... norm below is negative of h formed in corth ..........
norm = hr(i, i - 1)*ortr(i) + hi(i, i - 1)*orti(i)
ip1 = i + 1
@@ -411,7 +411,7 @@ contains
!
do 170 i = l, igh
ll = min0(i + 1, igh)
- if (dabs(hi(i, i - 1)) == 0._wp) go to 170
+ if (abs(hi(i, i - 1)) == 0._wp) go to 170
call pythag(hr(i, i - 1), hi(i, i - 1), norm)
yr = hr(i, i - 1)/norm
yi = hi(i, i - 1)/norm
@@ -456,9 +456,9 @@ contains
240 do 260 ll = low, en
l = en + low - ll
if (l == low) go to 300
- tst1 = dabs(hr(l - 1, l - 1)) + dabs(hi(l - 1, l - 1)) &
- + dabs(hr(l, l)) + dabs(hi(l, l))
- tst2 = tst1 + dabs(hr(l, l - 1))
+ tst1 = abs(hr(l - 1, l - 1)) + abs(hi(l - 1, l - 1)) &
+ + abs(hr(l, l)) + abs(hi(l, l))
+ tst2 = tst1 + abs(hr(l, l - 1))
if (tst2 == tst1) go to 300
260 end do
! .......... form shift ..........
@@ -481,7 +481,7 @@ contains
si = si - xxi
go to 340
! .......... form exceptional shift ..........
-320 sr = dabs(hr(en, enm1)) + dabs(hr(enm1, en - 2))
+320 sr = abs(hr(en, enm1)) + abs(hr(enm1, en - 2))
si = 0.0_wp
!
340 do 360 i = low, en
@@ -523,7 +523,7 @@ contains
500 end do
!
si = hi(en, en)
- if (dabs(si) == 0._wp) go to 540
+ if (abs(si) == 0._wp) go to 540
call pythag(hr(en, en), si, norm)
sr = hr(en, en)/norm
si = si/norm
@@ -568,7 +568,7 @@ contains
590 end do
600 end do
!
- if (dabs(si) == 0._wp) go to 240
+ if (abs(si) == 0._wp) go to 240
!
do 630 i = 1, en
yr = hr(i, en)
@@ -598,7 +598,7 @@ contains
!
do i = 1, nl
do j = i, nl
- tr = dabs(hr(i, j)) + dabs(hi(i, j))
+ tr = abs(hr(i, j)) + abs(hi(i, j))
if (tr > norm) norm = tr
end do
end do
@@ -635,7 +635,7 @@ contains
765 continue
call cdiv(zzr, zzi, yr, yi, hr(i, en), hi(i, en))
! .......... overflow control ..........
- tr = dabs(hr(i, en)) + dabs(hi(i, en))
+ tr = abs(hr(i, en)) + abs(hi(i, en))
if (tr == 0.0_wp) go to 780
tst1 = tr
tst2 = tst1 + 1.0_wp/tst1
@@ -709,12 +709,12 @@ contains
!! transformed in their first ml columns
subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi)
integer, intent(in) :: nm, nl, low, igh
- double precision, intent(in) :: scale(nl)
+ real(wp), intent(in) :: scale(nl)
integer, intent(in) :: ml
- double precision, intent(inout) :: zr(nm, ml), zi(nm, ml)
+ real(wp), intent(inout) :: zr(nm, ml), zi(nm, ml)
integer :: i, j, k, ii
- double precision :: s
+ real(wp) :: s
if (ml == 0) go to 200
if (igh == low) go to 120
@@ -757,14 +757,14 @@ contains
real(wp), intent(in) :: xr, xi
real(wp), intent(out) :: yr, yi
!
-! (yr,yi) = complex dsqrt(xr,xi)
+! (yr,yi) = complex sqrt(xr,xi)
! branch chosen so that yr .ge. 0.0 and sign(yi) .eq. sign(xi)
!
real(wp) :: s, tr, ti, c
tr = xr
ti = xi
call pythag(tr, ti, c)
- s = dsqrt(0.5_wp*(c + dabs(tr)))
+ s = sqrt(0.5_wp*(c + abs(tr)))
if (tr >= 0.0_wp) yr = s
if (ti < 0.0_wp) s = -s
if (tr <= 0.0_wp) yi = s
@@ -786,7 +786,7 @@ contains
! cr = (ar*br + ai*bi) / (br**2._wp + bi**2._wp)
! ci = (ai*br - ar*bi) / (br**2._wp + bi**2._wp)
- s = dabs(br) + dabs(bi)
+ s = abs(br) + abs(bi)
ars = ar/s
ais = ai/s
brs = br/s
@@ -801,12 +801,12 @@ contains
real(wp), intent(in) :: a, b
real(wp), intent(out) :: c
!
-! finds dsqrt(a**2+b**2) without overflow or destructive underflow
+! finds sqrt(a**2+b**2) without overflow or destructive underflow
!
real(wp) :: p, r, s, t, u
- p = dmax1(dabs(a), dabs(b))
+ p = dmax1(abs(a), abs(b))
if (p == 0.0_wp) go to 20
- r = (dmin1(dabs(a), dabs(b))/p)**2
+ r = (dmin1(abs(a), abs(b))/p)**2
10 continue
t = 4.0_wp + r
if (t == 4.0_wp) go to 20
diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp
index a4062ab5..ab9bbcaa 100644
--- a/src/common/m_helper.fpp
+++ b/src/common/m_helper.fpp
@@ -68,7 +68,7 @@ contains
real(wp) :: nR3
nR3 = dot_product(weights, nRtmp**3._wp)
- ntmp = DSQRT((4._wp*pi/3._wp)*nR3/vftmp)
+ ntmp = sqrt((4._wp*pi/3._wp)*nR3/vftmp)
!ntmp = (3._wp/(4._wp*pi))*0.00001
!print *, "nbub", ntmp
@@ -153,8 +153,8 @@ contains
if (thermal == 2) gamma_m = 1._wp
temp = 293.15_wp
- D_m = 0.242d-4
- uu = DSQRT(pl0/rhol0)
+ D_m = 0.242e-4
+ uu = sqrt(pl0/rhol0)
omega_ref = 3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/Web
@@ -163,10 +163,10 @@ contains
R_n = Ru/M_n
R_v = Ru/M_v
! phi_vn & phi_nv (phi_nn = phi_vv = 1)
- phi_vn = (1._wp + DSQRT(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 &
- /(DSQRT(8._wp)*DSQRT(1._wp + M_v/M_n))
- phi_nv = (1._wp + DSQRT(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 &
- /(DSQRT(8._wp)*DSQRT(1._wp + M_n/M_v))
+ phi_vn = (1._wp + sqrt(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 &
+ /(sqrt(8._wp)*sqrt(1._wp + M_v/M_n))
+ phi_nv = (1._wp + sqrt(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 &
+ /(sqrt(8._wp)*sqrt(1._wp + M_n/M_v))
! internal bubble pressure
pb0 = pl0 + 2._wp*ss/(R0ref*R0)
@@ -208,7 +208,7 @@ contains
!end if
! natural frequencies
- omegaN = DSQRT(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0
+ omegaN = sqrt(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0
do ir = 1, Nb
call s_transcoeff(omegaN(ir)*R0(ir), Pe_T(ir)*R0(ir), &
Re_trans_T(ir), Im_trans_T(ir))
@@ -273,30 +273,30 @@ contains
!R0mx = 150.D0
sd = poly_sigma
- R0mn = 0.8_wp*DEXP(-2.8_wp*sd)
- R0mx = 0.2_wp*DEXP(9.5_wp*sd) + 1._wp
+ R0mn = 0.8_wp*exp(-2.8_wp*sd)
+ R0mx = 0.2_wp*exp(9.5_wp*sd) + 1._wp
! phi = ln( R0 ) & return R0
do ir = 1, nb
- phi(ir) = DLOG(R0mn) &
- + dble(ir - 1)*DLOG(R0mx/R0mn)/dble(nb - 1)
- R0(ir) = DEXP(phi(ir))
+ phi(ir) = log(R0mn) &
+ + dble(ir - 1)*log(R0mx/R0mn)/dble(nb - 1)
+ R0(ir) = exp(phi(ir))
end do
dphi = phi(2) - phi(1)
! weights for quadrature using Simpson's rule
do ir = 2, nb - 1
! Gaussian
- tmp = DEXP(-0.5_wp*(phi(ir)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(ir)/sd)**2)/sqrt(2._wp*pi)/sd
if (mod(ir, 2) == 0) then
weight(ir) = tmp*4._wp*dphi/3._wp
else
weight(ir) = tmp*2._wp*dphi/3._wp
end if
end do
- tmp = DEXP(-0.5_wp*(phi(1)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(1)/sd)**2)/sqrt(2._wp*pi)/sd
weight(1) = tmp*dphi/3._wp
- tmp = DEXP(-0.5_wp*(phi(nb)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(nb)/sd)**2)/sqrt(2._wp*pi)/sd
weight(nb) = tmp*dphi/3._wp
end subroutine s_simpson
diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90
index b5483998..9d358e29 100644
--- a/src/common/m_helper_basic.f90
+++ b/src/common/m_helper_basic.f90
@@ -22,7 +22,7 @@ contains
!> This procedure checks if two floating point numbers of wp are within tolerance.
!! @param a First number.
!! @param b Second number.
- !! @param tol_input Relative error (default = 1d-6).
+ !! @param tol_input Relative error (default = 1e-6).
!! @return Result of the comparison.
logical function f_approx_equal(a, b, tol_input) result(res)
!$acc routine seq
@@ -35,7 +35,7 @@ contains
if (present(tol_input)) then
tol = tol_input
else
- tol = 1d-6
+ tol = 1e-6
end if
if (a == b) then
diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp
index 9264a14b..b6b47019 100644
--- a/src/common/m_phase_change.fpp
+++ b/src/common/m_phase_change.fpp
@@ -54,7 +54,7 @@ module m_phase_change
integer, parameter :: max_iter = 1e8 !< max # of iterations
real(wp), parameter :: pCr = 4.94d7 !< Critical water pressure
real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature
- real(wp), parameter :: mixM = 1.0d-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen
+ real(wp), parameter :: mixM = 1.0e-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen
integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid
integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid
!> @}
@@ -148,7 +148,7 @@ contains
!$acc loop seq
do i = momxb, momxe
- dynE = dynE + 5.0d-1*q_cons_vf(i)%sf(j, k, l)**2/rho
+ dynE = dynE + 5.0e-1*q_cons_vf(i)%sf(j, k, l)**2/rho
end do
@@ -246,7 +246,7 @@ contains
! Calculations AFTER equilibrium
! entropy
- sk(1:num_fluids) = cvs(1:num_fluids)*DLOG((TS**gs_min(1:num_fluids)) &
+ sk(1:num_fluids) = cvs(1:num_fluids)*log((TS**gs_min(1:num_fluids)) &
/((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids)
! enthalpy
@@ -357,7 +357,7 @@ contains
! Newton Solver for the pT-equilibrium
ns = 0
! change this relative error metric. 1E4 is just arbitrary
- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0))
+ do while ((abs(pS - pO) > palpha_eps) .and. (abs((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0))
! increasing counter
ns = ns + 1
@@ -381,7 +381,7 @@ contains
hp = 1.0_wp/(rhoe + pS - mQ) + 1.0_wp/(pS + minval(p_infpT))
! updating common pressure for the newton solver
- pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + DABS(1.0_wp - gp)) &
+ pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + abs(1.0_wp - gp)) &
/(2.0_wp*gpp)*hp)
end do
@@ -425,14 +425,14 @@ contains
ns = 0
! Relaxation factor
- Om = 1.0d-3
+ Om = 1.0e-3
p_infpTg = p_infpT
if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) &
+ q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe &
- gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. &
- ((pS >= 0.0_wp) .and. (pS < 1.0d-1))) then
+ ((pS >= 0.0_wp) .and. (pS < 1.0e-1))) then
! improve this initial condition
pS = 1.0d4
@@ -446,8 +446,8 @@ contains
! improve this initial condition
R2D(1) = 0.0_wp; R2D(2) = 0.0_wp
DeltamP(1) = 0.0_wp; DeltamP(2) = 0.0_wp
- do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) &
- .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) &
+ do while (((sqrt(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) &
+ .and. ((sqrt(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) &
.or. (ns == 0))
! Updating counter for the iterative procedure
@@ -605,10 +605,10 @@ contains
+ mCVGP)
dFdT = &
- -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TS) &
+ -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TS) &
- (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp))
+ + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp))
dTdm = -(cvs(lp)*(gs_min(lp) - 1)/(pS + ps_inf(lp)) &
- cvs(vp)*(gs_min(vp) - 1)/(pS + ps_inf(vp)))*TS**2
@@ -706,9 +706,9 @@ contains
! Gibbs Free Energy Equality condition (DG)
R2D(1) = TS*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) &
- *(1 - DLOG(TS)) - (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp))) &
+ *(1 - log(TS)) - (qvps(lp) - qvps(vp)) &
+ + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp))) &
+ qvs(lp) - qvs(vp)
! Constant Energy Process condition (DE)
@@ -754,24 +754,24 @@ contains
ns = 0
! underrelaxation factor
- Om = 1.0d-3
- do while ((DABS(FT) > ptgalpha_eps) .or. (ns == 0))
+ Om = 1.0e-3
+ do while ((abs(FT) > ptgalpha_eps) .or. (ns == 0))
! increasing counter
ns = ns + 1
! calculating residual
FT = TSat*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) &
- *(1 - DLOG(TSat)) - (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp))) &
+ *(1 - log(TSat)) - (qvps(lp) - qvps(vp)) &
+ + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp))) &
+ qvs(lp) - qvs(vp)
! calculating the jacobian
dFdT = &
- -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TSat) &
+ -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TSat) &
- (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp))
+ + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp))
! updating saturation temperature
TSat = TSat - Om*FT/dFdT
diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90
index a95ffbb7..013a2201 100644
--- a/src/common/m_precision_select.f90
+++ b/src/common/m_precision_select.f90
@@ -13,9 +13,10 @@ module m_precision_select
integer, parameter :: single_precision = selected_real_kind(6, 37)
integer, parameter :: double_precision = selected_real_kind(15, 307)
- integer, parameter :: wp = double_precision
+ integer, parameter :: wp = single_precision
#ifdef MFC_MPI
- integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION
+ integer, parameter :: mpi_p = MPI_FLOAT
+ ! integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION
#else
integer, parameter :: mpi_p = -100
#endif
diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp
index de7fdd5e..054255c7 100644
--- a/src/common/m_variables_conversion.fpp
+++ b/src/common/m_variables_conversion.fpp
@@ -189,7 +189,7 @@ contains
Y_rs(i) = rhoYks(i)/rho
end do
- if (sum(Y_rs) > 1d-16) then
+ if (sum(Y_rs) > 1e-16) then
call get_temperature(.true., energy - dyn_p, 1200._wp, Y_rs, T)
call get_pressure(rho, T, Y_rs, pres)
else
@@ -295,7 +295,7 @@ contains
alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp)
end do
- alpha_K = alpha_K/max(sum(alpha_K), 1d-16)
+ alpha_K = alpha_K/max(sum(alpha_K), 1e-16)
end if
@@ -420,7 +420,7 @@ contains
alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp)
end do
- alpha_K = alpha_K/max(sum(alpha_K), 1d-16)
+ alpha_K = alpha_K/max(sum(alpha_K), 1e-16)
end if
@@ -987,7 +987,7 @@ contains
if (model_eqns /= 4) then
qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) &
/rho_K
- dyn_pres_K = dyn_pres_K + 5d-1*qK_cons_vf(i)%sf(j, k, l) &
+ dyn_pres_K = dyn_pres_K + 5e-1*qK_cons_vf(i)%sf(j, k, l) &
*qK_prim_vf(i)%sf(j, k, l)
else
qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) &
@@ -1349,7 +1349,7 @@ contains
! Computing the energy from the pressure
E_K = gamma_K*pres_K + pi_inf_K &
- + 5d-1*rho_K*vel_K_sum + qv_K
+ + 5e-1*rho_K*vel_K_sum + qv_K
! mass flux, this should be \alpha_i \rho_i u_i
!$acc loop seq
@@ -1468,7 +1468,7 @@ contains
(rho*(1._wp - adv(num_fluids)))
end if
else
- c = ((H - 5d-1*vel_sum)/gamma)
+ c = ((H - 5e-1*vel_sum)/gamma)
end if
if (mixture_err .and. c < 0._wp) then
diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp
index 536d4289..530c654d 100644
--- a/src/post_process/m_derived_variables.fpp
+++ b/src/post_process/m_derived_variables.fpp
@@ -212,7 +212,7 @@ contains
end if
if (mixture_err .and. q_sf(i, j, k) < 0._wp) then
- q_sf(i, j, k) = 1d-16
+ q_sf(i, j, k) = 1e-16
else
q_sf(i, j, k) = sqrt(q_sf(i, j, k))
end if
@@ -285,8 +285,8 @@ contains
end if
end if
- if (abs(top) < 1d-8) top = 0._wp
- if (abs(bottom) < 1d-8) bottom = 0._wp
+ if (abs(top) < 1e-8) top = 0._wp
+ if (abs(bottom) < 1e-8) bottom = 0._wp
if (top == bottom) then
slope = 1._wp
@@ -295,20 +295,20 @@ contains
! (bottom == 0._wp .AND. top /= 0._wp)) THEN
! slope = 0._wp
else
- slope = (top*bottom)/(bottom**2._wp + 1d-16)
+ slope = (top*bottom)/(bottom**2._wp + 1e-16)
end if
! Flux limiter function
if (flux_lim == 1) then ! MINMOD (MM)
q_sf(j, k, l) = max(0._wp, min(1._wp, slope))
elseif (flux_lim == 2) then ! MUSCL (MC)
- q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5d-1*(1._wp + slope), 2._wp))
+ q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5e-1*(1._wp + slope), 2._wp))
elseif (flux_lim == 3) then ! OSPRE (OP)
- q_sf(j, k, l) = (15d-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp)
+ q_sf(j, k, l) = (15e-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp)
elseif (flux_lim == 4) then ! SUPERBEE (SB)
q_sf(j, k, l) = max(0._wp, min(1._wp, 2._wp*slope), min(slope, 2._wp))
elseif (flux_lim == 5) then ! SWEBY (SW) (beta = 1.5)
- q_sf(j, k, l) = max(0._wp, min(15d-1*slope, 1._wp), min(slope, 15d-1))
+ q_sf(j, k, l) = max(0._wp, min(15e-1*slope, 1._wp), min(slope, 15e-1))
elseif (flux_lim == 6) then ! VAN ALBADA (VA)
q_sf(j, k, l) = (slope**2._wp + slope)/(slope**2._wp + 1._wp)
elseif (flux_lim == 7) then ! VAN LEER (VL)
@@ -321,7 +321,7 @@ contains
!> Computes the solution to the linear system Ax=b w/ sol = x
!! @param A Input matrix
- !! @param b right-hand-side
+ !! @param b right-hane-side
!! @param sol Solution
!! @param ndim Problem size
subroutine s_solve_linear_system(A, b, sol, ndim)
diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp
index 23f11a46..fa8b1c0a 100644
--- a/src/pre_process/include/2dHardcodedIC.fpp
+++ b/src/pre_process/include/2dHardcodedIC.fpp
@@ -80,7 +80,7 @@
intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
- alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
+ alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
if (alph < eps) alph = eps
if (alph > 1 - eps) alph = 1 - eps
diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp
index 4448297e..75b2fbd5 100644
--- a/src/pre_process/include/3dHardcodedIC.fpp
+++ b/src/pre_process/include/3dHardcodedIC.fpp
@@ -23,7 +23,7 @@
intH = amp*(sin(2*pi*x_cc(i)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h
- alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
+ alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
if (alph < eps) alph = eps
if (alph > 1 - eps) alph = 1 - eps
diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp
index c43cfd89..4d4c93ab 100644
--- a/src/pre_process/m_assign_variables.fpp
+++ b/src/pre_process/m_assign_variables.fpp
@@ -197,7 +197,7 @@ contains
#:endif
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id
end subroutine s_assign_patch_mixture_primitive_variables
@@ -216,7 +216,7 @@ contains
real(wp) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno
p0 = 101325
- pres_mag = 1d-1
+ pres_mag = 1e-1
loc = x_cc(177)
n_tait = fluid_pp(1)%gamma
B_tait = fluid_pp(1)%pi_inf
@@ -264,7 +264,7 @@ contains
velH = 0._wp
else
velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno
- velH = dsqrt(velH)
+ velH = sqrt(velH)
velH = velH*deno
end if
@@ -439,10 +439,10 @@ contains
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
else if (dist_type == 2) then
q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
- q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR
+ q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR
q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV
- q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2)
- q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV
+ q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2)
+ q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
end if
else
@@ -604,10 +604,10 @@ contains
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
else if (dist_type == 2) then
q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
- q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR
+ q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR
q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV
- q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2)
- q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV
+ q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2)
+ q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
end if
else
@@ -669,7 +669,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id
end subroutine s_assign_patch_species_primitive_variables
diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90
index 9f8e0291..17e84be2 100644
--- a/src/pre_process/m_grid.f90
+++ b/src/pre_process/m_grid.f90
@@ -64,7 +64,7 @@ contains
dx = (x_domain%end - x_domain%beg)/real(m + 1, wp)
do i = 0, m
- x_cc(i) = x_domain%beg + 5d-1*dx*real(2*i + 1, wp)
+ x_cc(i) = x_domain%beg + 5e-1*dx*real(2*i + 1, wp)
x_cb(i - 1) = x_domain%beg + dx*real(i, wp)
end do
@@ -104,7 +104,7 @@ contains
dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp)
- y_cc(0) = y_domain%beg + 5d-1*dy
+ y_cc(0) = y_domain%beg + 5e-1*dy
y_cb(-1) = y_domain%beg
do i = 1, n
@@ -117,7 +117,7 @@ contains
dy = (y_domain%end - y_domain%beg)/real(n + 1, wp)
do i = 0, n
- y_cc(i) = y_domain%beg + 5d-1*dy*real(2*i + 1, wp)
+ y_cc(i) = y_domain%beg + 5e-1*dy*real(2*i + 1, wp)
y_cb(i - 1) = y_domain%beg + dy*real(i, wp)
end do
@@ -157,7 +157,7 @@ contains
dz = (z_domain%end - z_domain%beg)/real(p + 1, wp)
do i = 0, p
- z_cc(i) = z_domain%beg + 5d-1*dz*real(2*i + 1, wp)
+ z_cc(i) = z_domain%beg + 5e-1*dz*real(2*i + 1, wp)
z_cb(i - 1) = z_domain%beg + dz*real(i, wp)
end do
diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp
index f4a7fa5d..6c11cc21 100644
--- a/src/pre_process/m_model.fpp
+++ b/src/pre_process/m_model.fpp
@@ -489,7 +489,7 @@ contains
end function f_model_is_inside
- ! From https://www.scratchapixel.com/lessons/3d-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html
+ ! From https://www.scratchapixel.com/lessons/3e-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html
!> This procedure checks if a ray intersects a triangle.
!! @param ray Ray.
!! @param triangle Triangle.
diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp
index 815ca455..662d2da0 100644
--- a/src/pre_process/m_patches.fpp
+++ b/src/pre_process/m_patches.fpp
@@ -137,7 +137,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id
end if
end do
@@ -201,7 +201,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
end do
@@ -662,7 +662,7 @@ contains
! the current patch are assigned to this cell.
do j = 0, n
do i = 0, m
- myr = dsqrt((x_cc(i) - x_centroid)**2 &
+ myr = sqrt((x_cc(i) - x_centroid)**2 &
+ (y_cc(j) - y_centroid)**2)
if (myr <= radius + thickness/2._wp .and. &
@@ -675,10 +675,10 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* &
- dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
+ exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
end if
end do
@@ -725,7 +725,7 @@ contains
do k = 0, p
do j = 0, n
do i = 0, m
- myr = dsqrt((x_cc(i) - x_centroid)**2 &
+ myr = sqrt((x_cc(i) - x_centroid)**2 &
+ (y_cc(j) - y_centroid)**2)
if (myr <= radius + thickness/2._wp .and. &
@@ -738,10 +738,10 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* &
- dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
+ exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
end if
end do
@@ -809,7 +809,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
end do
@@ -889,7 +889,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
end do
@@ -977,7 +977,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end if
@@ -1001,7 +1001,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
@@ -1053,7 +1053,7 @@ contains
do i = 0, m
if (patch_icpp(patch_id)%smoothen) then
- eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy) &
+ eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy) &
*(a*x_cc(i) + b*y_cc(j) + c) &
/sqrt(a**2 + b**2))
end if
@@ -1070,7 +1070,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
@@ -1140,7 +1140,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
! Assign Parameters =========================================================
q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0)
@@ -1209,7 +1209,7 @@ contains
@:Hardcoded1D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id
end if
end do
@@ -1332,7 +1332,7 @@ contains
@:Hardcoded2D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
@@ -1414,7 +1414,7 @@ contains
@:Hardcoded3D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
@@ -1480,29 +1480,29 @@ contains
if (epsilon == 1._wp) then
if (beta == 0._wp) then
- H = 5d-1*sqrt(3._wp/pi)*cos(sph_phi)
+ H = 5e-1*sqrt(3._wp/pi)*cos(sph_phi)
elseif (beta == 1._wp) then
- H = -5d-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)
+ H = -5e-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)
end if
elseif (epsilon == 2._wp) then
if (beta == 0._wp) then
- H = 25d-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp)
+ H = 25e-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp)
elseif (beta == 1._wp) then
- H = -5d-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi)
+ H = -5e-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi)
elseif (beta == 2._wp) then
- H = 25d-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2
+ H = 25e-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2
end if
elseif (epsilon == 3._wp) then
if (beta == 0._wp) then
- H = 25d-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi))
+ H = 25e-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi))
elseif (beta == 1._wp) then
- H = -125d-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* &
+ H = -125e-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* &
(5._wp*cos(sph_phi)**2 - 1._wp)
elseif (beta == 2._wp) then
- H = 25d-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
+ H = 25e-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
sin(sph_phi)**2*cos(sph_phi)
elseif (beta == 3._wp) then
- H = -125d-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp
+ H = -125e-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp
end if
elseif (epsilon == 4._wp) then
if (beta == 0._wp) then
@@ -1529,7 +1529,7 @@ contains
H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* &
sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp)
elseif (beta == 2._wp) then
- H = 125d-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
+ H = 125e-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
sin(sph_phi)**2*(3._wp*cos(sph_phi)**3._wp - cos(sph_phi))
elseif (beta == 3._wp) then
H = -1._wp/32._wp*sqrt(385._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* &
@@ -1728,7 +1728,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
@@ -1862,7 +1862,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end if
@@ -1948,7 +1948,7 @@ contains
end if
if (patch_icpp(patch_id)%smoothen) then
- eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy, dz) &
+ eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy, dz) &
*(a*x_cc(i) + &
b*cart_y + &
c*cart_z + d) &
@@ -1968,7 +1968,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp
index 0ef4e2a0..bcfe1f62 100644
--- a/src/pre_process/m_perturbation.fpp
+++ b/src/pre_process/m_perturbation.fpp
@@ -67,7 +67,7 @@ contains
perturb_alpha = q_prim_vf(E_idx + perturb_sph_fluid)%sf(i, j, k)
! Perturb partial density fields to match perturbed volume fraction fields
- ! IF ((perturb_alpha >= 25d-2) .AND. (perturb_alpha <= 75d-2)) THEN
+ ! IF ((perturb_alpha >= 25e-2) .AND. (perturb_alpha <= 75e-2)) THEN
if ((perturb_alpha /= 0._wp) .and. (perturb_alpha /= 1._wp)) then
! Derive new partial densities
@@ -518,9 +518,9 @@ contains
! Normalize the eigenvector by its component with the largest modulus.
norm = 0._wp
do i = 0, mixlayer_nvar*n - n_bc_skip - 1
- if (dsqrt(vr(i)**2 + vi(i)**2) > norm) then
+ if (sqrt(vr(i)**2 + vi(i)**2) > norm) then
idx = i
- norm = dsqrt(vr(i)**2 + vi(i)**2)
+ norm = sqrt(vr(i)**2 + vi(i)**2)
end if
end do
@@ -583,8 +583,8 @@ contains
xci = 0._wp
do i = 1, mixlayer_nvar
do k = 0, n
- xcr((i - 1)*(nbp - 1) + k) = 5d-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1))
- xci((i - 1)*(nbp - 1) + k) = 5d-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1))
+ xcr((i - 1)*(nbp - 1) + k) = 5e-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1))
+ xci((i - 1)*(nbp - 1) + k) = 5e-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1))
end do
end do
diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp
index cbceb1f2..6eac3f1a 100644
--- a/src/simulation/include/inline_riemann.fpp
+++ b/src/simulation/include/inline_riemann.fpp
@@ -1,13 +1,13 @@
#:def arithmetic_avg()
- rho_avg = 5d-1*(rho_L + rho_R)
+ rho_avg = 5e-1*(rho_L + rho_R)
vel_avg_rms = 0._wp
!$acc loop seq
do i = 1, num_dims
- vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp
+ vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp
end do
- H_avg = 5d-1*(H_L + H_R)
- gamma_avg = 5d-1*(gamma_L + gamma_R)
+ H_avg = 5e-1*(H_L + H_R)
+ gamma_avg = 5e-1*(gamma_L + gamma_R)
#:enddef arithmetic_avg
@@ -46,7 +46,7 @@
#:def compute_low_Mach_correction()
- zcoef = min(1._wp, max(vel_L_rms**5d-1/c_L, vel_R_rms**5d-1/c_R))
+ zcoef = min(1._wp, max(vel_L_rms**5e-1/c_L, vel_R_rms**5e-1/c_R))
pcorr = 0._wp
if (low_Mach == 1) then
@@ -55,8 +55,8 @@
(rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* &
(zcoef - 1._wp)
else if (low_Mach == 2) then
- vel_L_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1))))
- vel_R_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1))))
+ vel_L_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1))))
+ vel_R_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1))))
vel_L(dir_idx(1)) = vel_L_tmp
vel_R(dir_idx(1)) = vel_R_tmp
end if
diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp
index dfe2f8a1..7f947b60 100644
--- a/src/simulation/m_acoustic_src.fpp
+++ b/src/simulation/m_acoustic_src.fpp
@@ -250,7 +250,7 @@ contains
end if
small_gamma = 1._wp/small_gamma + 1._wp
- c = dsqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho)
+ c = sqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho)
! Wavelength to frequency conversion
if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c)
@@ -368,12 +368,12 @@ contains
end if
elseif (pulse(ai) == 2) then ! Gaussian pulse
- source = mag(ai)*dexp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
+ source = mag(ai)*exp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
if (term_index == mass_label) then
source = source/c - &
- foc_length_factor*mag(ai)*dsqrt(pi/2)*gauss_sigma_time_local* &
- (erf((sim_time - delay(ai))/(dsqrt(2._wp)*gauss_sigma_time_local)) + 1)
+ foc_length_factor*mag(ai)*sqrt(pi/2)*gauss_sigma_time_local* &
+ (erf((sim_time - delay(ai))/(sqrt(2._wp)*gauss_sigma_time_local)) + 1)
end if
elseif (pulse(ai) == 3) then ! Square wave
@@ -384,7 +384,7 @@ contains
source = mag(ai)*sign(1._wp, sine_wave)
! Prevent max-norm differences due to compilers to pass CI
- if (abs(sine_wave) < 1d-2) then
+ if (abs(sine_wave) < 1e-2) then
source = mag(ai)*sine_wave*1d2
end if
@@ -397,7 +397,7 @@ contains
integer :: count
integer :: dim
real(wp) :: source_spatial, angle, xyz_to_r_ratios(3)
- real(wp), parameter :: threshold = 1d-10
+ real(wp), parameter :: threshold = 1e-10
if (n == 0) then
dim = 1
@@ -537,14 +537,14 @@ contains
source = 0._wp
if (support(ai) == 1) then ! 1D
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
elseif (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D
! If we let unit vector e = (cos(dir), sin(dir)),
dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e)
if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then ! |r - dist*e| < length/2
if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
end if
end if
end if
@@ -573,20 +573,20 @@ contains
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
angle = -atan(r(2)/(foc_length(ai) - r(1)))
end if
elseif (support(ai) == 7) then ! 3D
- current_angle = -atan(dsqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
+ current_angle = -atan(sqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
- norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ norm = sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm
xyz_to_r_ratios(2) = -r(2)/norm
xyz_to_r_ratios(3) = -r(3)/norm
@@ -629,14 +629,14 @@ contains
current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai)
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
do elem = elem_min, elem_max
angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp)
angle_min = angle_max - angle_per_elem
if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then
- source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp)
+ source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
angle = current_angle
exit ! Assume elements don't overlap
end if
@@ -652,7 +652,7 @@ contains
angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai)
! Point 2 is the elem center
- x2 = f - dsqrt(f**2 - half_apert**2)
+ x2 = f - sqrt(f**2 - half_apert**2)
y2 = half_apert*cos(angle_elem)
z2 = half_apert*sin(angle_elem)
@@ -663,12 +663,12 @@ contains
y3 = C*r(2)
z3 = C*r(3)
- dist_interp_to_elem_center = dsqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
+ dist_interp_to_elem_center = sqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
if ((dist_interp_to_elem_center < aperture_element_3D/2._wp) .and. (r(1) < f)) then
- dist = dsqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
- source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp)
+ dist = sqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
+ source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
- norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
+ norm = sqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
xyz_to_r_ratios(1) = -(r(1) - f)/norm
xyz_to_r_ratios(2) = -r(2)/norm
xyz_to_r_ratios(3) = -r(3)/norm
diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp
index 3e240064..c511d12b 100644
--- a/src/simulation/m_bubbles.fpp
+++ b/src/simulation/m_bubbles.fpp
@@ -139,7 +139,7 @@ contains
do j = 0, m
divu%sf(j, k, l) = 0._wp
divu%sf(j, k, l) = &
- 5d-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - &
+ 5e-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - &
q_prim_vf(contxe + idir)%sf(j - 1, k, l))
end do
@@ -154,7 +154,7 @@ contains
do k = 0, n
do j = 0, m
divu%sf(j, k, l) = divu%sf(j, k, l) + &
- 5d-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - &
+ 5e-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - &
q_prim_vf(contxe + idir)%sf(j, k - 1, l))
end do
@@ -168,7 +168,7 @@ contains
do k = 0, n
do j = 0, m
divu%sf(j, k, l) = divu%sf(j, k, l) + &
- 5d-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - &
+ 5e-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - &
q_prim_vf(contxe + idir)%sf(j, k, l - 1))
end do
@@ -359,8 +359,8 @@ contains
! Rule 2: myR_tmp1(4) > 0._wp
! Rule 3: abs((myR_tmp1(4) - myR_tmp2(4))/myR) < tol
! Rule 4: abs((myV_tmp1(4) - myV_tmp2(4))/myV) < tol
- if ((err1 <= 1d-4) .and. (err2 <= 1d-4) .and. (err3 <= 1d-4) &
- .and. (err4 < 1d-4) .and. (err5 < 1d-4) &
+ if ((err1 <= 1e-4) .and. (err2 <= 1e-4) .and. (err3 <= 1e-4) &
+ .and. (err4 < 1e-4) .and. (err5 < 1e-4) &
.and. myR_tmp1(4) > 0._wp) then
! Accepted. Finalize the sub-step
@@ -371,12 +371,12 @@ contains
myV = myV_tmp1(4)
! Update step size for the next sub-step
- h = h*min(2._wp, max(0.5_wp, (1d-4/err1)**(1._wp/3._wp)))
+ h = h*min(2._wp, max(0.5_wp, (1e-4/err1)**(1._wp/3._wp)))
exit
else
! Rejected. Update step size for the next try on sub-step
- if (err2 <= 1d-4) then
+ if (err2 <= 1e-4) then
h = 0.5_wp*h
else
h = 0.25_wp*h
@@ -401,7 +401,7 @@ contains
bub_r_src(j, k, l, q) = q_cons_vf(vs(q))%sf(j, k, l)
end if
- if (alf < 1.d-11) then
+ if (alf < 1.e-11) then
bub_adv_src(j, k, l) = 0._wp
bub_r_src(j, k, l, q) = 0._wp
bub_v_src(j, k, l, q) = 0._wp
@@ -474,12 +474,12 @@ contains
f_bub_adv_src, f_divu)
! Compute d0 = ||y0|| and d1 = ||f(x0,y0)||
- d0 = DSQRT((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp)
- d1 = DSQRT((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp)
- if (d0 < 1d-5 .or. d1 < 1d-5) then
- h0 = 1d-6
+ d0 = sqrt((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp)
+ d1 = sqrt((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp)
+ if (d0 < 1e-5 .or. d1 < 1e-5) then
+ h0 = 1e-6
else
- h0 = 1d-2*(d0/d1)
+ h0 = 1e-2*(d0/d1)
end if
! Evaluate f(x0+h0,y0+h0*f(x0,y0))
@@ -490,14 +490,14 @@ contains
f_bub_adv_src, f_divu)
! Compute d2 = ||f(x0+h0,y0+h0*f(x0,y0))-f(x0,y0)||/h0
- d2 = DSQRT(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0
+ d2 = sqrt(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0
! Set h1 = (0.01/max(d1,d2))^{1/(p+1)}
! if max(d1,d2) < 1e-15, h1 = max(1e-6, h0*1e-3)
- if (max(d1, d2) < 1d-15) then
- h1 = max(1d-6, h0*1d-3)
+ if (max(d1, d2) < 1e-15) then
+ h1 = max(1e-6, h0*1e-3)
else
- h1 = (1d-2/max(d1, d2))**(1._wp/3._wp)
+ h1 = (1e-2/max(d1, d2))**(1._wp/3._wp)
end if
! Set h = min(100*h0,h1)
@@ -566,7 +566,7 @@ contains
/max(abs(myR_tmp(1)), abs(myR_tmp(4)))
err_V = (-5._wp*h/24._wp)*(myA_tmp(2) + myA_tmp(3) - 2._wp*myA_tmp(4)) &
/max(abs(myV_tmp(1)), abs(myV_tmp(4)))
- err = DSQRT((err_R**2._wp + err_V**2._wp)/2._wp)
+ err = sqrt((err_R**2._wp + err_V**2._wp)/2._wp)
end subroutine s_advance_substep
@@ -625,7 +625,7 @@ contains
tmp = (fCpinf/(1._wp + fBtait) + 1._wp)**((fntait - 1._wp)/fntait)
tmp = fntait*(1._wp + fBtait)*tmp
- f_cgas = dsqrt(tmp + (fntait - 1._wp)*fH)
+ f_cgas = sqrt(tmp + (fntait - 1._wp)*fH)
end function f_cgas
@@ -730,7 +730,7 @@ contains
! Keller-Miksis bubbles
fCpinf = fP
fCpbw = f_cpbw_KM(fR0, fR, fV, fpb)
- c_liquid = dsqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf)))
+ c_liquid = sqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf)))
f_rddot = f_rddot_KM(fpbdot, fCpinf, fCpbw, fRho, fR, fV, fR0, c_liquid)
else if (bubble_model == 3) then
! Rayleigh-Plesset bubbles
diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp
index 03c6a89d..fdf898ae 100644
--- a/src/simulation/m_cbc.fpp
+++ b/src/simulation/m_cbc.fpp
@@ -603,7 +603,7 @@ contains
!> The following is the implementation of the CBC based on
!! the work of Thompson (1987, 1990) on hyperbolic systems.
!! The CBC is indirectly applied in the computation of the
- !! right-hand-side (RHS) near the relevant domain boundary
+ !! right-hane-side (RHS) near the relevant domain boundary
!! through the modification of the fluxes.
!! @param q_prim_vf Cell-average primitive variables
!! @param flux_vf Cell-boundary-average fluxes
@@ -802,7 +802,7 @@ contains
mf(i) = alpha_rho(i)/rho
end do
- E = gamma*pres + pi_inf + 5d-1*rho*vel_K_sum
+ E = gamma*pres + pi_inf + 5e-1*rho*vel_K_sum
H = (E + pres)/rho
@@ -881,10 +881,10 @@ contains
! Be careful about the cylindrical coordinate!
if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then
- dpres_dt = -5d-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) &
+ dpres_dt = -5e-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) &
/y_cc(n)
else
- dpres_dt = -5d-1*(L(advxe) + L(1))
+ dpres_dt = -5e-1*(L(advxe) + L(1))
end if
!$acc loop seq
@@ -957,7 +957,7 @@ contains
+ dpi_inf_dt &
+ dqv_dt &
+ rho*vel_dv_dt_sum &
- + 5d-1*drho_dt*vel_K_sum)
+ + 5e-1*drho_dt*vel_K_sum)
if (riemann_solver == 1) then
!$acc loop seq
diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp
index e061e4e0..fab73bc2 100644
--- a/src/simulation/m_compute_cbc.fpp
+++ b/src/simulation/m_compute_cbc.fpp
@@ -73,25 +73,25 @@ contains
integer :: i !< Generic loop iterator
- L(1) = (5d-1 - 5d-1*sign(1._wp, lambda(1)))*lambda(1) &
+ L(1) = (5e-1 - 5e-1*sign(1._wp, lambda(1)))*lambda(1) &
*(dpres_ds - rho*c*dvel_ds(dir_idx(1)))
do i = 2, momxb
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) &
*(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds)
end do
do i = momxb + 1, momxe
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) &
*(dvel_ds(dir_idx(i - contxe)))
end do
do i = E_idx, advxe - 1
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) &
*(dadv_ds(i - momxe))
end do
- L(advxe) = (5d-1 - 5d-1*sign(1._wp, lambda(3)))*lambda(3) &
+ L(advxe) = (5e-1 - 5e-1*sign(1._wp, lambda(3)))*lambda(3) &
*(dpres_ds + rho*c*dvel_ds(dir_idx(1)))
end subroutine s_compute_nonreflecting_subsonic_buffer_L
diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp
index 38208e3d..1aa75048 100644
--- a/src/simulation/m_compute_levelset.fpp
+++ b/src/simulation/m_compute_levelset.fpp
@@ -61,7 +61,7 @@ contains
dist_vec(1) = x_cc(i) - x_centroid
dist_vec(2) = y_cc(j) - y_centroid
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
levelset(i, j, 0, ib_patch_id) = dist - radius
if (dist == 0) then
levelset_norm(i, j, 0, ib_patch_id, :) = 0
@@ -108,7 +108,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist
global_id = k
@@ -128,7 +128,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist
global_id = k
@@ -197,7 +197,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y
dist_vec(3) = 0
- dist_surf = dsqrt(sum(dist_vec**2))
+ dist_surf = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist_surf
global_id = k
@@ -217,7 +217,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y
dist_vec(3) = 0
- dist_surf = dsqrt(sum(dist_vec**2))
+ dist_surf = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist_surf
global_id = k
@@ -368,7 +368,7 @@ contains
dist_vec(1) = x_cc(i) - x_centroid
dist_vec(2) = y_cc(j) - y_centroid
dist_vec(3) = z_cc(k) - z_centroid
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
levelset(i, j, k, ib_patch_id) = dist - radius
if (dist == 0) then
levelset_norm(i, j, k, ib_patch_id, :) = (/1, 0, 0/)
diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp
index f5231c85..6cd7bf07 100644
--- a/src/simulation/m_data_output.fpp
+++ b/src/simulation/m_data_output.fpp
@@ -985,7 +985,7 @@ contains
if (t_step_old /= dflt_int) then
nondim_time = real(t_step + t_step_old, wp)*dt
else
- nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451_wp
+ nondim_time = real(t_step, wp)*dt !*1.e-5/10.0761131451_wp
end if
end if
@@ -1088,7 +1088,7 @@ contains
nR3 = nR3 + weight(s)*(nR(s)**3._wp)
end do
- nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf)
+ nbub = sqrt((4._wp*pi/3._wp)*nR3/alf)
end if
#ifdef DEBUG
print *, 'In probe, nbub: ', nbub
@@ -1195,7 +1195,7 @@ contains
nR3 = nR3 + weight(s)*(nR(s)**3._wp)
end do
- nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf)
+ nbub = sqrt((4._wp*pi/3._wp)*nR3/alf)
end if
R(:) = nR(:)/nbub
@@ -1464,7 +1464,7 @@ contains
int_pres = int_pres + (pres - 1._wp)**2._wp
end if
end do
- int_pres = dsqrt(int_pres/(1._wp*npts))
+ int_pres = sqrt(int_pres/(1._wp*npts))
if (num_procs > 1) then
tmp = int_pres
@@ -1496,16 +1496,16 @@ contains
trigger = .false.
if (i == 1) then
!inner portion
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) &
trigger = .true.
elseif (i == 2) then
!net region
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. &
- dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. &
+ sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) &
trigger = .true.
elseif (i == 3) then
!everything else
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) &
trigger = .true.
end if
diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp
index 1e688088..39f56729 100644
--- a/src/simulation/m_ibm.fpp
+++ b/src/simulation/m_ibm.fpp
@@ -680,13 +680,13 @@ contains
interp_coeffs = 0._wp
- if (dist(1, 1, 1) <= 1d-16) then
+ if (dist(1, 1, 1) <= 1e-16) then
interp_coeffs(1, 1, 1) = 1._wp
- else if (dist(2, 1, 1) <= 1d-16) then
+ else if (dist(2, 1, 1) <= 1e-16) then
interp_coeffs(2, 1, 1) = 1._wp
- else if (dist(1, 2, 1) <= 1d-16) then
+ else if (dist(1, 2, 1) <= 1e-16) then
interp_coeffs(1, 2, 1) = 1._wp
- else if (dist(2, 2, 1) <= 1d-16) then
+ else if (dist(2, 2, 1) <= 1e-16) then
interp_coeffs(2, 2, 1) = 1._wp
else
eta(:, :, 1) = 1._wp/dist(:, :, 1)**2
@@ -751,21 +751,21 @@ contains
(z_cc(k2) - gp%ip_loc(3))**2)
interp_coeffs = 0._wp
buf = 1._wp
- if (dist(1, 1, 1) <= 1d-16) then
+ if (dist(1, 1, 1) <= 1e-16) then
interp_coeffs(1, 1, 1) = 1._wp
- else if (dist(2, 1, 1) <= 1d-16) then
+ else if (dist(2, 1, 1) <= 1e-16) then
interp_coeffs(2, 1, 1) = 1._wp
- else if (dist(1, 2, 1) <= 1d-16) then
+ else if (dist(1, 2, 1) <= 1e-16) then
interp_coeffs(1, 2, 1) = 1._wp
- else if (dist(2, 2, 1) <= 1d-16) then
+ else if (dist(2, 2, 1) <= 1e-16) then
interp_coeffs(2, 2, 1) = 1._wp
- else if (dist(1, 1, 2) <= 1d-16) then
+ else if (dist(1, 1, 2) <= 1e-16) then
interp_coeffs(1, 1, 2) = 1._wp
- else if (dist(2, 1, 2) <= 1d-16) then
+ else if (dist(2, 1, 2) <= 1e-16) then
interp_coeffs(2, 1, 2) = 1._wp
- else if (dist(1, 2, 2) <= 1d-16) then
+ else if (dist(1, 2, 2) <= 1e-16) then
interp_coeffs(1, 2, 2) = 1._wp
- else if (dist(2, 2, 2) <= 1d-16) then
+ else if (dist(2, 2, 2) <= 1e-16) then
interp_coeffs(2, 2, 2) = 1._wp
else
eta = 1._wp/dist**2
diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp
index bfbc590d..b3b112f3 100644
--- a/src/simulation/m_qbmm.fpp
+++ b/src/simulation/m_qbmm.fpp
@@ -462,9 +462,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -475,15 +475,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -546,9 +546,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -559,15 +559,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -603,9 +603,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l))
@@ -616,15 +616,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
end do
@@ -654,9 +654,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -667,15 +667,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -869,7 +869,7 @@ contains
c = n_tait*(pres + B_tait)*(1._wp - alf)/(rho)
if (c > 0._wp) then
- c = DSQRT(c)
+ c = sqrt(c)
else
c = sgm_eps
end if
@@ -977,16 +977,16 @@ contains
drdt = msum(2)
if (moms(4) - moms(2)**2._wp > 0._wp) then
if (j == 1 .or. j == 2) then
- drdt2 = -1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp))
+ drdt2 = -1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp))
else
- drdt2 = 1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp))
+ drdt2 = 1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp))
end if
else
! Edge case where variance < 0
if (j == 1 .or. j == 2) then
- drdt2 = -1._wp/(2._wp*dsqrt(verysmall))
+ drdt2 = -1._wp/(2._wp*sqrt(verysmall))
else
- drdt2 = 1._wp/(2._wp*dsqrt(verysmall))
+ drdt2 = 1._wp/(2._wp*sqrt(verysmall))
end if
end if
@@ -1006,7 +1006,7 @@ contains
momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp)
momsp(2)%sf(id1, id2, id3) = 4._wp*pi*nbub*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp)
momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 2._wp, 0._wp)
- if (abs(gam - 1._wp) <= 1.d-4) then
+ if (abs(gam - 1._wp) <= 1.e-4) then
! Gam \approx 1, don't risk imaginary quadrature
momsp(4)%sf(id1, id2, id3) = 1._wp
else
@@ -1129,8 +1129,8 @@ contains
frho(1) = fmom(1)/2._wp;
frho(2) = fmom(1)/2._wp;
c2 = maxval((/c2, verysmall/))
- fup(1) = bu - DSQRT(c2)
- fup(2) = bu + DSQRT(c2)
+ fup(1) = bu - sqrt(c2)
+ fup(2) = bu + sqrt(c2)
end subroutine s_hyqmom
diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp
index d70df65b..982f1d3e 100644
--- a/src/simulation/m_rhs.fpp
+++ b/src/simulation/m_rhs.fpp
@@ -6,7 +6,7 @@
#:include 'macros.fpp'
!> @brief The module contains the subroutines used to calculate the right-
-!! hand-side (RHS) in the quasi-conservative, shock- and interface-
+!! hane-side (RHS) in the quasi-conservative, shock- and interface-
!! capturing finite-volume framework for the multicomponent Navier-
!! Stokes equations supplemented by appropriate advection equations
!! used to capture the material interfaces. The system of equations
@@ -1285,7 +1285,7 @@ contains
do j = 0, m
do i = 1, num_fluids
rhs_vf(i + intxb - 1)%sf(j, k, l) = &
- rhs_vf(i + intxb - 1)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i + intxb - 1)%sf(j, k, l) - 5e-1/y_cc(k)* &
q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* &
q_prim_vf%vf(E_idx)%sf(j, k, l)* &
(flux_src_n(2)%vf(advxb)%sf(j, k, l) + &
@@ -1304,7 +1304,7 @@ contains
do k = 0, n
do q = 0, m
rhs_vf(j)%sf(q, k, l) = &
- rhs_vf(j)%sf(q, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(j)%sf(q, k, l) - 5e-1/y_cc(k)* &
(flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l) &
+ flux_gsrc_n(2)%vf(j)%sf(q, k, l))
end do
@@ -1443,7 +1443,7 @@ contains
do q = 0, n
do l = 0, m
rhs_vf(j)%sf(l, q, k) = &
- rhs_vf(j)%sf(l, q, k) - 5d-1/y_cc(q)* &
+ rhs_vf(j)%sf(l, q, k) - 5e-1/y_cc(q)* &
(flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1) &
- flux_gsrc_n(3)%vf(j)%sf(l, q, k))
end do
@@ -1785,7 +1785,7 @@ contains
!$acc loop seq
do i = momxb, E_idx
rhs_vf(i)%sf(j, k, l) = &
- rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* &
(flux_src_n(i)%sf(j, k - 1, l) &
+ flux_src_n(i)%sf(j, k, l))
end do
@@ -1815,7 +1815,7 @@ contains
!$acc loop seq
do i = momxb, E_idx
rhs_vf(i)%sf(j, k, l) = &
- rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* &
(flux_src_n(i)%sf(j, k - 1, l) &
+ flux_src_n(i)%sf(j, k, l))
end do
@@ -1864,12 +1864,12 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(momxb + 1)%sf(j, k, l) = &
- rhs_vf(momxb + 1)%sf(j, k, l) + 5d-1* &
+ rhs_vf(momxb + 1)%sf(j, k, l) + 5e-1* &
(flux_src_n(momxe)%sf(j, k, l - 1) &
+ flux_src_n(momxe)%sf(j, k, l))
rhs_vf(momxe)%sf(j, k, l) = &
- rhs_vf(momxe)%sf(j, k, l) - 5d-1* &
+ rhs_vf(momxe)%sf(j, k, l) - 5e-1* &
(flux_src_n(momxb + 1)%sf(j, k, l - 1) &
+ flux_src_n(momxb + 1)%sf(j, k, l))
end do
@@ -1965,8 +1965,8 @@ contains
q_cons_vf(i + advxb - 1)%sf(j, k, l) &
- pi_infs(i))/gammas(i)
- if (pres_K_init(i) <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) &
- pres_K_init(i) = -(1._wp - 1d-8)*pres_inf(i) + 1d-8
+ if (pres_K_init(i) <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) &
+ pres_K_init(i) = -(1._wp - 1e-8)*pres_inf(i) + 1e-8
else
pres_K_init(i) = 0._wp
end if
@@ -1974,7 +1974,7 @@ contains
end do
! Iterative process for relaxed pressure determination
- f_pres = 1d-9
+ f_pres = 1e-9
df_pres = 1d9
!$acc loop seq
@@ -1985,13 +1985,13 @@ contains
!$acc loop seq
do iter = 0, 49
- if (DABS(f_pres) > 1d-10) then
+ if (abs(f_pres) > 1e-10) then
pres_relax = pres_relax - f_pres/df_pres
! Physical pressure
do i = 1, num_fluids
- if (pres_relax <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) &
- pres_relax = -(1._wp - 1d-8)*pres_inf(i) + 1._wp
+ if (pres_relax <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) &
+ pres_relax = -(1._wp - 1e-8)*pres_inf(i) + 1._wp
end do
! Newton-Raphson method
@@ -2114,7 +2114,7 @@ contains
!$acc loop seq
do i = momxb, momxe
- dyn_pres = dyn_pres + 5d-1*q_cons_vf(i)%sf(j, k, l)* &
+ dyn_pres = dyn_pres + 5e-1*q_cons_vf(i)%sf(j, k, l)* &
q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps)
end do
diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp
index 2d14710e..d3166e4b 100644
--- a/src/simulation/m_riemann_solvers.fpp
+++ b/src/simulation/m_riemann_solvers.fpp
@@ -469,8 +469,8 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -553,35 +553,35 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
s_M = min(0._wp, s_L); s_P = max(0._wp, s_R)
- xi_M = (5d-1 + sign(5d-1, s_L)) &
- + (5d-1 - sign(5d-1, s_L)) &
- *(5d-1 + sign(5d-1, s_R))
- xi_P = (5d-1 - sign(5d-1, s_R)) &
- + (5d-1 - sign(5d-1, s_L)) &
- *(5d-1 + sign(5d-1, s_R))
+ xi_M = (5e-1 + sign(5e-1, s_L)) &
+ + (5e-1 - sign(5e-1, s_L)) &
+ *(5e-1 + sign(5e-1, s_R))
+ xi_P = (5e-1 - sign(5e-1, s_R)) &
+ + (5e-1 - sign(5e-1, s_L)) &
+ *(5e-1 + sign(5e-1, s_R))
! Mass
!$acc loop seq
@@ -1037,9 +1037,9 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1076,23 +1076,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1336,9 +1336,9 @@ contains
qv_R = qv_R + alpha_rho_R(i)*qvs(i)
end do
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1368,23 +1368,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1400,8 +1400,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1 + sign(5e-1, s_S))
+ xi_P = (5e-1 - sign(5e-1, s_S))
!$acc loop seq
do i = 1, contxe
@@ -1645,9 +1645,9 @@ contains
end if
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1749,14 +1749,14 @@ contains
if ((ptilde_L /= ptilde_L) .or. (ptilde_R /= ptilde_R)) then
end if
- rho_avg = 5d-1*(rho_L + rho_R)
- H_avg = 5d-1*(H_L + H_R)
- gamma_avg = 5d-1*(gamma_L + gamma_R)
+ rho_avg = 5e-1*(rho_L + rho_R)
+ H_avg = 5e-1*(H_L + H_R)
+ gamma_avg = 5e-1*(gamma_L + gamma_R)
vel_avg_rms = 0._wp
!$acc loop seq
do i = 1, num_dims
- vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp
+ vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp
end do
end if
@@ -1795,23 +1795,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1827,8 +1827,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1 + sign(5e-1, s_S))
+ xi_P = (5e-1 - sign(5e-1, s_S))
if (low_Mach == 1) then
@:compute_low_Mach_correction()
@@ -2107,9 +2107,9 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -2151,23 +2151,23 @@ contains
rho_R*(s_R - vel_R(idx1)))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(idx1) - &
vel_R(idx1)))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(idx1) - c_L*Ms_L
s_R = vel_R(idx1) + c_R*Ms_R
- s_S = 5d-1*((vel_L(idx1) + vel_R(idx1)) + &
+ s_S = 5e-1*((vel_L(idx1) + vel_R(idx1)) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -2183,8 +2183,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1 + sign(5e-1, s_S))
+ xi_P = (5e-1 - sign(5e-1, s_S))
if (low_Mach == 1) then
@:compute_low_Mach_correction()
@@ -3083,7 +3083,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ &
@@ -3109,7 +3109,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dx(1)/ &
@@ -3137,17 +3137,17 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j + 1, k, l))
!$acc loop seq
do i = 1, 2
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvelR_dx_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + &
@@ -3179,10 +3179,10 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j + 1, k, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = (dvel_avg_dy(2) + &
@@ -3214,11 +3214,11 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvelR_dx_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ &
@@ -3252,7 +3252,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dz(3)/y_cc(k)/ &
@@ -3283,18 +3283,18 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k + 1, l))
!$acc loop seq
do i = 1, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k + 1, l))
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k + 1, l))
end do
@@ -3332,13 +3332,13 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k + 1, l))
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k + 1, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k + 1, l))
tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2) + &
@@ -3367,17 +3367,17 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(3) = 5d-1*(velL_vf(3)%sf(j, k, l) &
+ avg_vel(3) = 5e-1*(velL_vf(3)%sf(j, k, l) &
+ velR_vf(3)%sf(j, k + 1, l))
!$acc loop seq
do i = 2, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k + 1, l))
end do
- dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvelR_dy_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ &
@@ -3412,7 +3412,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = dvel_avg_dz(3)/y_cb(k)/ &
@@ -3444,27 +3444,27 @@ contains
!$acc loop seq
do i = 2, 3
- avg_vel(i) = 5d-1*(velL_vf(i)%sf(j, k, l) &
+ avg_vel(i) = 5e-1*(velL_vf(i)%sf(j, k, l) &
+ velR_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k, l + 1))
end do
do i = 2, 3
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k, l + 1))
end do
@@ -3507,16 +3507,16 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k, l + 1))
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k, l + 1))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k, l + 1))
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k, l + 1))
tau_Re(3, 3) = (dvel_avg_dx(1) &
@@ -3607,7 +3607,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ &
@@ -3633,7 +3633,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dx(1)/ &
@@ -3664,11 +3664,11 @@ contains
!$acc loop seq
do i = 1, 2
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvelR_dx_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ &
@@ -3702,7 +3702,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dy(2)/ &
@@ -3733,11 +3733,11 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvelR_dx_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ &
@@ -3770,7 +3770,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dz(3)/ &
@@ -3804,11 +3804,11 @@ contains
do i = 1, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k + 1, l))
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k + 1, l))
end do
@@ -3845,10 +3845,10 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k + 1, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k + 1, l))
tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2))/ &
@@ -3879,11 +3879,11 @@ contains
!$acc loop seq
do i = 2, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k + 1, l))
end do
- dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvelR_dy_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ &
@@ -3917,7 +3917,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = dvel_avg_dz(3)/ &
@@ -3950,21 +3950,21 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 2, 3
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k, l + 1))
end do
@@ -4004,13 +4004,13 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k, l + 1))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k, l + 1))
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k, l + 1))
tau_Re(3, 3) = (dvel_avg_dx(1) &
diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90
index 30f05fde..497e2812 100644
--- a/src/simulation/m_sim_helpers.f90
+++ b/src/simulation/m_sim_helpers.f90
@@ -62,7 +62,7 @@ contains
pres = q_prim_vf(E_idx)%sf(j, k, l)
- E = gamma*pres + pi_inf + 5d-1*rho*vel_sum + qv
+ E = gamma*pres + pi_inf + 5e-1*rho*vel_sum + qv
H = (E + pres)/rho
diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp
index a05c10e0..bde86270 100644
--- a/src/simulation/m_start_up.fpp
+++ b/src/simulation/m_start_up.fpp
@@ -36,7 +36,7 @@ module m_start_up
use m_acoustic_src !< Acoustic source calculations
- use m_rhs !< Right-hand-side (RHS) evaluation procedures
+ use m_rhs !< Right-hane-side (RHS) evaluation procedures
use m_chemistry !< Chemistry module
@@ -1062,7 +1062,7 @@ contains
dyn_pres = 0._wp
do i = mom_idx%beg, mom_idx%end
- dyn_pres = dyn_pres + 5d-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) &
+ dyn_pres = dyn_pres + 5e-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) &
/max(rho, sgm_eps)
end do
@@ -1108,7 +1108,7 @@ contains
if (t_step == 0) dt_init = dt
- if (dt < 1d-3*dt_init) call s_mpi_abort("Delta t has become too small")
+ if (dt < 1e-3*dt_init) call s_mpi_abort("Delta t has become too small")
end if
if (cfl_dt) then
diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp
index f5b65be4..2a4fb9e1 100644
--- a/src/simulation/m_time_steppers.fpp
+++ b/src/simulation/m_time_steppers.fpp
@@ -17,7 +17,7 @@ module m_time_steppers
use m_global_parameters !< Definitions of the global parameters
- use m_rhs !< Right-hand-side (RHS) evaluation procedures
+ use m_rhs !< Right-hane-side (RHS) evaluation procedures
use m_data_output !< Run-time info & solution data output procedures
diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp
index 6056ee15..389d024d 100644
--- a/src/simulation/m_viscous.fpp
+++ b/src/simulation/m_viscous.fpp
@@ -679,7 +679,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, j - 1, l) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, j - 1, l))
- dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqL_prim_dx_n(2)%vf(i)%sf(k, j, l)
end do
end do
@@ -698,7 +698,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, j, l) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, j, l))
- dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqR_prim_dx_n(2)%vf(i)%sf(k, j, l)
end do
@@ -718,7 +718,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(j - 1, k, l) + &
dqR_prim_dy_n(2)%vf(i)%sf(j - 1, k, l))
- dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqL_prim_dy_n(1)%vf(i)%sf(j, k, l)
end do
@@ -738,7 +738,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(j, k, l) + &
dqR_prim_dy_n(2)%vf(i)%sf(j, k, l))
- dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqR_prim_dy_n(1)%vf(i)%sf(j, k, l)
end do
@@ -793,7 +793,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(j - 1, k, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(j - 1, k, l))
- dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqL_prim_dz_n(1)%vf(i)%sf(j, k, l)
end do
@@ -814,7 +814,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(j, k, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(j, k, l))
- dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqR_prim_dz_n(1)%vf(i)%sf(j, k, l)
end do
@@ -835,7 +835,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(k, j - 1, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(k, j - 1, l))
- dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqL_prim_dz_n(2)%vf(i)%sf(k, j, l)
end do
@@ -856,7 +856,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(k, j, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(k, j, l))
- dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqR_prim_dz_n(2)%vf(i)%sf(k, j, l)
end do
@@ -877,7 +877,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(k, l, j - 1) + &
dqR_prim_dy_n(2)%vf(i)%sf(k, l, j - 1))
- dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqL_prim_dy_n(3)%vf(i)%sf(k, l, j)
end do
@@ -898,7 +898,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(k, l, j) + &
dqR_prim_dy_n(2)%vf(i)%sf(k, l, j))
- dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqR_prim_dy_n(3)%vf(i)%sf(k, l, j)
end do
@@ -918,7 +918,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, l, j - 1) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, l, j - 1))
- dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqL_prim_dx_n(3)%vf(i)%sf(k, l, j)
end do
@@ -937,7 +937,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, l, j) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, l, j))
- dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqR_prim_dx_n(3)%vf(i)%sf(k, l, j)
end do
diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp
index 02997fdd..cdc601cc 100644
--- a/src/simulation/m_weno.fpp
+++ b/src/simulation/m_weno.fpp
@@ -909,8 +909,8 @@ contains
!! stencil.
!! @param i Equation number
!! @param j First-coordinate cell index
- !! @param k Second-coordinate cell index
- !! @param l Third-coordinate cell index
+ !! @param k Secone-coordinate cell index
+ !! @param l Thire-coordinate cell index
subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
real(wp), dimension(startx:, starty:, startz:, 1:), intent(IN) :: v_rs_ws
@@ -981,11 +981,11 @@ contains
vL_MD = (v_rs_ws(j, k, l, i) &
+ v_rs_ws(j - 1, k, l, i) &
- - d_MD)*5d-1
+ - d_MD)*5e-1
vL_LC = v_rs_ws(j, k, l, i) &
- (v_rs_ws(j + 1, k, l, i) &
- - v_rs_ws(j, k, l, i))*5d-1 + beta_mp*d_LC
+ - v_rs_ws(j, k, l, i))*5e-1 + beta_mp*d_LC
vL_min = max(min(v_rs_ws(j, k, l, i), &
v_rs_ws(j - 1, k, l, i), &
@@ -1002,8 +1002,8 @@ contains
vL_LC))
vL_rs_vf(j, k, l, i) = vL_rs_vf(j, k, l, i) &
- + (sign(5d-1, vL_min - vL_rs_vf(j, k, l, i)) &
- + sign(5d-1, vL_max - vL_rs_vf(j, k, l, i))) &
+ + (sign(5e-1, vL_min - vL_rs_vf(j, k, l, i)) &
+ + sign(5e-1, vL_max - vL_rs_vf(j, k, l, i))) &
*min(abs(vL_min - vL_rs_vf(j, k, l, i)), &
abs(vL_max - vL_rs_vf(j, k, l, i)))
! END: Left Monotonicity Preserving Bound ==========================
@@ -1040,11 +1040,11 @@ contains
vR_MD = (v_rs_ws(j, k, l, i) &
+ v_rs_ws(j + 1, k, l, i) &
- - d_MD)*5d-1
+ - d_MD)*5e-1
vR_LC = v_rs_ws(j, k, l, i) &
+ (v_rs_ws(j, k, l, i) &
- - v_rs_ws(j - 1, k, l, i))*5d-1 + beta_mp*d_LC
+ - v_rs_ws(j - 1, k, l, i))*5e-1 + beta_mp*d_LC
vR_min = max(min(v_rs_ws(j, k, l, i), &
v_rs_ws(j + 1, k, l, i), &
@@ -1061,8 +1061,8 @@ contains
vR_LC))
vR_rs_vf(j, k, l, i) = vR_rs_vf(j, k, l, i) &
- + (sign(5d-1, vR_min - vR_rs_vf(j, k, l, i)) &
- + sign(5d-1, vR_max - vR_rs_vf(j, k, l, i))) &
+ + (sign(5e-1, vR_min - vR_rs_vf(j, k, l, i)) &
+ + sign(5e-1, vR_max - vR_rs_vf(j, k, l, i))) &
*min(abs(vR_min - vR_rs_vf(j, k, l, i)), &
abs(vR_max - vR_rs_vf(j, k, l, i)))
! END: Right Monotonicity Preserving Bound =========================
|
|
I looked over all the changes and everything looks good as long as a reasonable speedup is observed when single-precision is selected. A few additions are needed for the toolchain and documentation. Here a list of relevant files from #119 to check out.
|
|
@sbryngelson Wouldn't it be better to replace the 1d-6 with a parametrized type like Nevermind, this version is messy and causes a lot of warnings/errors. |
@aricer123 for these kinds of statements, I think that real(wp), parameter :: dflt_real = 1E-6should be fine (without using |
aricer123
force-pushed
the
add-modular-precision-update
branch
from
11f7f7f to
ad50852
Compare
|
@sbryngelson incorporating the patch file seems to be failing tests, i simply incorporated the changes along with the fixes to m_precision_select. |
Well, the tests have a tolerance, and if you use lower precision computation compared to how the goldenfiles (reference) were created, all the tests will fail. If it fails to build and fails tests in double precision, then I'm not sure what the problem is without looking further. |
|
It's actually somewhat suspicious (maybe?) (for the test suite, I suppose) that going down to single precision only barely causes tests to fail: Failed test tests/D79C3E6F: 1D -> bc=-1 after 1 attempt(s).
Test tests/D79C3E6F: 1D -> bc=-1: Variable n°1 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 0.45486176013947
- Golden: 0.45486203112937
- Error: abs: 2.71E-07, rel: 5.96E-07
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/70DAE9E8: 1D -> bc=-4 after 1 attempt(s).
Test tests/70DAE9E8: 1D -> bc=-4: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/AED93D34: 1D -> bc=-8 after 1 attempt(s).
Test tests/AED93D34: 1D -> bc=-8: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000157
- Error: abs: 1.57E-12, rel: 1.57E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/C5B79059: 1D -> bc=-9 after 1 attempt(s).
Test tests/C5B79059: 1D -> bc=-9: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000158
- Error: abs: 1.58E-12, rel: 1.58E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/48CCE072: 1D -> bc=-7 after 1 attempt(s).
Test tests/48CCE072: 1D -> bc=-7: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000157
- Error: abs: 1.57E-12, rel: 1.57E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/A60691E7: 1D -> bc=-11 after 1 attempt(s).
Test tests/A60691E7: 1D -> bc=-11: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000156
- Error: abs: 1.56E-12, rel: 1.56E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/727F72ED: 1D -> bc=-10 after 1 attempt(s).
Test tests/727F72ED: 1D -> bc=-10: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000156
- Error: abs: 1.56E-12, rel: 1.56E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/8A59E8E6: 1D -> bc=-2 after 1 attempt(s).
Test tests/8A59E8E6: 1D -> bc=-2: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/3AE495F4: 1D -> bc=-5 after 1 attempt(s).
Test tests/3AE495F4: 1D -> bc=-5: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000158
- Error: abs: 1.58E-12, rel: 1.58E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/5EC236F2: 1D -> bc=-6 after 1 attempt(s).
Test tests/5EC236F2: 1D -> bc=-6: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000157
- Error: abs: 1.57E-12, rel: 1.57E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/3FC6FC4A: 1D -> bc=-12 after 1 attempt(s).
Test tests/3FC6FC4A: 1D -> bc=-12: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000157
- Error: abs: 1.57E-12, rel: 1.57E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/2FD933A2: 1D -> bc=-15 after 1 attempt(s).
Test tests/2FD933A2: 1D -> bc=-15: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/2AB32975: 1D -> bc=-3 after 1 attempt(s).
Test tests/2AB32975: 1D -> bc=-3: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/ED728400: 1D -> bc=-16 after 1 attempt(s).
Test tests/ED728400: 1D -> bc=-16: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/2A5CFF02: 1D -> weno_order=3 after 1 attempt(s).
Failed test tests/B3E70A3A: 1D -> weno_order=5 -> mp_weno=T after 1 attempt(s).
Test tests/2A5CFF02: 1D -> weno_order=3: Variable n°2 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999999999747
- Error: abs: 2.53E-12, rel: 2.53E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/F9850EA5: 1D -> weno_order=3 -> wenoz=T after 1 attempt(s).
Test tests/B3E70A3A: 1D -> weno_order=5 -> mp_weno=T: Variable n°10 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999999925654
- Error: abs: 7.43E-10, rel: 7.43E-10
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/16A922E4: 1D -> weno_order=3 -> mapped_weno=T after 1 attempt(s).
Test tests/F9850EA5: 1D -> weno_order=3 -> wenoz=T: Variable n°2 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000146
- Error: abs: 1.46E-12, rel: 1.46E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Test tests/16A922E4: 1D -> weno_order=3 -> mapped_weno=T: Variable n°2 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999999999861
- Error: abs: 1.39E-12, rel: 1.39E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/7789B55A: 1D -> weno_order=5 after 1 attempt(s).
Test tests/7789B55A: 1D -> weno_order=5: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 1.00000000000159
- Error: abs: 1.59E-12, rel: 1.59E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12
Failed test tests/48D5C130: 1D -> weno_order=5 -> teno=T after 1 attempt(s).
Test tests/48D5C130: 1D -> weno_order=5 -> teno=T: Variable n°4 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999999999886
- Error: abs: 1.14E-12, rel: 1.14E-12
- Tolerance: abs: 1.00E-12, rel: 1.00E-12though some tests do fail in a more expected way Test tests/3053B44F: 1D -> Acoustic Source -> Gaussian -> Sigma Dist: Variable n°1 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999998780133
- Error: abs: 1.22E-08, rel: 1.22E-08
- Tolerance: abs: 3.00E-12, rel: 3.00E-12
Failed test tests/EE34D7DC: 1D -> Acoustic Source -> Gaussian -> Sigma Time after 1 attempt(s).
Test tests/E752CD0F: 1D -> Acoustic Source -> Sine -> Number of Pulses: Variable n°1 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999998780133
- Error: abs: 1.22E-08, rel: 1.22E-08
- Tolerance: abs: 3.00E-12, rel: 3.00E-12
Test tests/EE34D7DC: 1D -> Acoustic Source -> Gaussian -> Sigma Time: Variable n°1 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999998780133
- Error: abs: 1.22E-08, rel: 1.22E-08
- Tolerance: abs: 3.00E-12, rel: 3.00E-12
Failed test tests/3643454B: 1D -> Bubbles -> Polytropic -> bubble_model=3 after 1 attempt(s).
Test tests/3643454B: 1D -> Bubbles -> Polytropic -> bubble_model=3: Variable n°1 (1-indexed) in D/cons.1.00.000000.dat is not within tolerance:
- Candidate: 0.95999997854233
- Golden: 0.96
- Error: abs: 2.15E-08, rel: 2.24E-08
- Tolerance: abs: 1.00E-10, rel: 1.00E-10
Failed test tests/66693DCC: 1D -> Acoustic Source -> Gaussian -> Dipole after 1 attempt(s).
Test tests/66693DCC: 1D -> Acoustic Source -> Gaussian -> Dipole: Variable n°1 (1-indexed) in D/cons.1.00.000050.dat is not within tolerance:
- Candidate: 1.0
- Golden: 0.99999998780133
- Error: abs: 1.22E-08, rel: 1.22E-08
- Tolerance: abs: 3.00E-12, rel: 3.00E-12 |
|
Double precision does not build with my patch. The reason contradicts @henryleberre's assumption I think. Using The fix is to use By doing this I have all tests passing on my local machine in double precision. This is the patch now diff --git a/CMakeLists.txt b/CMakeLists.txt
index 8e5e8138..41bc2ec6 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -102,6 +102,7 @@ endif()
if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
add_compile_options(
$<$<COMPILE_LANGUAGE:Fortran>:-ffree-line-length-none>
+ # $<$<COMPILE_LANGUAGE:Fortran>:-freal-8-real-4>
)
if (MFC_GCov)
diff --git a/examples/3D_performance_test/case.py b/examples/3D_performance_test/case.py
index d1fc4c77..00a368cc 100644
--- a/examples/3D_performance_test/case.py
+++ b/examples/3D_performance_test/case.py
@@ -28,9 +28,9 @@ print(json.dumps({
'z_a' : -1.5E-03/1.E-03,
'z_b' : 1.5E-03/1.E-03,
'cyl_coord' : 'F',
- 'm' : 200,
- 'n' : 200,
- 'p' : 200,
+ 'm' : 100,
+ 'n' : 100,
+ 'p' : 100,
'dt' : 0.2E-09/1.E-03,
't_step_start' : 0,
't_step_stop' : 30,
diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp
index a8ef8697..fa6fba51 100644
--- a/src/common/m_constants.fpp
+++ b/src/common/m_constants.fpp
@@ -9,10 +9,10 @@ module m_constants
character, parameter :: dflt_char = ' ' !< Default string value
real(wp), parameter :: dflt_real = -1d6 !< Default real value
- real(wp), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance
- real(wp), parameter :: small_alf = 1d-11 !< Small alf tolerance
+ real(wp), parameter :: sgm_eps = 1e-16 !< Segmentation tolerance
+ real(wp), parameter :: small_alf = 1e-11 !< Small alf tolerance
real(wp), parameter :: pi = 3.141592653589793_wp !< Pi
- real(wp), parameter :: verysmall = 1.d-12 !< Very small number
+ real(wp), parameter :: verysmall = 1.e-12 !< Very small number
integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils
integer, parameter :: path_len = 400 !< Maximum path length
diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90
index 80198afb..c460ae30 100644
--- a/src/common/m_eigen_solver.f90
+++ b/src/common/m_eigen_solver.f90
@@ -163,8 +163,8 @@ contains
do 200 j = k, l
if (j == i) go to 200
- c = c + dabs(ar(j, i)) + dabs(ai(j, i))
- r = r + dabs(ar(i, j)) + dabs(ai(i, j))
+ c = c + abs(ar(j, i)) + abs(ai(j, i))
+ r = r + abs(ar(i, j)) + abs(ai(i, j))
200 end do
! .......... guard against zero c or r due to underflow ..........
if (c == 0.0_wp .or. r == 0.0_wp) go to 270
@@ -243,7 +243,7 @@ contains
scale = 0.0_wp
! .......... scale column (algol tol then not needed) ..........
do 90 i = ml, igh
- scale = scale + dabs(ar(i, ml - 1)) + dabs(ai(i, ml - 1))
+ scale = scale + abs(ar(i, ml - 1)) + abs(ai(i, ml - 1))
90 end do
if (scale == 0._wp) go to 180
mp = ml + igh
@@ -255,7 +255,7 @@ contains
h = h + ortr(i)*ortr(i) + orti(i)*orti(i)
100 end do
!
- g = dsqrt(h)
+ g = sqrt(h)
call pythag(ortr(ml), orti(ml), f)
if (f == 0._wp) go to 103
h = h + f*g
@@ -375,8 +375,8 @@ contains
! .......... for i=igh-1 step -1 until low+1 do -- ..........
105 do 140 ii = 1, iend
i = igh - ii
- if (dabs(ortr(i)) == 0._wp .and. dabs(orti(i)) == 0._wp) go to 140
- if (dabs(hr(i, i - 1)) == 0._wp .and. dabs(hi(i, i - 1)) == 0._wp) go to 140
+ if (abs(ortr(i)) == 0._wp .and. abs(orti(i)) == 0._wp) go to 140
+ if (abs(hr(i, i - 1)) == 0._wp .and. abs(hi(i, i - 1)) == 0._wp) go to 140
! .......... norm below is negative of h formed in corth ..........
norm = hr(i, i - 1)*ortr(i) + hi(i, i - 1)*orti(i)
ip1 = i + 1
@@ -411,7 +411,7 @@ contains
!
do 170 i = l, igh
ll = min0(i + 1, igh)
- if (dabs(hi(i, i - 1)) == 0._wp) go to 170
+ if (abs(hi(i, i - 1)) == 0._wp) go to 170
call pythag(hr(i, i - 1), hi(i, i - 1), norm)
yr = hr(i, i - 1)/norm
yi = hi(i, i - 1)/norm
@@ -456,9 +456,9 @@ contains
240 do 260 ll = low, en
l = en + low - ll
if (l == low) go to 300
- tst1 = dabs(hr(l - 1, l - 1)) + dabs(hi(l - 1, l - 1)) &
- + dabs(hr(l, l)) + dabs(hi(l, l))
- tst2 = tst1 + dabs(hr(l, l - 1))
+ tst1 = abs(hr(l - 1, l - 1)) + abs(hi(l - 1, l - 1)) &
+ + abs(hr(l, l)) + abs(hi(l, l))
+ tst2 = tst1 + abs(hr(l, l - 1))
if (tst2 == tst1) go to 300
260 end do
! .......... form shift ..........
@@ -481,7 +481,7 @@ contains
si = si - xxi
go to 340
! .......... form exceptional shift ..........
-320 sr = dabs(hr(en, enm1)) + dabs(hr(enm1, en - 2))
+320 sr = abs(hr(en, enm1)) + abs(hr(enm1, en - 2))
si = 0.0_wp
!
340 do 360 i = low, en
@@ -523,7 +523,7 @@ contains
500 end do
!
si = hi(en, en)
- if (dabs(si) == 0._wp) go to 540
+ if (abs(si) == 0._wp) go to 540
call pythag(hr(en, en), si, norm)
sr = hr(en, en)/norm
si = si/norm
@@ -568,7 +568,7 @@ contains
590 end do
600 end do
!
- if (dabs(si) == 0._wp) go to 240
+ if (abs(si) == 0._wp) go to 240
!
do 630 i = 1, en
yr = hr(i, en)
@@ -598,7 +598,7 @@ contains
!
do i = 1, nl
do j = i, nl
- tr = dabs(hr(i, j)) + dabs(hi(i, j))
+ tr = abs(hr(i, j)) + abs(hi(i, j))
if (tr > norm) norm = tr
end do
end do
@@ -635,7 +635,7 @@ contains
765 continue
call cdiv(zzr, zzi, yr, yi, hr(i, en), hi(i, en))
! .......... overflow control ..........
- tr = dabs(hr(i, en)) + dabs(hi(i, en))
+ tr = abs(hr(i, en)) + abs(hi(i, en))
if (tr == 0.0_wp) go to 780
tst1 = tr
tst2 = tst1 + 1.0_wp/tst1
@@ -709,12 +709,12 @@ contains
!! transformed in their first ml columns
subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi)
integer, intent(in) :: nm, nl, low, igh
- double precision, intent(in) :: scale(nl)
+ real(wp), intent(in) :: scale(nl)
integer, intent(in) :: ml
- double precision, intent(inout) :: zr(nm, ml), zi(nm, ml)
+ real(wp), intent(inout) :: zr(nm, ml), zi(nm, ml)
integer :: i, j, k, ii
- double precision :: s
+ real(wp) :: s
if (ml == 0) go to 200
if (igh == low) go to 120
@@ -757,14 +757,14 @@ contains
real(wp), intent(in) :: xr, xi
real(wp), intent(out) :: yr, yi
!
-! (yr,yi) = complex dsqrt(xr,xi)
+! (yr,yi) = complex sqrt(xr,xi)
! branch chosen so that yr .ge. 0.0 and sign(yi) .eq. sign(xi)
!
real(wp) :: s, tr, ti, c
tr = xr
ti = xi
call pythag(tr, ti, c)
- s = dsqrt(0.5_wp*(c + dabs(tr)))
+ s = sqrt(0.5_wp*(c + abs(tr)))
if (tr >= 0.0_wp) yr = s
if (ti < 0.0_wp) s = -s
if (tr <= 0.0_wp) yi = s
@@ -786,7 +786,7 @@ contains
! cr = (ar*br + ai*bi) / (br**2._wp + bi**2._wp)
! ci = (ai*br - ar*bi) / (br**2._wp + bi**2._wp)
- s = dabs(br) + dabs(bi)
+ s = abs(br) + abs(bi)
ars = ar/s
ais = ai/s
brs = br/s
@@ -801,12 +801,12 @@ contains
real(wp), intent(in) :: a, b
real(wp), intent(out) :: c
!
-! finds dsqrt(a**2+b**2) without overflow or destructive underflow
+! finds sqrt(a**2+b**2) without overflow or destructive underflow
!
real(wp) :: p, r, s, t, u
- p = dmax1(dabs(a), dabs(b))
+ p = dmax1(abs(a), abs(b))
if (p == 0.0_wp) go to 20
- r = (dmin1(dabs(a), dabs(b))/p)**2
+ r = (dmin1(abs(a), abs(b))/p)**2
10 continue
t = 4.0_wp + r
if (t == 4.0_wp) go to 20
diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp
index a4062ab5..ab9bbcaa 100644
--- a/src/common/m_helper.fpp
+++ b/src/common/m_helper.fpp
@@ -68,7 +68,7 @@ contains
real(wp) :: nR3
nR3 = dot_product(weights, nRtmp**3._wp)
- ntmp = DSQRT((4._wp*pi/3._wp)*nR3/vftmp)
+ ntmp = sqrt((4._wp*pi/3._wp)*nR3/vftmp)
!ntmp = (3._wp/(4._wp*pi))*0.00001
!print *, "nbub", ntmp
@@ -153,8 +153,8 @@ contains
if (thermal == 2) gamma_m = 1._wp
temp = 293.15_wp
- D_m = 0.242d-4
- uu = DSQRT(pl0/rhol0)
+ D_m = 0.242e-4
+ uu = sqrt(pl0/rhol0)
omega_ref = 3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/Web
@@ -163,10 +163,10 @@ contains
R_n = Ru/M_n
R_v = Ru/M_v
! phi_vn & phi_nv (phi_nn = phi_vv = 1)
- phi_vn = (1._wp + DSQRT(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 &
- /(DSQRT(8._wp)*DSQRT(1._wp + M_v/M_n))
- phi_nv = (1._wp + DSQRT(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 &
- /(DSQRT(8._wp)*DSQRT(1._wp + M_n/M_v))
+ phi_vn = (1._wp + sqrt(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 &
+ /(sqrt(8._wp)*sqrt(1._wp + M_v/M_n))
+ phi_nv = (1._wp + sqrt(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 &
+ /(sqrt(8._wp)*sqrt(1._wp + M_n/M_v))
! internal bubble pressure
pb0 = pl0 + 2._wp*ss/(R0ref*R0)
@@ -208,7 +208,7 @@ contains
!end if
! natural frequencies
- omegaN = DSQRT(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0
+ omegaN = sqrt(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0
do ir = 1, Nb
call s_transcoeff(omegaN(ir)*R0(ir), Pe_T(ir)*R0(ir), &
Re_trans_T(ir), Im_trans_T(ir))
@@ -273,30 +273,30 @@ contains
!R0mx = 150.D0
sd = poly_sigma
- R0mn = 0.8_wp*DEXP(-2.8_wp*sd)
- R0mx = 0.2_wp*DEXP(9.5_wp*sd) + 1._wp
+ R0mn = 0.8_wp*exp(-2.8_wp*sd)
+ R0mx = 0.2_wp*exp(9.5_wp*sd) + 1._wp
! phi = ln( R0 ) & return R0
do ir = 1, nb
- phi(ir) = DLOG(R0mn) &
- + dble(ir - 1)*DLOG(R0mx/R0mn)/dble(nb - 1)
- R0(ir) = DEXP(phi(ir))
+ phi(ir) = log(R0mn) &
+ + dble(ir - 1)*log(R0mx/R0mn)/dble(nb - 1)
+ R0(ir) = exp(phi(ir))
end do
dphi = phi(2) - phi(1)
! weights for quadrature using Simpson's rule
do ir = 2, nb - 1
! Gaussian
- tmp = DEXP(-0.5_wp*(phi(ir)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(ir)/sd)**2)/sqrt(2._wp*pi)/sd
if (mod(ir, 2) == 0) then
weight(ir) = tmp*4._wp*dphi/3._wp
else
weight(ir) = tmp*2._wp*dphi/3._wp
end if
end do
- tmp = DEXP(-0.5_wp*(phi(1)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(1)/sd)**2)/sqrt(2._wp*pi)/sd
weight(1) = tmp*dphi/3._wp
- tmp = DEXP(-0.5_wp*(phi(nb)/sd)**2)/DSQRT(2._wp*pi)/sd
+ tmp = exp(-0.5_wp*(phi(nb)/sd)**2)/sqrt(2._wp*pi)/sd
weight(nb) = tmp*dphi/3._wp
end subroutine s_simpson
diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90
index b5483998..9d358e29 100644
--- a/src/common/m_helper_basic.f90
+++ b/src/common/m_helper_basic.f90
@@ -22,7 +22,7 @@ contains
!> This procedure checks if two floating point numbers of wp are within tolerance.
!! @param a First number.
!! @param b Second number.
- !! @param tol_input Relative error (default = 1d-6).
+ !! @param tol_input Relative error (default = 1e-6).
!! @return Result of the comparison.
logical function f_approx_equal(a, b, tol_input) result(res)
!$acc routine seq
@@ -35,7 +35,7 @@ contains
if (present(tol_input)) then
tol = tol_input
else
- tol = 1d-6
+ tol = 1e-6
end if
if (a == b) then
diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp
index 9264a14b..b6b47019 100644
--- a/src/common/m_phase_change.fpp
+++ b/src/common/m_phase_change.fpp
@@ -54,7 +54,7 @@ module m_phase_change
integer, parameter :: max_iter = 1e8 !< max # of iterations
real(wp), parameter :: pCr = 4.94d7 !< Critical water pressure
real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature
- real(wp), parameter :: mixM = 1.0d-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen
+ real(wp), parameter :: mixM = 1.0e-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen
integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid
integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid
!> @}
@@ -148,7 +148,7 @@ contains
!$acc loop seq
do i = momxb, momxe
- dynE = dynE + 5.0d-1*q_cons_vf(i)%sf(j, k, l)**2/rho
+ dynE = dynE + 5.0e-1*q_cons_vf(i)%sf(j, k, l)**2/rho
end do
@@ -246,7 +246,7 @@ contains
! Calculations AFTER equilibrium
! entropy
- sk(1:num_fluids) = cvs(1:num_fluids)*DLOG((TS**gs_min(1:num_fluids)) &
+ sk(1:num_fluids) = cvs(1:num_fluids)*log((TS**gs_min(1:num_fluids)) &
/((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids)
! enthalpy
@@ -357,7 +357,7 @@ contains
! Newton Solver for the pT-equilibrium
ns = 0
! change this relative error metric. 1E4 is just arbitrary
- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0))
+ do while ((abs(pS - pO) > palpha_eps) .and. (abs((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0))
! increasing counter
ns = ns + 1
@@ -381,7 +381,7 @@ contains
hp = 1.0_wp/(rhoe + pS - mQ) + 1.0_wp/(pS + minval(p_infpT))
! updating common pressure for the newton solver
- pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + DABS(1.0_wp - gp)) &
+ pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + abs(1.0_wp - gp)) &
/(2.0_wp*gpp)*hp)
end do
@@ -425,14 +425,14 @@ contains
ns = 0
! Relaxation factor
- Om = 1.0d-3
+ Om = 1.0e-3
p_infpTg = p_infpT
if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) &
+ q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe &
- gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. &
- ((pS >= 0.0_wp) .and. (pS < 1.0d-1))) then
+ ((pS >= 0.0_wp) .and. (pS < 1.0e-1))) then
! improve this initial condition
pS = 1.0d4
@@ -446,8 +446,8 @@ contains
! improve this initial condition
R2D(1) = 0.0_wp; R2D(2) = 0.0_wp
DeltamP(1) = 0.0_wp; DeltamP(2) = 0.0_wp
- do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) &
- .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) &
+ do while (((sqrt(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) &
+ .and. ((sqrt(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) &
.or. (ns == 0))
! Updating counter for the iterative procedure
@@ -605,10 +605,10 @@ contains
+ mCVGP)
dFdT = &
- -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TS) &
+ -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TS) &
- (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp))
+ + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp))
dTdm = -(cvs(lp)*(gs_min(lp) - 1)/(pS + ps_inf(lp)) &
- cvs(vp)*(gs_min(vp) - 1)/(pS + ps_inf(vp)))*TS**2
@@ -706,9 +706,9 @@ contains
! Gibbs Free Energy Equality condition (DG)
R2D(1) = TS*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) &
- *(1 - DLOG(TS)) - (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp))) &
+ *(1 - log(TS)) - (qvps(lp) - qvps(vp)) &
+ + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp))) &
+ qvs(lp) - qvs(vp)
! Constant Energy Process condition (DE)
@@ -754,24 +754,24 @@ contains
ns = 0
! underrelaxation factor
- Om = 1.0d-3
- do while ((DABS(FT) > ptgalpha_eps) .or. (ns == 0))
+ Om = 1.0e-3
+ do while ((abs(FT) > ptgalpha_eps) .or. (ns == 0))
! increasing counter
ns = ns + 1
! calculating residual
FT = TSat*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) &
- *(1 - DLOG(TSat)) - (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp))) &
+ *(1 - log(TSat)) - (qvps(lp) - qvps(vp)) &
+ + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp))) &
+ qvs(lp) - qvs(vp)
! calculating the jacobian
dFdT = &
- -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TSat) &
+ -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TSat) &
- (qvps(lp) - qvps(vp)) &
- + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) &
- - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp))
+ + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) &
+ - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp))
! updating saturation temperature
TSat = TSat - Om*FT/dFdT
diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90
index a95ffbb7..ff7256a4 100644
--- a/src/common/m_precision_select.f90
+++ b/src/common/m_precision_select.f90
@@ -14,7 +14,9 @@ module m_precision_select
integer, parameter :: double_precision = selected_real_kind(15, 307)
integer, parameter :: wp = double_precision
+ ! integer, parameter :: wp = single_precision
#ifdef MFC_MPI
+ ! integer, parameter :: mpi_p = MPI_FLOAT
integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION
#else
integer, parameter :: mpi_p = -100
diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp
index de7fdd5e..e4c002cc 100644
--- a/src/common/m_variables_conversion.fpp
+++ b/src/common/m_variables_conversion.fpp
@@ -189,7 +189,7 @@ contains
Y_rs(i) = rhoYks(i)/rho
end do
- if (sum(Y_rs) > 1d-16) then
+ if (sum(Y_rs) > 1e-16) then
call get_temperature(.true., energy - dyn_p, 1200._wp, Y_rs, T)
call get_pressure(rho, T, Y_rs, pres)
else
@@ -295,7 +295,7 @@ contains
alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp)
end do
- alpha_K = alpha_K/max(sum(alpha_K), 1d-16)
+ alpha_K = alpha_K/max(sum(alpha_K), 1e-16)
end if
@@ -420,7 +420,7 @@ contains
alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp)
end do
- alpha_K = alpha_K/max(sum(alpha_K), 1d-16)
+ alpha_K = alpha_K/max(sum(alpha_K), 1e-16)
end if
@@ -987,7 +987,7 @@ contains
if (model_eqns /= 4) then
qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) &
/rho_K
- dyn_pres_K = dyn_pres_K + 5d-1*qK_cons_vf(i)%sf(j, k, l) &
+ dyn_pres_K = dyn_pres_K + 5e-1_wp*qK_cons_vf(i)%sf(j, k, l) &
*qK_prim_vf(i)%sf(j, k, l)
else
qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) &
@@ -1349,7 +1349,7 @@ contains
! Computing the energy from the pressure
E_K = gamma_K*pres_K + pi_inf_K &
- + 5d-1*rho_K*vel_K_sum + qv_K
+ + 5e-1_wp*rho_K*vel_K_sum + qv_K
! mass flux, this should be \alpha_i \rho_i u_i
!$acc loop seq
@@ -1468,7 +1468,7 @@ contains
(rho*(1._wp - adv(num_fluids)))
end if
else
- c = ((H - 5d-1*vel_sum)/gamma)
+ c = ((H - 5e-1_wp*vel_sum)/gamma)
end if
if (mixture_err .and. c < 0._wp) then
diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp
index 536d4289..31e116b3 100644
--- a/src/post_process/m_derived_variables.fpp
+++ b/src/post_process/m_derived_variables.fpp
@@ -212,7 +212,7 @@ contains
end if
if (mixture_err .and. q_sf(i, j, k) < 0._wp) then
- q_sf(i, j, k) = 1d-16
+ q_sf(i, j, k) = 1e-16
else
q_sf(i, j, k) = sqrt(q_sf(i, j, k))
end if
@@ -285,8 +285,8 @@ contains
end if
end if
- if (abs(top) < 1d-8) top = 0._wp
- if (abs(bottom) < 1d-8) bottom = 0._wp
+ if (abs(top) < 1e-8) top = 0._wp
+ if (abs(bottom) < 1e-8) bottom = 0._wp
if (top == bottom) then
slope = 1._wp
@@ -295,20 +295,20 @@ contains
! (bottom == 0._wp .AND. top /= 0._wp)) THEN
! slope = 0._wp
else
- slope = (top*bottom)/(bottom**2._wp + 1d-16)
+ slope = (top*bottom)/(bottom**2._wp + 1e-16)
end if
! Flux limiter function
if (flux_lim == 1) then ! MINMOD (MM)
q_sf(j, k, l) = max(0._wp, min(1._wp, slope))
elseif (flux_lim == 2) then ! MUSCL (MC)
- q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5d-1*(1._wp + slope), 2._wp))
+ q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5e-1_wp*(1._wp + slope), 2._wp))
elseif (flux_lim == 3) then ! OSPRE (OP)
- q_sf(j, k, l) = (15d-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp)
+ q_sf(j, k, l) = (15e-1_wp*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp)
elseif (flux_lim == 4) then ! SUPERBEE (SB)
q_sf(j, k, l) = max(0._wp, min(1._wp, 2._wp*slope), min(slope, 2._wp))
elseif (flux_lim == 5) then ! SWEBY (SW) (beta = 1.5)
- q_sf(j, k, l) = max(0._wp, min(15d-1*slope, 1._wp), min(slope, 15d-1))
+ q_sf(j, k, l) = max(0._wp, min(15e-1_wp*slope, 1._wp), min(slope, 15e-1_wp))
elseif (flux_lim == 6) then ! VAN ALBADA (VA)
q_sf(j, k, l) = (slope**2._wp + slope)/(slope**2._wp + 1._wp)
elseif (flux_lim == 7) then ! VAN LEER (VL)
@@ -321,7 +321,7 @@ contains
!> Computes the solution to the linear system Ax=b w/ sol = x
!! @param A Input matrix
- !! @param b right-hand-side
+ !! @param b right-hane-side
!! @param sol Solution
!! @param ndim Problem size
subroutine s_solve_linear_system(A, b, sol, ndim)
diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp
index 23f11a46..68ea2731 100644
--- a/src/pre_process/include/2dHardcodedIC.fpp
+++ b/src/pre_process/include/2dHardcodedIC.fpp
@@ -80,7 +80,7 @@
intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
- alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
+ alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3))
if (alph < eps) alph = eps
if (alph > 1 - eps) alph = 1 - eps
diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp
index 4448297e..f04f5bfc 100644
--- a/src/pre_process/include/3dHardcodedIC.fpp
+++ b/src/pre_process/include/3dHardcodedIC.fpp
@@ -23,7 +23,7 @@
intH = amp*(sin(2*pi*x_cc(i)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h
- alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3))
+ alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3))
if (alph < eps) alph = eps
if (alph > 1 - eps) alph = 1 - eps
diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp
index c43cfd89..4d4c93ab 100644
--- a/src/pre_process/m_assign_variables.fpp
+++ b/src/pre_process/m_assign_variables.fpp
@@ -197,7 +197,7 @@ contains
#:endif
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id
end subroutine s_assign_patch_mixture_primitive_variables
@@ -216,7 +216,7 @@ contains
real(wp) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno
p0 = 101325
- pres_mag = 1d-1
+ pres_mag = 1e-1
loc = x_cc(177)
n_tait = fluid_pp(1)%gamma
B_tait = fluid_pp(1)%pi_inf
@@ -264,7 +264,7 @@ contains
velH = 0._wp
else
velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno
- velH = dsqrt(velH)
+ velH = sqrt(velH)
velH = velH*deno
end if
@@ -439,10 +439,10 @@ contains
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
else if (dist_type == 2) then
q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
- q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR
+ q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR
q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV
- q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2)
- q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV
+ q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2)
+ q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
end if
else
@@ -604,10 +604,10 @@ contains
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
else if (dist_type == 2) then
q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp
- q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR
+ q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR
q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV
- q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2)
- q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV
+ q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2)
+ q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV
q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2
end if
else
@@ -669,7 +669,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id
end subroutine s_assign_patch_species_primitive_variables
diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90
index 9f8e0291..48491eaf 100644
--- a/src/pre_process/m_grid.f90
+++ b/src/pre_process/m_grid.f90
@@ -64,7 +64,7 @@ contains
dx = (x_domain%end - x_domain%beg)/real(m + 1, wp)
do i = 0, m
- x_cc(i) = x_domain%beg + 5d-1*dx*real(2*i + 1, wp)
+ x_cc(i) = x_domain%beg + 5e-1_wp*dx*real(2*i + 1, wp)
x_cb(i - 1) = x_domain%beg + dx*real(i, wp)
end do
@@ -104,7 +104,7 @@ contains
dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp)
- y_cc(0) = y_domain%beg + 5d-1*dy
+ y_cc(0) = y_domain%beg + 5e-1_wp*dy
y_cb(-1) = y_domain%beg
do i = 1, n
@@ -117,7 +117,7 @@ contains
dy = (y_domain%end - y_domain%beg)/real(n + 1, wp)
do i = 0, n
- y_cc(i) = y_domain%beg + 5d-1*dy*real(2*i + 1, wp)
+ y_cc(i) = y_domain%beg + 5e-1_wp*dy*real(2*i + 1, wp)
y_cb(i - 1) = y_domain%beg + dy*real(i, wp)
end do
@@ -157,7 +157,7 @@ contains
dz = (z_domain%end - z_domain%beg)/real(p + 1, wp)
do i = 0, p
- z_cc(i) = z_domain%beg + 5d-1*dz*real(2*i + 1, wp)
+ z_cc(i) = z_domain%beg + 5e-1_wp*dz*real(2*i + 1, wp)
z_cb(i - 1) = z_domain%beg + dz*real(i, wp)
end do
diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp
index f4a7fa5d..6c11cc21 100644
--- a/src/pre_process/m_model.fpp
+++ b/src/pre_process/m_model.fpp
@@ -489,7 +489,7 @@ contains
end function f_model_is_inside
- ! From https://www.scratchapixel.com/lessons/3d-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html
+ ! From https://www.scratchapixel.com/lessons/3e-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html
!> This procedure checks if a ray intersects a triangle.
!! @param ray Ray.
!! @param triangle Triangle.
diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp
index 815ca455..64db11af 100644
--- a/src/pre_process/m_patches.fpp
+++ b/src/pre_process/m_patches.fpp
@@ -137,7 +137,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id
end if
end do
@@ -201,7 +201,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
end do
@@ -662,7 +662,7 @@ contains
! the current patch are assigned to this cell.
do j = 0, n
do i = 0, m
- myr = dsqrt((x_cc(i) - x_centroid)**2 &
+ myr = sqrt((x_cc(i) - x_centroid)**2 &
+ (y_cc(j) - y_centroid)**2)
if (myr <= radius + thickness/2._wp .and. &
@@ -675,10 +675,10 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* &
- dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
+ exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
end if
end do
@@ -725,7 +725,7 @@ contains
do k = 0, p
do j = 0, n
do i = 0, m
- myr = dsqrt((x_cc(i) - x_centroid)**2 &
+ myr = sqrt((x_cc(i) - x_centroid)**2 &
+ (y_cc(j) - y_centroid)**2)
if (myr <= radius + thickness/2._wp .and. &
@@ -738,10 +738,10 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* &
- dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
+ exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
end if
end do
@@ -809,7 +809,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
end do
@@ -889,7 +889,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
end do
@@ -977,7 +977,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end if
@@ -1001,7 +1001,7 @@ contains
end if
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
@@ -1053,7 +1053,7 @@ contains
do i = 0, m
if (patch_icpp(patch_id)%smoothen) then
- eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy) &
+ eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy) &
*(a*x_cc(i) + b*y_cc(j) + c) &
/sqrt(a**2 + b**2))
end if
@@ -1070,7 +1070,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
@@ -1140,7 +1140,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
! Assign Parameters =========================================================
q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0)
@@ -1209,7 +1209,7 @@ contains
@:Hardcoded1D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id
end if
end do
@@ -1332,7 +1332,7 @@ contains
@:Hardcoded2D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id
end if
end do
@@ -1414,7 +1414,7 @@ contains
@:Hardcoded3D()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
@@ -1480,29 +1480,29 @@ contains
if (epsilon == 1._wp) then
if (beta == 0._wp) then
- H = 5d-1*sqrt(3._wp/pi)*cos(sph_phi)
+ H = 5e-1_wp*sqrt(3._wp/pi)*cos(sph_phi)
elseif (beta == 1._wp) then
- H = -5d-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)
+ H = -5e-1_wp*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)
end if
elseif (epsilon == 2._wp) then
if (beta == 0._wp) then
- H = 25d-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp)
+ H = 25e-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp)
elseif (beta == 1._wp) then
- H = -5d-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi)
+ H = -5e-1_wp*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi)
elseif (beta == 2._wp) then
- H = 25d-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2
+ H = 25e-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2
end if
elseif (epsilon == 3._wp) then
if (beta == 0._wp) then
- H = 25d-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi))
+ H = 25e-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi))
elseif (beta == 1._wp) then
- H = -125d-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* &
+ H = -125e-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* &
(5._wp*cos(sph_phi)**2 - 1._wp)
elseif (beta == 2._wp) then
- H = 25d-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
+ H = 25e-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
sin(sph_phi)**2*cos(sph_phi)
elseif (beta == 3._wp) then
- H = -125d-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp
+ H = -125e-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp
end if
elseif (epsilon == 4._wp) then
if (beta == 0._wp) then
@@ -1529,7 +1529,7 @@ contains
H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* &
sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp)
elseif (beta == 2._wp) then
- H = 125d-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
+ H = 125e-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* &
sin(sph_phi)**2*(3._wp*cos(sph_phi)**3._wp - cos(sph_phi))
elseif (beta == 3._wp) then
H = -1._wp/32._wp*sqrt(385._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* &
@@ -1728,7 +1728,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
@@ -1862,7 +1862,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end if
@@ -1948,7 +1948,7 @@ contains
end if
if (patch_icpp(patch_id)%smoothen) then
- eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy, dz) &
+ eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) &
*(a*x_cc(i) + &
b*cart_y + &
c*cart_z + d) &
@@ -1968,7 +1968,7 @@ contains
@:analytical()
! Updating the patch identities bookkeeping variable
- if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id
+ if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id
end if
end do
diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp
index 0ef4e2a0..b49db5fc 100644
--- a/src/pre_process/m_perturbation.fpp
+++ b/src/pre_process/m_perturbation.fpp
@@ -67,7 +67,7 @@ contains
perturb_alpha = q_prim_vf(E_idx + perturb_sph_fluid)%sf(i, j, k)
! Perturb partial density fields to match perturbed volume fraction fields
- ! IF ((perturb_alpha >= 25d-2) .AND. (perturb_alpha <= 75d-2)) THEN
+ ! IF ((perturb_alpha >= 25e-2) .AND. (perturb_alpha <= 75e-2)) THEN
if ((perturb_alpha /= 0._wp) .and. (perturb_alpha /= 1._wp)) then
! Derive new partial densities
@@ -518,9 +518,9 @@ contains
! Normalize the eigenvector by its component with the largest modulus.
norm = 0._wp
do i = 0, mixlayer_nvar*n - n_bc_skip - 1
- if (dsqrt(vr(i)**2 + vi(i)**2) > norm) then
+ if (sqrt(vr(i)**2 + vi(i)**2) > norm) then
idx = i
- norm = dsqrt(vr(i)**2 + vi(i)**2)
+ norm = sqrt(vr(i)**2 + vi(i)**2)
end if
end do
@@ -583,8 +583,8 @@ contains
xci = 0._wp
do i = 1, mixlayer_nvar
do k = 0, n
- xcr((i - 1)*(nbp - 1) + k) = 5d-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1))
- xci((i - 1)*(nbp - 1) + k) = 5d-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1))
+ xcr((i - 1)*(nbp - 1) + k) = 5e-1_wp*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1))
+ xci((i - 1)*(nbp - 1) + k) = 5e-1_wp*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1))
end do
end do
diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp
index cbceb1f2..6371a3f1 100644
--- a/src/simulation/include/inline_riemann.fpp
+++ b/src/simulation/include/inline_riemann.fpp
@@ -1,13 +1,13 @@
#:def arithmetic_avg()
- rho_avg = 5d-1*(rho_L + rho_R)
+ rho_avg = 5e-1_wp*(rho_L + rho_R)
vel_avg_rms = 0._wp
!$acc loop seq
do i = 1, num_dims
- vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp
+ vel_avg_rms = vel_avg_rms + (5e-1_wp*(vel_L(i) + vel_R(i)))**2._wp
end do
- H_avg = 5d-1*(H_L + H_R)
- gamma_avg = 5d-1*(gamma_L + gamma_R)
+ H_avg = 5e-1_wp*(H_L + H_R)
+ gamma_avg = 5e-1_wp*(gamma_L + gamma_R)
#:enddef arithmetic_avg
@@ -46,7 +46,7 @@
#:def compute_low_Mach_correction()
- zcoef = min(1._wp, max(vel_L_rms**5d-1/c_L, vel_R_rms**5d-1/c_R))
+ zcoef = min(1._wp, max(vel_L_rms**5e-1_wp/c_L, vel_R_rms**5e-1_wp/c_R))
pcorr = 0._wp
if (low_Mach == 1) then
@@ -55,8 +55,8 @@
(rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* &
(zcoef - 1._wp)
else if (low_Mach == 2) then
- vel_L_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1))))
- vel_R_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1))))
+ vel_L_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1))))
+ vel_R_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1))))
vel_L(dir_idx(1)) = vel_L_tmp
vel_R(dir_idx(1)) = vel_R_tmp
end if
diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp
index dfe2f8a1..7f947b60 100644
--- a/src/simulation/m_acoustic_src.fpp
+++ b/src/simulation/m_acoustic_src.fpp
@@ -250,7 +250,7 @@ contains
end if
small_gamma = 1._wp/small_gamma + 1._wp
- c = dsqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho)
+ c = sqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho)
! Wavelength to frequency conversion
if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c)
@@ -368,12 +368,12 @@ contains
end if
elseif (pulse(ai) == 2) then ! Gaussian pulse
- source = mag(ai)*dexp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
+ source = mag(ai)*exp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
if (term_index == mass_label) then
source = source/c - &
- foc_length_factor*mag(ai)*dsqrt(pi/2)*gauss_sigma_time_local* &
- (erf((sim_time - delay(ai))/(dsqrt(2._wp)*gauss_sigma_time_local)) + 1)
+ foc_length_factor*mag(ai)*sqrt(pi/2)*gauss_sigma_time_local* &
+ (erf((sim_time - delay(ai))/(sqrt(2._wp)*gauss_sigma_time_local)) + 1)
end if
elseif (pulse(ai) == 3) then ! Square wave
@@ -384,7 +384,7 @@ contains
source = mag(ai)*sign(1._wp, sine_wave)
! Prevent max-norm differences due to compilers to pass CI
- if (abs(sine_wave) < 1d-2) then
+ if (abs(sine_wave) < 1e-2) then
source = mag(ai)*sine_wave*1d2
end if
@@ -397,7 +397,7 @@ contains
integer :: count
integer :: dim
real(wp) :: source_spatial, angle, xyz_to_r_ratios(3)
- real(wp), parameter :: threshold = 1d-10
+ real(wp), parameter :: threshold = 1e-10
if (n == 0) then
dim = 1
@@ -537,14 +537,14 @@ contains
source = 0._wp
if (support(ai) == 1) then ! 1D
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
elseif (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D
! If we let unit vector e = (cos(dir), sin(dir)),
dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e)
if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then ! |r - dist*e| < length/2
if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
end if
end if
end if
@@ -573,20 +573,20 @@ contains
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
angle = -atan(r(2)/(foc_length(ai) - r(1)))
end if
elseif (support(ai) == 7) then ! 3D
- current_angle = -atan(dsqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
+ current_angle = -atan(sqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
- source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
- norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ norm = sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm
xyz_to_r_ratios(2) = -r(2)/norm
xyz_to_r_ratios(3) = -r(3)/norm
@@ -629,14 +629,14 @@ contains
current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai)
- dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
+ dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
do elem = elem_min, elem_max
angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp)
angle_min = angle_max - angle_per_elem
if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then
- source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp)
+ source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
angle = current_angle
exit ! Assume elements don't overlap
end if
@@ -652,7 +652,7 @@ contains
angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai)
! Point 2 is the elem center
- x2 = f - dsqrt(f**2 - half_apert**2)
+ x2 = f - sqrt(f**2 - half_apert**2)
y2 = half_apert*cos(angle_elem)
z2 = half_apert*sin(angle_elem)
@@ -663,12 +663,12 @@ contains
y3 = C*r(2)
z3 = C*r(3)
- dist_interp_to_elem_center = dsqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
+ dist_interp_to_elem_center = sqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
if ((dist_interp_to_elem_center < aperture_element_3D/2._wp) .and. (r(1) < f)) then
- dist = dsqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
- source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp)
+ dist = sqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
+ source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
- norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
+ norm = sqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
xyz_to_r_ratios(1) = -(r(1) - f)/norm
xyz_to_r_ratios(2) = -r(2)/norm
xyz_to_r_ratios(3) = -r(3)/norm
diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp
index 3e240064..012a9a56 100644
--- a/src/simulation/m_bubbles.fpp
+++ b/src/simulation/m_bubbles.fpp
@@ -139,7 +139,7 @@ contains
do j = 0, m
divu%sf(j, k, l) = 0._wp
divu%sf(j, k, l) = &
- 5d-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - &
+ 5e-1_wp/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - &
q_prim_vf(contxe + idir)%sf(j - 1, k, l))
end do
@@ -154,7 +154,7 @@ contains
do k = 0, n
do j = 0, m
divu%sf(j, k, l) = divu%sf(j, k, l) + &
- 5d-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - &
+ 5e-1_wp/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - &
q_prim_vf(contxe + idir)%sf(j, k - 1, l))
end do
@@ -168,7 +168,7 @@ contains
do k = 0, n
do j = 0, m
divu%sf(j, k, l) = divu%sf(j, k, l) + &
- 5d-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - &
+ 5e-1_wp/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - &
q_prim_vf(contxe + idir)%sf(j, k, l - 1))
end do
@@ -359,8 +359,8 @@ contains
! Rule 2: myR_tmp1(4) > 0._wp
! Rule 3: abs((myR_tmp1(4) - myR_tmp2(4))/myR) < tol
! Rule 4: abs((myV_tmp1(4) - myV_tmp2(4))/myV) < tol
- if ((err1 <= 1d-4) .and. (err2 <= 1d-4) .and. (err3 <= 1d-4) &
- .and. (err4 < 1d-4) .and. (err5 < 1d-4) &
+ if ((err1 <= 1e-4) .and. (err2 <= 1e-4) .and. (err3 <= 1e-4) &
+ .and. (err4 < 1e-4) .and. (err5 < 1e-4) &
.and. myR_tmp1(4) > 0._wp) then
! Accepted. Finalize the sub-step
@@ -371,12 +371,12 @@ contains
myV = myV_tmp1(4)
! Update step size for the next sub-step
- h = h*min(2._wp, max(0.5_wp, (1d-4/err1)**(1._wp/3._wp)))
+ h = h*min(2._wp, max(0.5_wp, (1e-4/err1)**(1._wp/3._wp)))
exit
else
! Rejected. Update step size for the next try on sub-step
- if (err2 <= 1d-4) then
+ if (err2 <= 1e-4) then
h = 0.5_wp*h
else
h = 0.25_wp*h
@@ -401,7 +401,7 @@ contains
bub_r_src(j, k, l, q) = q_cons_vf(vs(q))%sf(j, k, l)
end if
- if (alf < 1.d-11) then
+ if (alf < 1.e-11) then
bub_adv_src(j, k, l) = 0._wp
bub_r_src(j, k, l, q) = 0._wp
bub_v_src(j, k, l, q) = 0._wp
@@ -474,12 +474,12 @@ contains
f_bub_adv_src, f_divu)
! Compute d0 = ||y0|| and d1 = ||f(x0,y0)||
- d0 = DSQRT((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp)
- d1 = DSQRT((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp)
- if (d0 < 1d-5 .or. d1 < 1d-5) then
- h0 = 1d-6
+ d0 = sqrt((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp)
+ d1 = sqrt((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp)
+ if (d0 < 1e-5 .or. d1 < 1e-5) then
+ h0 = 1e-6
else
- h0 = 1d-2*(d0/d1)
+ h0 = 1e-2*(d0/d1)
end if
! Evaluate f(x0+h0,y0+h0*f(x0,y0))
@@ -490,14 +490,14 @@ contains
f_bub_adv_src, f_divu)
! Compute d2 = ||f(x0+h0,y0+h0*f(x0,y0))-f(x0,y0)||/h0
- d2 = DSQRT(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0
+ d2 = sqrt(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0
! Set h1 = (0.01/max(d1,d2))^{1/(p+1)}
! if max(d1,d2) < 1e-15, h1 = max(1e-6, h0*1e-3)
- if (max(d1, d2) < 1d-15) then
- h1 = max(1d-6, h0*1d-3)
+ if (max(d1, d2) < 1e-15) then
+ h1 = max(1e-6, h0*1e-3)
else
- h1 = (1d-2/max(d1, d2))**(1._wp/3._wp)
+ h1 = (1e-2/max(d1, d2))**(1._wp/3._wp)
end if
! Set h = min(100*h0,h1)
@@ -566,7 +566,7 @@ contains
/max(abs(myR_tmp(1)), abs(myR_tmp(4)))
err_V = (-5._wp*h/24._wp)*(myA_tmp(2) + myA_tmp(3) - 2._wp*myA_tmp(4)) &
/max(abs(myV_tmp(1)), abs(myV_tmp(4)))
- err = DSQRT((err_R**2._wp + err_V**2._wp)/2._wp)
+ err = sqrt((err_R**2._wp + err_V**2._wp)/2._wp)
end subroutine s_advance_substep
@@ -625,7 +625,7 @@ contains
tmp = (fCpinf/(1._wp + fBtait) + 1._wp)**((fntait - 1._wp)/fntait)
tmp = fntait*(1._wp + fBtait)*tmp
- f_cgas = dsqrt(tmp + (fntait - 1._wp)*fH)
+ f_cgas = sqrt(tmp + (fntait - 1._wp)*fH)
end function f_cgas
@@ -730,7 +730,7 @@ contains
! Keller-Miksis bubbles
fCpinf = fP
fCpbw = f_cpbw_KM(fR0, fR, fV, fpb)
- c_liquid = dsqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf)))
+ c_liquid = sqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf)))
f_rddot = f_rddot_KM(fpbdot, fCpinf, fCpbw, fRho, fR, fV, fR0, c_liquid)
else if (bubble_model == 3) then
! Rayleigh-Plesset bubbles
diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp
index 03c6a89d..aa885925 100644
--- a/src/simulation/m_cbc.fpp
+++ b/src/simulation/m_cbc.fpp
@@ -603,7 +603,7 @@ contains
!> The following is the implementation of the CBC based on
!! the work of Thompson (1987, 1990) on hyperbolic systems.
!! The CBC is indirectly applied in the computation of the
- !! right-hand-side (RHS) near the relevant domain boundary
+ !! right-hane-side (RHS) near the relevant domain boundary
!! through the modification of the fluxes.
!! @param q_prim_vf Cell-average primitive variables
!! @param flux_vf Cell-boundary-average fluxes
@@ -802,7 +802,7 @@ contains
mf(i) = alpha_rho(i)/rho
end do
- E = gamma*pres + pi_inf + 5d-1*rho*vel_K_sum
+ E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_K_sum
H = (E + pres)/rho
@@ -881,10 +881,10 @@ contains
! Be careful about the cylindrical coordinate!
if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then
- dpres_dt = -5d-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) &
+ dpres_dt = -5e-1_wp*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) &
/y_cc(n)
else
- dpres_dt = -5d-1*(L(advxe) + L(1))
+ dpres_dt = -5e-1_wp*(L(advxe) + L(1))
end if
!$acc loop seq
@@ -957,7 +957,7 @@ contains
+ dpi_inf_dt &
+ dqv_dt &
+ rho*vel_dv_dt_sum &
- + 5d-1*drho_dt*vel_K_sum)
+ + 5e-1_wp*drho_dt*vel_K_sum)
if (riemann_solver == 1) then
!$acc loop seq
diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp
index e061e4e0..577536a8 100644
--- a/src/simulation/m_compute_cbc.fpp
+++ b/src/simulation/m_compute_cbc.fpp
@@ -73,25 +73,25 @@ contains
integer :: i !< Generic loop iterator
- L(1) = (5d-1 - 5d-1*sign(1._wp, lambda(1)))*lambda(1) &
+ L(1) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(1)))*lambda(1) &
*(dpres_ds - rho*c*dvel_ds(dir_idx(1)))
do i = 2, momxb
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) &
*(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds)
end do
do i = momxb + 1, momxe
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) &
*(dvel_ds(dir_idx(i - contxe)))
end do
do i = E_idx, advxe - 1
- L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) &
+ L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) &
*(dadv_ds(i - momxe))
end do
- L(advxe) = (5d-1 - 5d-1*sign(1._wp, lambda(3)))*lambda(3) &
+ L(advxe) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(3)))*lambda(3) &
*(dpres_ds + rho*c*dvel_ds(dir_idx(1)))
end subroutine s_compute_nonreflecting_subsonic_buffer_L
diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp
index 38208e3d..1aa75048 100644
--- a/src/simulation/m_compute_levelset.fpp
+++ b/src/simulation/m_compute_levelset.fpp
@@ -61,7 +61,7 @@ contains
dist_vec(1) = x_cc(i) - x_centroid
dist_vec(2) = y_cc(j) - y_centroid
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
levelset(i, j, 0, ib_patch_id) = dist - radius
if (dist == 0) then
levelset_norm(i, j, 0, ib_patch_id, :) = 0
@@ -108,7 +108,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist
global_id = k
@@ -128,7 +128,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y
dist_vec(3) = 0
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist
global_id = k
@@ -197,7 +197,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y
dist_vec(3) = 0
- dist_surf = dsqrt(sum(dist_vec**2))
+ dist_surf = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist_surf
global_id = k
@@ -217,7 +217,7 @@ contains
dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x
dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y
dist_vec(3) = 0
- dist_surf = dsqrt(sum(dist_vec**2))
+ dist_surf = sqrt(sum(dist_vec**2))
if (k == 1) then
global_dist = dist_surf
global_id = k
@@ -368,7 +368,7 @@ contains
dist_vec(1) = x_cc(i) - x_centroid
dist_vec(2) = y_cc(j) - y_centroid
dist_vec(3) = z_cc(k) - z_centroid
- dist = dsqrt(sum(dist_vec**2))
+ dist = sqrt(sum(dist_vec**2))
levelset(i, j, k, ib_patch_id) = dist - radius
if (dist == 0) then
levelset_norm(i, j, k, ib_patch_id, :) = (/1, 0, 0/)
diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp
index f5231c85..6cd7bf07 100644
--- a/src/simulation/m_data_output.fpp
+++ b/src/simulation/m_data_output.fpp
@@ -985,7 +985,7 @@ contains
if (t_step_old /= dflt_int) then
nondim_time = real(t_step + t_step_old, wp)*dt
else
- nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451_wp
+ nondim_time = real(t_step, wp)*dt !*1.e-5/10.0761131451_wp
end if
end if
@@ -1088,7 +1088,7 @@ contains
nR3 = nR3 + weight(s)*(nR(s)**3._wp)
end do
- nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf)
+ nbub = sqrt((4._wp*pi/3._wp)*nR3/alf)
end if
#ifdef DEBUG
print *, 'In probe, nbub: ', nbub
@@ -1195,7 +1195,7 @@ contains
nR3 = nR3 + weight(s)*(nR(s)**3._wp)
end do
- nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf)
+ nbub = sqrt((4._wp*pi/3._wp)*nR3/alf)
end if
R(:) = nR(:)/nbub
@@ -1464,7 +1464,7 @@ contains
int_pres = int_pres + (pres - 1._wp)**2._wp
end if
end do
- int_pres = dsqrt(int_pres/(1._wp*npts))
+ int_pres = sqrt(int_pres/(1._wp*npts))
if (num_procs > 1) then
tmp = int_pres
@@ -1496,16 +1496,16 @@ contains
trigger = .false.
if (i == 1) then
!inner portion
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) &
trigger = .true.
elseif (i == 2) then
!net region
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. &
- dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. &
+ sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) &
trigger = .true.
elseif (i == 3) then
!everything else
- if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) &
+ if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) &
trigger = .true.
end if
diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp
index 1e688088..39f56729 100644
--- a/src/simulation/m_ibm.fpp
+++ b/src/simulation/m_ibm.fpp
@@ -680,13 +680,13 @@ contains
interp_coeffs = 0._wp
- if (dist(1, 1, 1) <= 1d-16) then
+ if (dist(1, 1, 1) <= 1e-16) then
interp_coeffs(1, 1, 1) = 1._wp
- else if (dist(2, 1, 1) <= 1d-16) then
+ else if (dist(2, 1, 1) <= 1e-16) then
interp_coeffs(2, 1, 1) = 1._wp
- else if (dist(1, 2, 1) <= 1d-16) then
+ else if (dist(1, 2, 1) <= 1e-16) then
interp_coeffs(1, 2, 1) = 1._wp
- else if (dist(2, 2, 1) <= 1d-16) then
+ else if (dist(2, 2, 1) <= 1e-16) then
interp_coeffs(2, 2, 1) = 1._wp
else
eta(:, :, 1) = 1._wp/dist(:, :, 1)**2
@@ -751,21 +751,21 @@ contains
(z_cc(k2) - gp%ip_loc(3))**2)
interp_coeffs = 0._wp
buf = 1._wp
- if (dist(1, 1, 1) <= 1d-16) then
+ if (dist(1, 1, 1) <= 1e-16) then
interp_coeffs(1, 1, 1) = 1._wp
- else if (dist(2, 1, 1) <= 1d-16) then
+ else if (dist(2, 1, 1) <= 1e-16) then
interp_coeffs(2, 1, 1) = 1._wp
- else if (dist(1, 2, 1) <= 1d-16) then
+ else if (dist(1, 2, 1) <= 1e-16) then
interp_coeffs(1, 2, 1) = 1._wp
- else if (dist(2, 2, 1) <= 1d-16) then
+ else if (dist(2, 2, 1) <= 1e-16) then
interp_coeffs(2, 2, 1) = 1._wp
- else if (dist(1, 1, 2) <= 1d-16) then
+ else if (dist(1, 1, 2) <= 1e-16) then
interp_coeffs(1, 1, 2) = 1._wp
- else if (dist(2, 1, 2) <= 1d-16) then
+ else if (dist(2, 1, 2) <= 1e-16) then
interp_coeffs(2, 1, 2) = 1._wp
- else if (dist(1, 2, 2) <= 1d-16) then
+ else if (dist(1, 2, 2) <= 1e-16) then
interp_coeffs(1, 2, 2) = 1._wp
- else if (dist(2, 2, 2) <= 1d-16) then
+ else if (dist(2, 2, 2) <= 1e-16) then
interp_coeffs(2, 2, 2) = 1._wp
else
eta = 1._wp/dist**2
diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp
index bfbc590d..b3b112f3 100644
--- a/src/simulation/m_qbmm.fpp
+++ b/src/simulation/m_qbmm.fpp
@@ -462,9 +462,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -475,15 +475,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -546,9 +546,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -559,15 +559,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -603,9 +603,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l))
@@ -616,15 +616,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
end do
@@ -654,9 +654,9 @@ contains
end if
if (q <= 2) then
- AX = R - dsqrt(var)
+ AX = R - sqrt(var)
else
- AX = R + dsqrt(var)
+ AX = R + sqrt(var)
end if
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
@@ -667,15 +667,15 @@ contains
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
if (q <= 2) then
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
else
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
- rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* &
+ rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* &
(-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
end if
@@ -869,7 +869,7 @@ contains
c = n_tait*(pres + B_tait)*(1._wp - alf)/(rho)
if (c > 0._wp) then
- c = DSQRT(c)
+ c = sqrt(c)
else
c = sgm_eps
end if
@@ -977,16 +977,16 @@ contains
drdt = msum(2)
if (moms(4) - moms(2)**2._wp > 0._wp) then
if (j == 1 .or. j == 2) then
- drdt2 = -1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp))
+ drdt2 = -1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp))
else
- drdt2 = 1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp))
+ drdt2 = 1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp))
end if
else
! Edge case where variance < 0
if (j == 1 .or. j == 2) then
- drdt2 = -1._wp/(2._wp*dsqrt(verysmall))
+ drdt2 = -1._wp/(2._wp*sqrt(verysmall))
else
- drdt2 = 1._wp/(2._wp*dsqrt(verysmall))
+ drdt2 = 1._wp/(2._wp*sqrt(verysmall))
end if
end if
@@ -1006,7 +1006,7 @@ contains
momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp)
momsp(2)%sf(id1, id2, id3) = 4._wp*pi*nbub*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp)
momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 2._wp, 0._wp)
- if (abs(gam - 1._wp) <= 1.d-4) then
+ if (abs(gam - 1._wp) <= 1.e-4) then
! Gam \approx 1, don't risk imaginary quadrature
momsp(4)%sf(id1, id2, id3) = 1._wp
else
@@ -1129,8 +1129,8 @@ contains
frho(1) = fmom(1)/2._wp;
frho(2) = fmom(1)/2._wp;
c2 = maxval((/c2, verysmall/))
- fup(1) = bu - DSQRT(c2)
- fup(2) = bu + DSQRT(c2)
+ fup(1) = bu - sqrt(c2)
+ fup(2) = bu + sqrt(c2)
end subroutine s_hyqmom
diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp
index d70df65b..ec800958 100644
--- a/src/simulation/m_rhs.fpp
+++ b/src/simulation/m_rhs.fpp
@@ -6,7 +6,7 @@
#:include 'macros.fpp'
!> @brief The module contains the subroutines used to calculate the right-
-!! hand-side (RHS) in the quasi-conservative, shock- and interface-
+!! hane-side (RHS) in the quasi-conservative, shock- and interface-
!! capturing finite-volume framework for the multicomponent Navier-
!! Stokes equations supplemented by appropriate advection equations
!! used to capture the material interfaces. The system of equations
@@ -1285,7 +1285,7 @@ contains
do j = 0, m
do i = 1, num_fluids
rhs_vf(i + intxb - 1)%sf(j, k, l) = &
- rhs_vf(i + intxb - 1)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i + intxb - 1)%sf(j, k, l) - 5e-1_wp/y_cc(k)* &
q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* &
q_prim_vf%vf(E_idx)%sf(j, k, l)* &
(flux_src_n(2)%vf(advxb)%sf(j, k, l) + &
@@ -1304,7 +1304,7 @@ contains
do k = 0, n
do q = 0, m
rhs_vf(j)%sf(q, k, l) = &
- rhs_vf(j)%sf(q, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(j)%sf(q, k, l) - 5e-1_wp/y_cc(k)* &
(flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l) &
+ flux_gsrc_n(2)%vf(j)%sf(q, k, l))
end do
@@ -1443,7 +1443,7 @@ contains
do q = 0, n
do l = 0, m
rhs_vf(j)%sf(l, q, k) = &
- rhs_vf(j)%sf(l, q, k) - 5d-1/y_cc(q)* &
+ rhs_vf(j)%sf(l, q, k) - 5e-1_wp/y_cc(q)* &
(flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1) &
- flux_gsrc_n(3)%vf(j)%sf(l, q, k))
end do
@@ -1785,7 +1785,7 @@ contains
!$acc loop seq
do i = momxb, E_idx
rhs_vf(i)%sf(j, k, l) = &
- rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i)%sf(j, k, l) - 5e-1_wp/y_cc(k)* &
(flux_src_n(i)%sf(j, k - 1, l) &
+ flux_src_n(i)%sf(j, k, l))
end do
@@ -1815,7 +1815,7 @@ contains
!$acc loop seq
do i = momxb, E_idx
rhs_vf(i)%sf(j, k, l) = &
- rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* &
+ rhs_vf(i)%sf(j, k, l) - 5e-1_wp/y_cc(k)* &
(flux_src_n(i)%sf(j, k - 1, l) &
+ flux_src_n(i)%sf(j, k, l))
end do
@@ -1864,12 +1864,12 @@ contains
do k = 0, n
do j = 0, m
rhs_vf(momxb + 1)%sf(j, k, l) = &
- rhs_vf(momxb + 1)%sf(j, k, l) + 5d-1* &
+ rhs_vf(momxb + 1)%sf(j, k, l) + 5e-1_wp* &
(flux_src_n(momxe)%sf(j, k, l - 1) &
+ flux_src_n(momxe)%sf(j, k, l))
rhs_vf(momxe)%sf(j, k, l) = &
- rhs_vf(momxe)%sf(j, k, l) - 5d-1* &
+ rhs_vf(momxe)%sf(j, k, l) - 5e-1_wp* &
(flux_src_n(momxb + 1)%sf(j, k, l - 1) &
+ flux_src_n(momxb + 1)%sf(j, k, l))
end do
@@ -1965,8 +1965,8 @@ contains
q_cons_vf(i + advxb - 1)%sf(j, k, l) &
- pi_infs(i))/gammas(i)
- if (pres_K_init(i) <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) &
- pres_K_init(i) = -(1._wp - 1d-8)*pres_inf(i) + 1d-8
+ if (pres_K_init(i) <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) &
+ pres_K_init(i) = -(1._wp - 1e-8)*pres_inf(i) + 1e-8
else
pres_K_init(i) = 0._wp
end if
@@ -1974,7 +1974,7 @@ contains
end do
! Iterative process for relaxed pressure determination
- f_pres = 1d-9
+ f_pres = 1e-9
df_pres = 1d9
!$acc loop seq
@@ -1985,13 +1985,13 @@ contains
!$acc loop seq
do iter = 0, 49
- if (DABS(f_pres) > 1d-10) then
+ if (abs(f_pres) > 1e-10) then
pres_relax = pres_relax - f_pres/df_pres
! Physical pressure
do i = 1, num_fluids
- if (pres_relax <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) &
- pres_relax = -(1._wp - 1d-8)*pres_inf(i) + 1._wp
+ if (pres_relax <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) &
+ pres_relax = -(1._wp - 1e-8)*pres_inf(i) + 1._wp
end do
! Newton-Raphson method
@@ -2114,7 +2114,7 @@ contains
!$acc loop seq
do i = momxb, momxe
- dyn_pres = dyn_pres + 5d-1*q_cons_vf(i)%sf(j, k, l)* &
+ dyn_pres = dyn_pres + 5e-1_wp*q_cons_vf(i)%sf(j, k, l)* &
q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps)
end do
diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp
index 2d14710e..0edbd97d 100644
--- a/src/simulation/m_riemann_solvers.fpp
+++ b/src/simulation/m_riemann_solvers.fpp
@@ -469,8 +469,8 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -553,35 +553,35 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
s_M = min(0._wp, s_L); s_P = max(0._wp, s_R)
- xi_M = (5d-1 + sign(5d-1, s_L)) &
- + (5d-1 - sign(5d-1, s_L)) &
- *(5d-1 + sign(5d-1, s_R))
- xi_P = (5d-1 - sign(5d-1, s_R)) &
- + (5d-1 - sign(5d-1, s_L)) &
- *(5d-1 + sign(5d-1, s_R))
+ xi_M = (5e-1_wp + sign(5e-1_wp, s_L)) &
+ + (5e-1_wp - sign(5e-1_wp, s_L)) &
+ *(5e-1_wp + sign(5e-1_wp, s_R))
+ xi_P = (5e-1_wp - sign(5e-1_wp, s_R)) &
+ + (5e-1_wp - sign(5e-1_wp, s_L)) &
+ *(5e-1_wp + sign(5e-1_wp, s_R))
! Mass
!$acc loop seq
@@ -1037,9 +1037,9 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1076,23 +1076,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1336,9 +1336,9 @@ contains
qv_R = qv_R + alpha_rho_R(i)*qvs(i)
end do
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1368,23 +1368,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1400,8 +1400,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1_wp + sign(5e-1_wp, s_S))
+ xi_P = (5e-1_wp - sign(5e-1_wp, s_S))
!$acc loop seq
do i = 1, contxe
@@ -1645,9 +1645,9 @@ contains
end if
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -1749,14 +1749,14 @@ contains
if ((ptilde_L /= ptilde_L) .or. (ptilde_R /= ptilde_R)) then
end if
- rho_avg = 5d-1*(rho_L + rho_R)
- H_avg = 5d-1*(H_L + H_R)
- gamma_avg = 5d-1*(gamma_L + gamma_R)
+ rho_avg = 5e-1_wp*(rho_L + rho_R)
+ H_avg = 5e-1_wp*(H_L + H_R)
+ gamma_avg = 5e-1_wp*(gamma_L + gamma_R)
vel_avg_rms = 0._wp
!$acc loop seq
do i = 1, num_dims
- vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp
+ vel_avg_rms = vel_avg_rms + (5e-1_wp*(vel_L(i) + vel_R(i)))**2._wp
end do
end if
@@ -1795,23 +1795,23 @@ contains
/(rho_L*(s_L - vel_L(dir_idx(1))) - &
rho_R*(s_R - vel_R(dir_idx(1))))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(dir_idx(1)) - &
vel_R(dir_idx(1))))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(dir_idx(1)) - c_L*Ms_L
s_R = vel_R(dir_idx(1)) + c_R*Ms_R
- s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
+ s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -1827,8 +1827,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1_wp + sign(5e-1_wp, s_S))
+ xi_P = (5e-1_wp - sign(5e-1_wp, s_S))
if (low_Mach == 1) then
@:compute_low_Mach_correction()
@@ -2107,9 +2107,9 @@ contains
end do
end if
- E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L
+ E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L
- E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R
+ E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R
H_L = (E_L + pres_L)/rho_L
H_R = (E_R + pres_R)/rho_R
@@ -2151,23 +2151,23 @@ contains
rho_R*(s_R - vel_R(idx1)))
elseif (wave_speeds == 2) then
- pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* &
+ pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* &
(vel_L(idx1) - &
vel_R(idx1)))
pres_SR = pres_SL
- Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* &
+ Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* &
(pres_SL/pres_L - 1._wp)*pres_L/ &
((pres_L + pi_inf_L/(1._wp + gamma_L)))))
- Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* &
+ Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* &
(pres_SR/pres_R - 1._wp)*pres_R/ &
((pres_R + pi_inf_R/(1._wp + gamma_R)))))
s_L = vel_L(idx1) - c_L*Ms_L
s_R = vel_R(idx1) + c_R*Ms_R
- s_S = 5d-1*((vel_L(idx1) + vel_R(idx1)) + &
+ s_S = 5e-1_wp*((vel_L(idx1) + vel_R(idx1)) + &
(pres_L - pres_R)/ &
(rho_avg*c_avg))
end if
@@ -2183,8 +2183,8 @@ contains
! goes with numerical velocity in x/y/z directions
! xi_P/M = 0.5 +/m sgn(0.5,s_star)
- xi_M = (5d-1 + sign(5d-1, s_S))
- xi_P = (5d-1 - sign(5d-1, s_S))
+ xi_M = (5e-1_wp + sign(5e-1_wp, s_S))
+ xi_P = (5e-1_wp - sign(5e-1_wp, s_S))
if (low_Mach == 1) then
@:compute_low_Mach_correction()
@@ -3083,7 +3083,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ &
@@ -3109,7 +3109,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dx(1)/ &
@@ -3137,17 +3137,17 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j + 1, k, l))
!$acc loop seq
do i = 1, 2
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvelR_dx_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + &
@@ -3179,10 +3179,10 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j + 1, k, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = (dvel_avg_dy(2) + &
@@ -3214,11 +3214,11 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvelR_dx_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ &
@@ -3252,7 +3252,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dz(3)/y_cc(k)/ &
@@ -3283,18 +3283,18 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k + 1, l))
!$acc loop seq
do i = 1, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k + 1, l))
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k + 1, l))
end do
@@ -3332,13 +3332,13 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k + 1, l))
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k + 1, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k + 1, l))
tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2) + &
@@ -3367,17 +3367,17 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(3) = 5d-1*(velL_vf(3)%sf(j, k, l) &
+ avg_vel(3) = 5e-1_wp*(velL_vf(3)%sf(j, k, l) &
+ velR_vf(3)%sf(j, k + 1, l))
!$acc loop seq
do i = 2, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k + 1, l))
end do
- dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvelR_dy_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ &
@@ -3412,7 +3412,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = dvel_avg_dz(3)/y_cb(k)/ &
@@ -3444,27 +3444,27 @@ contains
!$acc loop seq
do i = 2, 3
- avg_vel(i) = 5d-1*(velL_vf(i)%sf(j, k, l) &
+ avg_vel(i) = 5e-1_wp*(velL_vf(i)%sf(j, k, l) &
+ velR_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k, l + 1))
end do
do i = 2, 3
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k, l + 1))
end do
@@ -3507,16 +3507,16 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) &
+ avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) &
+ velR_vf(2)%sf(j, k, l + 1))
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k, l + 1))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k, l + 1))
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k, l + 1))
tau_Re(3, 3) = (dvel_avg_dx(1) &
@@ -3607,7 +3607,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ &
@@ -3633,7 +3633,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dx(1)/ &
@@ -3664,11 +3664,11 @@ contains
!$acc loop seq
do i = 1, 2
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) &
+ dvelR_dx_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ &
@@ -3702,7 +3702,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dy(2)/ &
@@ -3733,11 +3733,11 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j + 1, k, l))
end do
- dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) &
+ dvelR_dx_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ &
@@ -3770,7 +3770,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j + 1, k, l))
tau_Re(1, 1) = dvel_avg_dz(3)/ &
@@ -3804,11 +3804,11 @@ contains
do i = 1, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k + 1, l))
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k + 1, l))
end do
@@ -3845,10 +3845,10 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k + 1, l))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k + 1, l))
tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2))/ &
@@ -3879,11 +3879,11 @@ contains
!$acc loop seq
do i = 2, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k + 1, l))
end do
- dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) &
+ dvelR_dy_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ &
@@ -3917,7 +3917,7 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k + 1, l))
tau_Re(2, 2) = dvel_avg_dz(3)/ &
@@ -3950,21 +3950,21 @@ contains
!$acc loop seq
do i = 1, 3, 2
dvel_avg_dx(i) = &
- 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) &
+ dvelR_dx_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 2, 3
dvel_avg_dy(i) = &
- 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) &
+ dvelR_dy_vf(i)%sf(j, k, l + 1))
end do
!$acc loop seq
do i = 1, 3
dvel_avg_dz(i) = &
- 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) &
+ 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) &
+ dvelR_dz_vf(i)%sf(j, k, l + 1))
end do
@@ -4004,13 +4004,13 @@ contains
do k = isy%beg, isy%end
do j = isx%beg, isx%end
- dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) &
+ dvelR_dx_vf(1)%sf(j, k, l + 1))
- dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) &
+ dvelR_dy_vf(2)%sf(j, k, l + 1))
- dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) &
+ dvelR_dz_vf(3)%sf(j, k, l + 1))
tau_Re(3, 3) = (dvel_avg_dx(1) &
diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90
index 30f05fde..6b3fa1c4 100644
--- a/src/simulation/m_sim_helpers.f90
+++ b/src/simulation/m_sim_helpers.f90
@@ -62,7 +62,7 @@ contains
pres = q_prim_vf(E_idx)%sf(j, k, l)
- E = gamma*pres + pi_inf + 5d-1*rho*vel_sum + qv
+ E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_sum + qv
H = (E + pres)/rho
diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp
index a05c10e0..aa495d46 100644
--- a/src/simulation/m_start_up.fpp
+++ b/src/simulation/m_start_up.fpp
@@ -36,7 +36,7 @@ module m_start_up
use m_acoustic_src !< Acoustic source calculations
- use m_rhs !< Right-hand-side (RHS) evaluation procedures
+ use m_rhs !< Right-hane-side (RHS) evaluation procedures
use m_chemistry !< Chemistry module
@@ -1062,7 +1062,7 @@ contains
dyn_pres = 0._wp
do i = mom_idx%beg, mom_idx%end
- dyn_pres = dyn_pres + 5d-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) &
+ dyn_pres = dyn_pres + 5e-1_wp*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) &
/max(rho, sgm_eps)
end do
@@ -1108,7 +1108,7 @@ contains
if (t_step == 0) dt_init = dt
- if (dt < 1d-3*dt_init) call s_mpi_abort("Delta t has become too small")
+ if (dt < 1e-3*dt_init) call s_mpi_abort("Delta t has become too small")
end if
if (cfl_dt) then
diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp
index f5b65be4..2a4fb9e1 100644
--- a/src/simulation/m_time_steppers.fpp
+++ b/src/simulation/m_time_steppers.fpp
@@ -17,7 +17,7 @@ module m_time_steppers
use m_global_parameters !< Definitions of the global parameters
- use m_rhs !< Right-hand-side (RHS) evaluation procedures
+ use m_rhs !< Right-hane-side (RHS) evaluation procedures
use m_data_output !< Run-time info & solution data output procedures
diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp
index 6056ee15..389d024d 100644
--- a/src/simulation/m_viscous.fpp
+++ b/src/simulation/m_viscous.fpp
@@ -679,7 +679,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, j - 1, l) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, j - 1, l))
- dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqL_prim_dx_n(2)%vf(i)%sf(k, j, l)
end do
end do
@@ -698,7 +698,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, j, l) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, j, l))
- dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqR_prim_dx_n(2)%vf(i)%sf(k, j, l)
end do
@@ -718,7 +718,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(j - 1, k, l) + &
dqR_prim_dy_n(2)%vf(i)%sf(j - 1, k, l))
- dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqL_prim_dy_n(1)%vf(i)%sf(j, k, l)
end do
@@ -738,7 +738,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(j, k, l) + &
dqR_prim_dy_n(2)%vf(i)%sf(j, k, l))
- dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqR_prim_dy_n(1)%vf(i)%sf(j, k, l)
end do
@@ -793,7 +793,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(j - 1, k, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(j - 1, k, l))
- dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqL_prim_dz_n(1)%vf(i)%sf(j, k, l)
end do
@@ -814,7 +814,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(j, k, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(j, k, l))
- dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* &
+ dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* &
dqR_prim_dz_n(1)%vf(i)%sf(j, k, l)
end do
@@ -835,7 +835,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(k, j - 1, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(k, j - 1, l))
- dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqL_prim_dz_n(2)%vf(i)%sf(k, j, l)
end do
@@ -856,7 +856,7 @@ contains
dqL_prim_dz_n(3)%vf(i)%sf(k, j, l) + &
dqR_prim_dz_n(3)%vf(i)%sf(k, j, l))
- dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* &
+ dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* &
dqR_prim_dz_n(2)%vf(i)%sf(k, j, l)
end do
@@ -877,7 +877,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(k, l, j - 1) + &
dqR_prim_dy_n(2)%vf(i)%sf(k, l, j - 1))
- dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqL_prim_dy_n(3)%vf(i)%sf(k, l, j)
end do
@@ -898,7 +898,7 @@ contains
dqL_prim_dy_n(2)%vf(i)%sf(k, l, j) + &
dqR_prim_dy_n(2)%vf(i)%sf(k, l, j))
- dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqR_prim_dy_n(3)%vf(i)%sf(k, l, j)
end do
@@ -918,7 +918,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, l, j - 1) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, l, j - 1))
- dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqL_prim_dx_n(3)%vf(i)%sf(k, l, j)
end do
@@ -937,7 +937,7 @@ contains
dqL_prim_dx_n(1)%vf(i)%sf(k, l, j) + &
dqR_prim_dx_n(1)%vf(i)%sf(k, l, j))
- dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* &
+ dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* &
dqR_prim_dx_n(3)%vf(i)%sf(k, l, j)
end do
diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp
index 02997fdd..143f2540 100644
--- a/src/simulation/m_weno.fpp
+++ b/src/simulation/m_weno.fpp
@@ -909,8 +909,8 @@ contains
!! stencil.
!! @param i Equation number
!! @param j First-coordinate cell index
- !! @param k Second-coordinate cell index
- !! @param l Third-coordinate cell index
+ !! @param k Secone-coordinate cell index
+ !! @param l Thire-coordinate cell index
subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf)
real(wp), dimension(startx:, starty:, startz:, 1:), intent(IN) :: v_rs_ws
@@ -981,11 +981,11 @@ contains
vL_MD = (v_rs_ws(j, k, l, i) &
+ v_rs_ws(j - 1, k, l, i) &
- - d_MD)*5d-1
+ - d_MD)*5e-1_wp
vL_LC = v_rs_ws(j, k, l, i) &
- (v_rs_ws(j + 1, k, l, i) &
- - v_rs_ws(j, k, l, i))*5d-1 + beta_mp*d_LC
+ - v_rs_ws(j, k, l, i))*5e-1_wp + beta_mp*d_LC
vL_min = max(min(v_rs_ws(j, k, l, i), &
v_rs_ws(j - 1, k, l, i), &
@@ -1002,8 +1002,8 @@ contains
vL_LC))
vL_rs_vf(j, k, l, i) = vL_rs_vf(j, k, l, i) &
- + (sign(5d-1, vL_min - vL_rs_vf(j, k, l, i)) &
- + sign(5d-1, vL_max - vL_rs_vf(j, k, l, i))) &
+ + (sign(5e-1_wp, vL_min - vL_rs_vf(j, k, l, i)) &
+ + sign(5e-1_wp, vL_max - vL_rs_vf(j, k, l, i))) &
*min(abs(vL_min - vL_rs_vf(j, k, l, i)), &
abs(vL_max - vL_rs_vf(j, k, l, i)))
! END: Left Monotonicity Preserving Bound ==========================
@@ -1040,11 +1040,11 @@ contains
vR_MD = (v_rs_ws(j, k, l, i) &
+ v_rs_ws(j + 1, k, l, i) &
- - d_MD)*5d-1
+ - d_MD)*5e-1_wp
vR_LC = v_rs_ws(j, k, l, i) &
+ (v_rs_ws(j, k, l, i) &
- - v_rs_ws(j - 1, k, l, i))*5d-1 + beta_mp*d_LC
+ - v_rs_ws(j - 1, k, l, i))*5e-1_wp + beta_mp*d_LC
vR_min = max(min(v_rs_ws(j, k, l, i), &
v_rs_ws(j + 1, k, l, i), &
@@ -1061,8 +1061,8 @@ contains
vR_LC))
vR_rs_vf(j, k, l, i) = vR_rs_vf(j, k, l, i) &
- + (sign(5d-1, vR_min - vR_rs_vf(j, k, l, i)) &
- + sign(5d-1, vR_max - vR_rs_vf(j, k, l, i))) &
+ + (sign(5e-1_wp, vR_min - vR_rs_vf(j, k, l, i)) &
+ + sign(5e-1_wp, vR_max - vR_rs_vf(j, k, l, i))) &
*min(abs(vR_min - vR_rs_vf(j, k, l, i)), &
abs(vR_max - vR_rs_vf(j, k, l, i)))
! END: Right Monotonicity Preserving Bound ========================= |
|
Note that my patch does not cover all the In order to capture which have a |
|
This was the command i used to try to replace all instances. This did a good job of replacing all instances. find src -type f ( -name ".f90" -o -name ".fpp" ) -exec sed -i '' -E 's/([+-]?[0-9]+(.[0-9]*)?)dDeE/(\1_wp * (10._wp ** \3))/g' {} + When I did this, it created a huge slate of warnings and was extremely messy so I just took Henry's suggestion and went with the agnostic type. |
|
did it work? At the end of the day, the codebase has lines like |
@aricer123 the tests work because it's using double precision in FFTW for those test cases, even if the rest of the code is using single precision. I recommend removing any options that use FFTW + single-precision computation, unless you support single-precision FFTW, because actual computations that use single precision and FFTW will be as slow as the FFT in double precision (because presumably it is promoting single to double precision internally in the FFTW interface or something) |
|
@aricer123 btw these checks can happen in Update: Actually, I think it's fine if this happens in double precision (even in single precision mode). it's very little of the computation and happens in edge cases anyway. Is there anything left in this PR? I guess we still need to see why there's no speedup on CPU cases... |
|
This most recent commit(the one that just passed CI) already includes the checks and removes the FFTW cases in single precision. Should I remove this functionality and go back to what I had before? Yea, there's nothing else apart from CPU speedup. I have to try to figure out how to run a profile on my Mac since there are limited profiling tools for Mac, I tried using Xcode instruments' time profiler but I couldn't see anything that would allow me to accurately compare fp32 vs fp64 computations. What do you use for your Mac to profile? |
|
I think you can leave it as-is. Easy enough to revert it back later.
To my knowledge there is not a good profiler you can use on Apple silicon.
If you don’t have an account of Phoenix or Rogues Gallery or the ACCESS-CI machines then you will need one regardless. Please see how to get them by reading the group syllabus.
|
|
An update: I ran on my Mac with gfortran and added |
|
@aricer123 I think this is good to go except for one minor but very necessary thing: Documentation. Update the docs to include how to use this feature (or not use it) (and notify the user that it exists). Also add it to the readme under capabilities -> software (or whatever I call it). If we discover some other operations around that were hiding double precision then we can take care of them later, but I don't want to delay merging this (save for the docs). |
sbryngelson
approved these changes
Dec 16, 2024
|
Follow up GH issue here #759 |
20 tasks
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
Description
Fixes #42
Type of change
Changes all instances of double precision in MFC with constant declared in the common directory, works with and without MPI support. Handles and fixes bugs with ./mfc.sh test -a in single precision to ensure it works/ensure post process works(FTTW and Silo calls). Ensures compatibility with latest chemistry additions and handles prometheus single precision. Makes sure linter cannot find any instances of double precision or kind literals in the code.
Adds flags for users to choose between single and double precision at build and adjusts tolerance to allow tests to pass regardless of precision mode. Skips some tests which have high relative error after trying to change the initial conditions so solutions wouldn't be as close to 0 as discussed in hackathon.
Adds a single precision check to the CI to ensure the test suite passes in single precision for all future PRs.
How has this been tested
Passes test suite so far, verified all instances were changed by parsing files to ensure no more instances of double precision.
I also profiled this on the GPUs by committing in single precision, a 1.3 - 1.5x increase in performance was observed.
Also used vislt to visualize the results of some cases which were previously having NaNs in post process to ensure there was no issue.