diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index 562005ac32..3a382caaed 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -7,12 +7,12 @@ select case (patch_icpp(patch_id)%hcid) case (150) ! 1D Smooth Alfven Case for MHD ! velocity - q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) - q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) ! magnetic field - q_prim_vf(B_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) - q_prim_vf(B_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox) ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, ! SDtoolbox) @@ -21,36 +21,36 @@ ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + ! 0.2*sin(5*x)" if (patch_id == 2) then - q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i)) + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i)) end if case (181) ! Titarev-Torro problem ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": ! "1 + 0.1*sin(20*x*pi)" - q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi) + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi) case (182) ! Multi-component diffusion ! This patch is a hard-coded for test suite optimization (multiple component diffusion) x_mid_diffu = 0.05_wp/2.0_wp width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq) - q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp - q_prim_vf(E_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 - q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp + q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp + q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 + q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp - q_prim_vf(chemxb)%sf(i, 0, 0) = y1 - q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2 - q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3 - q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4 + q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1 + q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2 + q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3 + q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp - q_prim_vf(contxb)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv) + q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv) case default call s_int_to_str(patch_id, iStr) call s_mpi_abort("Invalid hcid specified for patch " // trim(iStr)) diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp index b2752228f0..a1fc9d297a 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -21,11 +21,11 @@ case (200) ! Two-fluid cubic interface if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then ! Volume Fractions - q_prim_vf(advxb)%sf(i, j, 0) = eps - q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps - q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp - q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp - q_prim_vf(E_idx)%sf(i, j, 0) = 1000._wp + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp end if case (202) ! Gresho vortex (Gouasmi et al 2022 JCP) r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp @@ -36,17 +36,17 @@ p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax - q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) else if (r < 2*rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) else - q_prim_vf(momxb)%sf(i, j, 0) = 0._wp - q_prim_vf(momxe)%sf(i, j, 0) = 0._wp - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp)) end if case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp @@ -57,20 +57,20 @@ p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax - q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) else if (r < 2*rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax))) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax))) else - q_prim_vf(momxb)%sf(i, j, 0) = 0._wp - q_prim_vf(momxe)%sf(i, j, 0) = 0._wp - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp)) end if - q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1._wp/gam) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam) case (204) ! Rayleigh-Taylor instability rhoH = 3._wp rhoL = 1._wp @@ -89,18 +89,18 @@ if (alph > 1._wp - eps) alph = 1._wp - eps if (y_cc(j) > intH) then - q_prim_vf(advxb)%sf(i, j, 0) = alph - q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph - q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhoL - q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoH + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhoL + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) else - q_prim_vf(advxb)%sf(i, j, 0) = alph - q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph - q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhoL + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoH + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhoL pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if case (205) ! 2D lung wave interaction problem h = 0.0_wp ! non dim origin y @@ -110,11 +110,11 @@ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h if (y_cc(j) > intH) then - q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) - q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) - q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres - q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) - q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2) end if case (206) ! 2D lung wave interaction problem - horizontal domain h = 0.0_wp ! non dim origin y @@ -124,17 +124,17 @@ intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h if (x_cc(i) > intL) then ! this is the liquid - q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) - q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) - q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres - q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) - q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2) end if case (207) ! Kelvin Helmholtz Instability sigma = 0.05_wp/sqrt(2.0_wp) gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2)) gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2)) - q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2) case (208) ! Richtmeyer Meshkov Instability lam = 1.0_wp eps = 1.0e-6_wp @@ -145,32 +145,32 @@ fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy)))) alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm alpha_sf6 = 1.0_wp - alpha_air - q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp - q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp - q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6 - q_prim_vf(advxe)%sf(i, j, 0) = alpha_air + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp + q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6 + q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air end if case (250) ! MHD Orszag-Tang vortex ! gamma = 5/3 rho = 25/(36*pi) p = 5/(12*pi) v = (-sin(2*pi*y), sin(2*pi*x), 0) B = (-sin(2*pi*y)/sqrt(4*pi), ! sin(4*pi*x)/sqrt(4*pi), 0) - q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j)) - q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i)) - q_prim_vf(B_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) - q_prim_vf(B_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi) case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1] if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then - q_prim_vf(contxb)%sf(i, j, 0) = 0.01 - q_prim_vf(E_idx)%sf(i, j, 0) = 1.0 + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01 + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then ! Linear interpolation between r=0.08 and r=1.0 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp) - q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor) - q_prim_vf(E_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor) else - q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp - q_prim_vf(E_idx)%sf(i, j, 0) = 3.e-5_wp + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp end if ! case 252 is for the 2D MHD Rotor problem @@ -186,34 +186,34 @@ ! inner radius of 0.1 if (r_sq <= 0.1**2) then ! -- Inside the rotor -- Set density uniformly to 10 - q_prim_vf(contxb)%sf(i, j, 0) = 10._wp + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c) - q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp) - q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp) ! taper width of 0.015 else if (r_sq <= 0.115**2) then ! linearly smooth the function between r = 0.1 and 0.115 - q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp) - q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) - q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp) end if case (253) ! MHD Smooth Magnetic Vortex ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P. ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire ! velocity - q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) - q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)) ! magnetic field - q_prim_vf(B_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) - q_prim_vf(B_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) ! pressure - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%E)%sf(i, j, & & 0) = 1._wp + (1 - 2._wp*(x_cc(i)**2 + y_cc(j)**2))*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/((2._wp*pi)**3) case (260) ! Gaussian Divergence Pulse ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma) @@ -225,17 +225,17 @@ C_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp ! B-field - q_prim_vf(B_idx%beg)%sf(i, j, 0) = 1._wp + C_mhd*erf((x_cc(i) - 0.5_wp)/sigma) + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + C_mhd*erf((x_cc(i) - 0.5_wp)/sigma) case (261) ! Blob r0 = 1._wp/sqrt(8._wp) r2 = x_cc(i)**2 + y_cc(j)**2 r = sqrt(r2) alpha = r/r0 if (alpha < 1) then - q_prim_vf(B_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp) - ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp) - ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) q_prim_vf(E_idx)%sf(i,j,0) = - ! 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp) + ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp) + ! q_prim_vf(eqn_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) + ! q_prim_vf(eqn_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(eqn_idx%B%beg)%sf(i,j,0)**2/2._wp end if case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°) ! rotate by \alpha = atan(2) @@ -247,20 +247,20 @@ if (r <= 0.5_wp) then ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi) - q_prim_vf(contxb)%sf(i, j, 0) = 1._wp - q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosA - q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sinA - q_prim_vf(E_idx)%sf(i, j, 0) = 20._wp - q_prim_vf(B_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA - q_prim_vf(B_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sinA + (5._wp/sqrt(4._wp*pi))*cosA + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosA + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sinA + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sinA + (5._wp/sqrt(4._wp*pi))*cosA else ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi) - q_prim_vf(contxb)%sf(i, j, 0) = 1._wp - q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosA - q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sinA - q_prim_vf(E_idx)%sf(i, j, 0) = 1._wp - q_prim_vf(B_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA - q_prim_vf(B_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sinA + (5._wp/sqrt(4._wp*pi))*cosA + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosA + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sinA + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp + q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sinA + (5._wp/sqrt(4._wp*pi))*cosA end if ! v^z and B^z remain zero by default case (270) ! 2D extrusion of 1D profile from external data @@ -270,16 +270,16 @@ ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses ! geometry 2 if (patch_id == 1) then - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%E)%sf(i, j, & & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) & & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0) - q_prim_vf(contxb + 0)%sf(i, j, & + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & & 0) = 1.0*(1.0 - (1.0/1.0)*(5.0/(2.0*pi))*(5.0/(8.0*1.0*(1.4 + 1.0)*pi))*exp(2.0*1.0*(1.0 - (x_cc(i) & & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4 - q_prim_vf(momxb + 0)%sf(i, j, & + q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, & & 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) & & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)) - q_prim_vf(momxb + 1)%sf(i, j, & + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, & & 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1) & & %x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)) end if @@ -287,22 +287,23 @@ ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses ! geometry 2 if (patch_id == 2) then - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%E)%sf(i, j, & & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1)) - q_prim_vf(contxb + 0)%sf(i, j, & + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.4)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1)) end if case (282) ! Zero-circulation vortex ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses ! geometry 2 if (patch_id == 2) then - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%E)%sf(i, j, & & 0) = 101325*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1.4/(1.4 - 1)) - q_prim_vf(contxb + 0)%sf(i, j, & + q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, & & 0) = 1*(1 - 0.5*(1.4 - 1)*(0.1/0.3)**2*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))))**(1/(1.4 - 1)) - q_prim_vf(momxb + 0)%sf(i, j, & + q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, & & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))) - q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, & + & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2))) end if case default if (proc_rank == 0) then diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp index ec63047d72..6f4be25f56 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -84,18 +84,18 @@ if (alph > 1._wp - eps) alph = 1._wp - eps if (y_cc(j) > intH) then - q_prim_vf(advxb)%sf(i, j, k) = alph - q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph - q_prim_vf(contxb)%sf(i, j, k) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhoL - q_prim_vf(E_idx)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph + q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoH + q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhoL + q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) else - q_prim_vf(advxb)%sf(i, j, k) = alph - q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph - q_prim_vf(contxb)%sf(i, j, k) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhoL + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph + q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoH + q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhoL pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(eqn_idx%E)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) h = 0.0_wp @@ -103,11 +103,11 @@ amp = patch_icpp(patch_id)%a(2) intH = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) if (x_cc(i) > intH) then - q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) - q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) - q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres - q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) - q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1) + q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2) end if case (302) ! 3D Jet with IGR ux_th = 10*sqrt(1.4*0.4) @@ -126,19 +126,19 @@ rcut = f_cut_on(r - r_th, eps_smooth) xcut = f_cut_on(x_cc(i), eps_smooth) - q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am - q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp - q_prim_vf(momxe)%sf(i, j, k) = 0._wp + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp if (num_fluids == 1) then - q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am else - q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps - q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k) - q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)) end if - q_prim_vf(E_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am + q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am case (303) ! 3D Multijet eps_smooth = 3.0_wp ux_th = 10*sqrt(1.4*0.4) @@ -152,19 +152,19 @@ rcut = rcut_arr(j, k) xcut = f_cut_on(x_cc(i), eps_smooth) - q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am - q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp - q_prim_vf(momxe)%sf(i, j, k) = 0._wp + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp if (num_fluids == 1) then - q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am else - q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps - q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k) - q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) + q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps + q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)) end if - q_prim_vf(E_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am + q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am case (370) ! 3D extrusion of 2D profile from external data ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain @: HardcodedReadValues() @@ -173,10 +173,10 @@ ! geometry 9 Mach = 0.1 if (patch_id == 1) then - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%E)%sf(i, j, & & k) = 101325 + (Mach**2*376.636429464809**2/16)*(cos(2*x_cc(i)/1) + cos(2*y_cc(j)/1))*(cos(2*z_cc(k)/1) + 2) - q_prim_vf(momxb + 0)%sf(i, j, k) = Mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1) - q_prim_vf(momxb + 1)%sf(i, j, k) = -Mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1) + q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, k) = Mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = -Mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1) end if case default call s_int_to_str(patch_id, iStr) diff --git a/src/common/include/ExtrusionHardcodedIC.fpp b/src/common/include/ExtrusionHardcodedIC.fpp index 3d82f60d11..762876ecc3 100644 --- a/src/common/include/ExtrusionHardcodedIC.fpp +++ b/src/common/include/ExtrusionHardcodedIC.fpp @@ -24,8 +24,8 @@ !> !> **Data Assignment:** !> - Populates q_prim_vf primitive variable arrays with file data -!> - Handles momentum component indexing with special treatment for momxe -!> - Sets momxe component to zero for 2D/3D cases +!> - Handles momentum component indexing with special treatment for eqn_idx%mom%end +!> - Sets eqn_idx%mom%end component to zero for 2D/3D cases !> !> **State Management:** !> - Uses files_loaded flag to prevent redundant file operations @@ -177,18 +177,18 @@ case (2) idx = i + 1 + global_offset_x - index_x do f = 1, sys_size - 1 - jump = merge(1, 0, f >= momxe) + jump = merge(1, 0, f >= eqn_idx%mom%end) q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f) end do - q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp case (3) idx = i + 1 + global_offset_x - index_x idy = j + 1 + global_offset_y - index_y do f = 1, sys_size - 1 - jump = merge(1, 0, f >= momxe) + jump = merge(1, 0, f >= eqn_idx%mom%end) q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f) end do - q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp + q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp end select #:enddef diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 2f4edc1ec4..3f881c544a 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -344,13 +344,13 @@ contains if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !< bc_x%beg do j = 1, buff_size - do i = 1, contxe + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(j - 1, k, l) end do - q_prim_vf(momxb)%sf(-j, k, l) = -q_prim_vf(momxb)%sf(j - 1, k, l) + q_prim_vf(eqn_idx%mom%beg)%sf(-j, k, l) = -q_prim_vf(eqn_idx%mom%beg)%sf(j - 1, k, l) - do i = momxb + 1, sys_size + do i = eqn_idx%mom%beg + 1, sys_size q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(j - 1, k, l) end do @@ -362,7 +362,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xibeg)%sf(-j, k, l) = -q_prim_vf(xibeg)%sf(j - 1, k, l) + q_prim_vf(eqn_idx%xi%beg)%sf(-j, k, l) = -q_prim_vf(eqn_idx%xi%beg)%sf(j - 1, k, l) end if end do @@ -378,13 +378,13 @@ contains end if else !< bc_x%end do j = 1, buff_size - do i = 1, contxe + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m - (j - 1), k, l) end do - q_prim_vf(momxb)%sf(m + j, k, l) = -q_prim_vf(momxb)%sf(m - (j - 1), k, l) + q_prim_vf(eqn_idx%mom%beg)%sf(m + j, k, l) = -q_prim_vf(eqn_idx%mom%beg)%sf(m - (j - 1), k, l) - do i = momxb + 1, sys_size + do i = eqn_idx%mom%beg + 1, sys_size q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m - (j - 1), k, l) end do @@ -396,7 +396,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xibeg)%sf(m + j, k, l) = -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) + q_prim_vf(eqn_idx%xi%beg)%sf(m + j, k, l) = -q_prim_vf(eqn_idx%xi%beg)%sf(m - (j - 1), k, l) end if end do if (qbmm .and. .not. polytropic .and. present(pb_in) .and. present(mv_in)) then @@ -413,13 +413,13 @@ contains else if (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg do j = 1, buff_size - do i = 1, momxb + do i = 1, eqn_idx%mom%beg q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l) end do - q_prim_vf(momxb + 1)%sf(k, -j, l) = -q_prim_vf(momxb + 1)%sf(k, j - 1, l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l) - do i = momxb + 2, sys_size + do i = eqn_idx%mom%beg + 2, sys_size q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l) end do @@ -431,7 +431,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xibeg + 1)%sf(k, -j, l) = -q_prim_vf(xibeg + 1)%sf(k, j - 1, l) + q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, j - 1, l) end if end do @@ -447,13 +447,13 @@ contains end if else !< bc_y%end do j = 1, buff_size - do i = 1, momxb + do i = 1, eqn_idx%mom%beg q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n - (j - 1), l) end do - q_prim_vf(momxb + 1)%sf(k, n + j, l) = -q_prim_vf(momxb + 1)%sf(k, n - (j - 1), l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, n + j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, n - (j - 1), l) - do i = momxb + 2, sys_size + do i = eqn_idx%mom%beg + 2, sys_size q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n - (j - 1), l) end do @@ -465,7 +465,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xibeg + 1)%sf(k, n + j, l) = -q_prim_vf(xibeg + 1)%sf(k, n - (j - 1), l) + q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, n + j, l) = -q_prim_vf(eqn_idx%xi%beg + 1)%sf(k, n - (j - 1), l) end if end do @@ -483,13 +483,13 @@ contains else if (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg do j = 1, buff_size - do i = 1, momxb + 1 + do i = 1, eqn_idx%mom%beg + 1 q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1) end do - q_prim_vf(momxe)%sf(k, l, -j) = -q_prim_vf(momxe)%sf(k, l, j - 1) + q_prim_vf(eqn_idx%mom%end)%sf(k, l, -j) = -q_prim_vf(eqn_idx%mom%end)%sf(k, l, j - 1) - do i = E_idx, sys_size + do i = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1) end do @@ -501,7 +501,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xiend)%sf(k, l, -j) = -q_prim_vf(xiend)%sf(k, l, j - 1) + q_prim_vf(eqn_idx%xi%end)%sf(k, l, -j) = -q_prim_vf(eqn_idx%xi%end)%sf(k, l, j - 1) end if end do @@ -517,13 +517,13 @@ contains end if else !< bc_z%end do j = 1, buff_size - do i = 1, momxb + 1 + do i = 1, eqn_idx%mom%beg + 1 q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p - (j - 1)) end do - q_prim_vf(momxe)%sf(k, l, p + j) = -q_prim_vf(momxe)%sf(k, l, p - (j - 1)) + q_prim_vf(eqn_idx%mom%end)%sf(k, l, p + j) = -q_prim_vf(eqn_idx%mom%end)%sf(k, l, p - (j - 1)) - do i = E_idx, sys_size + do i = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p - (j - 1)) end do @@ -535,7 +535,7 @@ contains end if if (hyperelasticity) then - q_prim_vf(xiend)%sf(k, l, p + j) = -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) + q_prim_vf(eqn_idx%xi%end)%sf(k, l, p + j) = -q_prim_vf(eqn_idx%xi%end)%sf(k, l, p - (j - 1)) end if end do @@ -687,27 +687,27 @@ contains do j = 1, buff_size if (z_cc(l) < pi) then - do i = 1, momxb + do i = 1, eqn_idx%mom%beg q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2)) end do - q_prim_vf(momxb + 1)%sf(k, -j, l) = -q_prim_vf(momxb + 1)%sf(k, j - 1, l + ((p + 1)/2)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l + ((p + 1)/2)) - q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l + ((p + 1)/2)) + q_prim_vf(eqn_idx%mom%end)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%end)%sf(k, j - 1, l + ((p + 1)/2)) - do i = E_idx, sys_size + do i = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2)) end do else - do i = 1, momxb + do i = 1, eqn_idx%mom%beg q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l - ((p + 1)/2)) end do - q_prim_vf(momxb + 1)%sf(k, -j, l) = -q_prim_vf(momxb + 1)%sf(k, j - 1, l - ((p + 1)/2)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, j - 1, l - ((p + 1)/2)) - q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l - ((p + 1)/2)) + q_prim_vf(eqn_idx%mom%end)%sf(k, -j, l) = -q_prim_vf(eqn_idx%mom%end)%sf(k, j - 1, l - ((p + 1)/2)) - do i = E_idx, sys_size + do i = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, j - 1, l - ((p + 1)/2)) end do end if @@ -744,7 +744,7 @@ contains if (bc_loc == -1) then !< bc_x%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1 else q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(0, k, l) @@ -754,7 +754,7 @@ contains else !< bc_x%end do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1 else q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m, k, l) @@ -766,7 +766,7 @@ contains if (bc_loc == -1) then !< bc_y%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxb + 1) then + if (i == eqn_idx%mom%beg + 1) then q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb2 else q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, 0, l) @@ -776,7 +776,7 @@ contains else !< bc_y%end do i = 1, sys_size do j = 1, buff_size - if (i == momxb + 1) then + if (i == eqn_idx%mom%beg + 1) then q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve2 else q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n, l) @@ -788,7 +788,7 @@ contains if (bc_loc == -1) then !< bc_z%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxe) then + if (i == eqn_idx%mom%end) then q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3 else q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, 0) @@ -798,7 +798,7 @@ contains else !< bc_z%end do i = 1, sys_size do j = 1, buff_size - if (i == momxe) then + if (i == eqn_idx%mom%end) then q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3 else q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p) @@ -824,11 +824,11 @@ contains if (bc_loc == -1) then !< bc_x%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(-j, k, l) = -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb3 else q_prim_vf(i)%sf(-j, k, l) = q_prim_vf(i)%sf(0, k, l) @@ -838,11 +838,11 @@ contains else !< bc_x%end do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(m + j, k, l) = -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve3 else q_prim_vf(i)%sf(m + j, k, l) = q_prim_vf(i)%sf(m, k, l) @@ -854,11 +854,11 @@ contains if (bc_loc == -1) then !< bc_y%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, -j, l) = -q_prim_vf(i)%sf(k, j - 1, l) + 2._wp*bc_y%vb3 else q_prim_vf(i)%sf(k, -j, l) = q_prim_vf(i)%sf(k, 0, l) @@ -868,11 +868,11 @@ contains else !< bc_y%end do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, n + j, l) = -q_prim_vf(i)%sf(k, n - (j - 1), l) + 2._wp*bc_y%ve3 else q_prim_vf(i)%sf(k, n + j, l) = q_prim_vf(i)%sf(k, n, l) @@ -884,11 +884,11 @@ contains if (bc_loc == -1) then !< bc_z%beg do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, l, -j) = -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3 else q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, 0) @@ -898,11 +898,11 @@ contains else !< bc_z%end do i = 1, sys_size do j = 1, buff_size - if (i == momxb) then + if (i == eqn_idx%mom%beg) then q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve1 - else if (i == momxb + 1 .and. num_dims > 1) then + else if (i == eqn_idx%mom%beg + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve2 - else if (i == momxb + 2 .and. num_dims > 2) then + else if (i == eqn_idx%mom%beg + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, l, p + j) = -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3 else q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p) @@ -1051,15 +1051,16 @@ contains end subroutine s_qbmm_extrapolation !> Populate ghost cell buffers for the color function and its divergence used in capillary surface tension. - impure subroutine s_populate_capillary_buffers(c_divs, bc_type) + impure subroutine s_populate_capillary_buffers(c_divs, bc_type, bc) type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs type(integer_field), dimension(1:num_dims,1:2), intent(in) :: bc_type + type(bc_xyz_info), intent(in) :: bc integer :: k, l !> x-direction - if (bc_x%beg >= 0) then + if (bc%x%beg >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 1, -1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) @@ -1078,7 +1079,7 @@ contains $:END_GPU_PARALLEL_LOOP() end if - if (bc_x%end >= 0) then + if (bc%x%end >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 1, 1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) @@ -1101,7 +1102,7 @@ contains #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 !> y-direction - if (bc_y%beg >= 0) then + if (bc%y%beg >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 2, -1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) @@ -1120,7 +1121,7 @@ contains $:END_GPU_PARALLEL_LOOP() end if - if (bc_y%end >= 0) then + if (bc%y%end >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 2, 1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) @@ -1144,7 +1145,7 @@ contains #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 !> z-direction - if (bc_z%beg >= 0) then + if (bc%z%beg >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 3, -1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) @@ -1163,7 +1164,7 @@ contains $:END_GPU_PARALLEL_LOOP() end if - if (bc_z%end >= 0) then + if (bc%z%end >= 0) then call s_mpi_sendrecv_variables_buffers(c_divs, 3, 1, num_dims + 1) else $:GPU_PARALLEL_LOOP(private='[l, k]', collapse=2) diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index 66f1e97923..b8464fca6e 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -63,14 +63,15 @@ contains do z = bounds(3)%beg, bounds(3)%end do y = bounds(2)%beg, bounds(2)%end do x = bounds(1)%beg, bounds(1)%end - do eqn = chemxb, chemxe - Ys(eqn - chemxb + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + Ys(eqn - eqn_idx%species%beg + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z) end do - ! e = E - 1/2*|u|^2 cons. E_idx = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i - energy = q_cons_vf(E_idx)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) - do eqn = momxb, momxe - energy = energy - 0.5_wp*(q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z))**2._wp + ! e = E - 1/2*|u|^2 cons. eqn_idx%E = \rho E cons. eqn_idx%cont%beg = \rho (1-fluid model) cons. eqn_idx%mom%beg + ! + i = \rho u_i + energy = q_cons_vf(eqn_idx%E)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z) + do eqn = eqn_idx%mom%beg, eqn_idx%mom%end + energy = energy - 0.5_wp*(q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(eqn_idx%cont%beg)%sf(x, y, z))**2._wp end do T_in = real(q_T_sf%sf(x, y, z), kind=wp) @@ -95,12 +96,12 @@ contains do z = bounds(3)%beg, bounds(3)%end do y = bounds(2)%beg, bounds(2)%end do x = bounds(1)%beg, bounds(1)%end - do i = chemxb, chemxe - Ys(i - chemxb + 1) = q_prim_vf(i)%sf(x, y, z) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(x, y, z) end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - q_T_sf%sf(x, y, z) = q_prim_vf(E_idx)%sf(x, y, z)*mix_mol_weight/(gas_constant*q_prim_vf(1)%sf(x, y, z)) + q_T_sf%sf(x, y, z) = q_prim_vf(eqn_idx%E)%sf(x, y, z)*mix_mol_weight/(gas_constant*q_prim_vf(1)%sf(x, y, z)) end do end do end do @@ -132,21 +133,22 @@ contains do y = bounds(2)%beg, bounds(2)%end do x = bounds(1)%beg, bounds(1)%end $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe - Ys(eqn - chemxb + 1) = q_prim_qp(eqn)%sf(x, y, z) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + Ys(eqn - eqn_idx%species%beg + 1) = q_prim_qp(eqn)%sf(x, y, z) end do - rho = q_cons_qp(contxe)%sf(x, y, z) + rho = q_cons_qp(eqn_idx%cont%end)%sf(x, y, z) T = q_T_sf%sf(x, y, z) call get_net_production_rates(rho, T, Ys, omega) $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe + do eqn = eqn_idx%species%beg, eqn_idx%species%end #:if USING_AMD - omega_m = molecular_weights_nonparameter(eqn - chemxb + 1)*omega(eqn - chemxb + 1) + omega_m = molecular_weights_nonparameter(eqn - eqn_idx%species%beg + 1)*omega(eqn & + & - eqn_idx%species%beg + 1) #:else - omega_m = molecular_weights(eqn - chemxb + 1)*omega(eqn - chemxb + 1) + omega_m = molecular_weights(eqn - eqn_idx%species%beg + 1)*omega(eqn - eqn_idx%species%beg + 1) #:endif rhs_vf(eqn)%sf(x, y, z) = rhs_vf(eqn)%sf(x, y, z) + omega_m end do @@ -217,10 +219,11 @@ contains ! Extract species mass fractions $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys_L(i - chemxb + 1) = q_prim_qp(i)%sf(x, y, z) - Ys_R(i - chemxb + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) - Ys_cell(i - chemxb + 1) = 0.5_wp*(Ys_L(i - chemxb + 1) + Ys_R(i - chemxb + 1)) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x, y, z) + Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + Ys_cell(i - eqn_idx%species%beg + 1) = 0.5_wp*(Ys_L(i - eqn_idx%species%beg + 1) + Ys_R(i & + & - eqn_idx%species%beg + 1)) end do ! Calculate molecular weights and mole fractions @@ -235,8 +238,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - P_L = q_prim_qp(E_idx)%sf(x, y, z) - P_R = q_prim_qp(E_idx)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + P_L = q_prim_qp(eqn_idx%E)%sf(x, y, z) + P_R = q_prim_qp(eqn_idx%E)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) rho_L = q_prim_qp(1)%sf(x, y, z) rho_R = q_prim_qp(1)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) @@ -259,26 +262,32 @@ contains ! Calculate species properties and gradients $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end #:if USING_AMD - h_l(i - chemxb + 1) = h_l(i - chemxb + 1)*gas_constant*T_L/molecular_weights_nonparameter(i & - & - chemxb + 1) - h_r(i - chemxb + 1) = h_r(i - chemxb + 1)*gas_constant*T_R/molecular_weights_nonparameter(i & - & - chemxb + 1) + h_l(i - eqn_idx%species%beg + 1) = h_l(i - eqn_idx%species%beg + 1) & + & *gas_constant*T_L/molecular_weights_nonparameter(i - eqn_idx%species%beg + 1) + h_r(i - eqn_idx%species%beg + 1) = h_r(i - eqn_idx%species%beg + 1) & + & *gas_constant*T_R/molecular_weights_nonparameter(i - eqn_idx%species%beg + 1) #:else - h_l(i - chemxb + 1) = h_l(i - chemxb + 1)*gas_constant*T_L/molecular_weights(i - chemxb + 1) - h_r(i - chemxb + 1) = h_r(i - chemxb + 1)*gas_constant*T_R/molecular_weights(i - chemxb + 1) + h_l(i - eqn_idx%species%beg + 1) = h_l(i - eqn_idx%species%beg + 1) & + & *gas_constant*T_L/molecular_weights(i - eqn_idx%species%beg + 1) + h_r(i - eqn_idx%species%beg + 1) = h_r(i - eqn_idx%species%beg + 1) & + & *gas_constant*T_R/molecular_weights(i - eqn_idx%species%beg + 1) #:endif - Xs_cell(i - chemxb + 1) = 0.5_wp*(Xs_L(i - chemxb + 1) + Xs_R(i - chemxb + 1)) - h_k(i - chemxb + 1) = 0.5_wp*(h_l(i - chemxb + 1) + h_r(i - chemxb + 1)) - dXk_dxi(i - chemxb + 1) = (Xs_R(i - chemxb + 1) - Xs_L(i - chemxb + 1))/grid_spacing + Xs_cell(i - eqn_idx%species%beg + 1) = 0.5_wp*(Xs_L(i - eqn_idx%species%beg + 1) + Xs_R(i & + & - eqn_idx%species%beg + 1)) + h_k(i - eqn_idx%species%beg + 1) = 0.5_wp*(h_l(i - eqn_idx%species%beg + 1) + h_r(i & + & - eqn_idx%species%beg + 1)) + dXk_dxi(i - eqn_idx%species%beg + 1) = (Xs_R(i - eqn_idx%species%beg + 1) - Xs_L(i & + & - eqn_idx%species%beg + 1))/grid_spacing end do ! Calculate mixture-averaged diffusivities $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - mass_diffusivities_mixavg_Cell(i - chemxb + 1) = (mass_diffusivities_mixavg2(i - chemxb + 1) & - & + mass_diffusivities_mixavg1(i - chemxb + 1))/2.0_wp + do i = eqn_idx%species%beg, eqn_idx%species%end + mass_diffusivities_mixavg_Cell(i - eqn_idx%species%beg + 1) = (mass_diffusivities_mixavg2(i & + & - eqn_idx%species%beg + 1) + mass_diffusivities_mixavg1(i & + & - eqn_idx%species%beg + 1))/2.0_wp end do lambda_Cell = 0.5_wp*(lambda_R + lambda_L) @@ -288,36 +297,40 @@ contains Mass_Diffu_Energy = 0.0_wp $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe + do eqn = eqn_idx%species%beg, eqn_idx%species%end #:if USING_AMD - Mass_Diffu_Flux(eqn - chemxb + 1) = rho_cell*mass_diffusivities_mixavg_Cell(eqn - chemxb + 1) & - & *molecular_weights_nonparameter(eqn - chemxb + 1)/MW_cell*dXk_dxi(eqn & - & - chemxb + 1) + Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) = rho_cell*mass_diffusivities_mixavg_Cell(eqn & + & - eqn_idx%species%beg + 1)*molecular_weights_nonparameter(eqn & + & - eqn_idx%species%beg + 1)/MW_cell*dXk_dxi(eqn - eqn_idx%species%beg + 1) #:else - Mass_Diffu_Flux(eqn - chemxb + 1) = rho_cell*mass_diffusivities_mixavg_Cell(eqn - chemxb + 1) & - & *molecular_weights(eqn - chemxb + 1)/MW_cell*dXk_dxi(eqn - chemxb + 1) + Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) = rho_cell*mass_diffusivities_mixavg_Cell(eqn & + & - eqn_idx%species%beg + 1)*molecular_weights(eqn - eqn_idx%species%beg + 1) & + & /MW_cell*dXk_dxi(eqn - eqn_idx%species%beg + 1) #:endif - rho_Vic = rho_Vic + Mass_Diffu_Flux(eqn - chemxb + 1) - Mass_Diffu_Energy = Mass_Diffu_Energy + h_k(eqn - chemxb + 1)*Mass_Diffu_Flux(eqn - chemxb + 1) + rho_Vic = rho_Vic + Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) + Mass_Diffu_Energy = Mass_Diffu_Energy + h_k(eqn - eqn_idx%species%beg + 1)*Mass_Diffu_Flux(eqn & + & - eqn_idx%species%beg + 1) end do ! Apply corrections for mass conservation $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe - Mass_Diffu_Energy = Mass_Diffu_Energy - h_k(eqn - chemxb + 1)*Ys_cell(eqn - chemxb + 1)*rho_Vic - Mass_Diffu_Flux(eqn - chemxb + 1) = Mass_Diffu_Flux(eqn - chemxb + 1) - rho_Vic*Ys_cell(eqn & - & - chemxb + 1) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + Mass_Diffu_Energy = Mass_Diffu_Energy - h_k(eqn - eqn_idx%species%beg + 1)*Ys_cell(eqn & + & - eqn_idx%species%beg + 1)*rho_Vic + Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) = Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) & + & - rho_Vic*Ys_cell(eqn - eqn_idx%species%beg + 1) end do ! Add thermal conduction contribution Mass_Diffu_Energy = lambda_Cell*dT_dxi + Mass_Diffu_Energy ! Update flux arrays - flux_src_vf(E_idx)%sf(x, y, z) = flux_src_vf(E_idx)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe - flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, z) - Mass_Diffu_Flux(eqn - chemxb + 1) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, & + & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) end do end do end do @@ -346,10 +359,11 @@ contains ! Extract species mass fractions $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys_L(i - chemxb + 1) = q_prim_qp(i)%sf(x, y, z) - Ys_R(i - chemxb + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) - Ys_cell(i - chemxb + 1) = 0.5_wp*(Ys_L(i - chemxb + 1) + Ys_R(i - chemxb + 1)) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys_L(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x, y, z) + Ys_R(i - eqn_idx%species%beg + 1) = q_prim_qp(i)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + Ys_cell(i - eqn_idx%species%beg + 1) = 0.5_wp*(Ys_L(i - eqn_idx%species%beg + 1) + Ys_R(i & + & - eqn_idx%species%beg + 1)) end do ! Calculate molecular weights and mole fractions @@ -361,8 +375,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - P_L = q_prim_qp(E_idx)%sf(x, y, z) - P_R = q_prim_qp(E_idx)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) + P_L = q_prim_qp(eqn_idx%E)%sf(x, y, z) + P_R = q_prim_qp(eqn_idx%E)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) rho_L = q_prim_qp(1)%sf(x, y, z) rho_R = q_prim_qp(1)%sf(x + offsets(1), y + offsets(2), z + offsets(3)) @@ -384,8 +398,9 @@ contains ! Calculate species properties and gradients $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - dYk_dxi(i - chemxb + 1) = (Ys_R(i - chemxb + 1) - Ys_L(i - chemxb + 1))/grid_spacing + do i = eqn_idx%species%beg, eqn_idx%species%end + dYk_dxi(i - eqn_idx%species%beg + 1) = (Ys_R(i - eqn_idx%species%beg + 1) - Ys_L(i & + & - eqn_idx%species%beg + 1))/grid_spacing end do ! Calculate mixture-averaged diffusivities @@ -399,17 +414,19 @@ contains Mass_Diffu_Energy = 0.0_wp $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe - Mass_Diffu_Flux(eqn - chemxb + 1) = rho_cell*diffusivity_cell*dYk_dxi(eqn - chemxb + 1) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) = rho_cell*diffusivity_cell*dYk_dxi(eqn & + & - eqn_idx%species%beg + 1) end do Mass_Diffu_Energy = rho_cell*diffusivity_cell*dh_dxi ! Update flux arrays - flux_src_vf(E_idx)%sf(x, y, z) = flux_src_vf(E_idx)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') - do eqn = chemxb, chemxe - flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, z) - Mass_Diffu_Flux(eqn - chemxb + 1) + do eqn = eqn_idx%species%beg, eqn_idx%species%end + flux_src_vf(eqn)%sf(x, y, z) = flux_src_vf(eqn)%sf(x, y, & + & z) - Mass_Diffu_Flux(eqn - eqn_idx%species%beg + 1) end do end do end do diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 0c00de90d7..b7de058c93 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -92,6 +92,12 @@ module m_derived_types real(wp) :: R(3) end type riemann_states_vec3 + !> Lightweight beg/end pair for equation index ranges (no BC payload). + type idx_bounds_info + integer :: beg + integer :: end + end type idx_bounds_info + !> Integer bounds for variables type int_bounds_info integer :: beg @@ -108,6 +114,44 @@ module m_derived_types logical :: grcbc_in, grcbc_out, grcbc_vel_out end type int_bounds_info + !> Groups the x, y, z boundary condition begin/end codes for passing as a single argument. + type bc_xyz_info + type(int_bounds_info) :: x, y, z + end type bc_xyz_info + + !> QBMM moment index mappings - separate from bub beg/end so eqn_idx contains no allocatables. + type qbmm_idx_info + integer, dimension(:), allocatable :: rs !< R moment indices per bubble bin + integer, dimension(:), allocatable :: vs !< V moment indices per bubble bin + integer, dimension(:), allocatable :: ps !< Pressure moment indices per bubble bin + integer, dimension(:), allocatable :: ms !< Mass moment indices per bubble bin + integer, dimension(:,:), allocatable :: moms !< Moment indices for qbmm + integer, dimension(:,:,:), allocatable :: fullmom !< Full moment indices for qbmm + end type qbmm_idx_info + + !> All conserved-variable equation indices, computed at startup from model_eqns and enabled features. + !> Range indices (beg/end) use int_bounds_info; scalar indices are plain integers (0 = inactive). + !> Contains no allocatable members - safe for GPU_DECLARE as a single struct. + type eqn_idx_info + type(idx_bounds_info) :: cont !< Partial densities (continuity equations) + type(idx_bounds_info) :: mom !< Momentum components + type(idx_bounds_info) :: adv !< Volume fractions (advection equations) + type(idx_bounds_info) :: bub !< Bubble equation range (beg/end only) + type(idx_bounds_info) :: stress !< Stress tensor components + type(idx_bounds_info) :: xi !< Reference map equations + type(idx_bounds_info) :: B !< Magnetic field components + type(idx_bounds_info) :: int_en !< Internal energy equations + type(idx_bounds_info) :: species !< Chemistry species equations + integer :: E !< Energy/pressure equation + integer :: n !< Number density equation + integer :: alf !< Void fraction (scalar, model_eqns=4) + integer :: gamma !< Specific heat ratio function (model_eqns=1) + integer :: pi_inf !< Liquid stiffness function (model_eqns=1) + integer :: c !< Color function equation + integer :: damage !< Damage variable equation + integer :: psi !< Psi variable equation + end type eqn_idx_info + type bc_patch_parameters integer :: geometry integer :: type @@ -124,18 +168,6 @@ module m_derived_types real(wp) :: end end type bounds_info - !> bounds for the bubble dynamic variables - type bub_bounds_info - integer :: beg - integer :: end - integer, dimension(:), allocatable :: rs - integer, dimension(:), allocatable :: vs - integer, dimension(:), allocatable :: ps - integer, dimension(:), allocatable :: ms - integer, dimension(:,:), allocatable :: moms !< Moment indices for qbmm - integer, dimension(:,:,:), allocatable :: fullmom !< Moment indices for qbmm - end type bub_bounds_info - !> Defines parameters for a Model Patch type ic_model_parameters character(LEN=pathlen_max) :: filepath !< Path the STL file relative to case_dir. diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 21926411db..7f9131550d 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -104,53 +104,53 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! Mixture density - rho = rho + q_cons_vf(i + contxb - 1)%sf(j, k, l) + rho = rho + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l) ! Total Volume Fraction - TvF = TvF + q_cons_vf(i + advxb - 1)%sf(j, k, l) + TvF = TvF + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) end do ! calculating the total reacting mass for the phase change process. By hypothesis, this should not change ! throughout the phase-change process. - rM = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + q_cons_vf(vp + contxb - 1)%sf(j, k, l) + rM = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) ! correcting negative (reacting) mass fraction values in case they happen call s_correct_partial_densities(MCT, q_cons_vf, rM, j, k, l) ! fixing m1 and m2 AFTER correcting the partial densities. Note that these values must be stored for the phase ! change process that will happen a posteriori - m1 = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + m1 = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) - m2 = q_cons_vf(vp + contxb - 1)%sf(j, k, l) + m2 = q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) ! kinetic energy as an auxiliary variable to the calculation of the total internal energy dynE = 0.0_wp $:GPU_LOOP(parallelism='[seq]') - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end dynE = dynE + 5.0e-1_wp*q_cons_vf(i)%sf(j, k, l)**2/rho end do ! calculating the total energy that MUST be preserved throughout the pT- and pTg-relaxation procedures at each ! of the cells. The internal energy is calculated as the total energy minus the kinetic energy to preserved its ! value at sharp interfaces - rhoe = q_cons_vf(E_idx)%sf(j, k, l) - dynE + rhoe = q_cons_vf(eqn_idx%E)%sf(j, k, l) - dynE ! Calling pT-equilibrium for either finishing phase-change module, or as an IC for the pTg-equilibrium for this ! case, MFL cannot be either 0 or 1, so I chose it to be 2 call s_infinite_pt_relaxation_k(j, k, l, 2, pS, p_infpT, q_cons_vf, rhoe, TS) ! Check if pTg-equilibrium needed; only partial densities require updating - if ((relax_model == 6) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, & - & l) > mixM*rM) .and. (q_cons_vf(vp + contxb - 1)%sf(j, k, & + if ((relax_model == 6) .and. ((q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, & + & l) > mixM*rM) .and. (q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, & & l) > mixM*rM)) .and. (pS < pCr) .and. (TS < TCr)) then ! Checking if phase change is needed, by checking whether the final solution is either subcoooled liquid or ! overheated vapor. ! overheated vapor case depleting the mass of liquid - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = mixM*rM + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = mixM*rM ! transferring the total mass to vapor - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! calling pT-equilibrium for overheated vapor, which is MFL = 0 call s_infinite_pt_relaxation_k(j, k, l, 0, pSOV, p_infOV, q_cons_vf, rhoe, TSOV) @@ -159,10 +159,10 @@ contains call s_TSat(pSOV, TSatOV, TSOV) ! subcooled liquid case transferring the total mass to liquid - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! depleting the mass of vapor - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = mixM*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = mixM*rM ! calling pT-equilibrium for subcooled liquid, which is MFL = 1 call s_infinite_pt_relaxation_k(j, k, l, 1, pSSL, p_infSL, q_cons_vf, rhoe, TSSL) @@ -179,10 +179,10 @@ contains TS = TSOV ! correcting the liquid partial density - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = mixM*rM + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = mixM*rM ! correcting the vapor partial density - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM else if (TSSL < TSatSL) then ! Assigning pressure pS = pSSL @@ -191,16 +191,16 @@ contains TS = TSSL ! correcting the liquid partial density - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! correcting the vapor partial density - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = mixM*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = mixM*rM else ! returning partial pressures to what they were from the homogeneous solver liquid - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = m1 + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = m1 ! vapor - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = m2 + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = m2 ! calling the pTg-equilibrium solver call s_infinite_ptg_relaxation_k(j, k, l, pS, p_infpT, rhoe, q_cons_vf, TS) @@ -232,15 +232,16 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! volume fractions - q_cons_vf(i + advxb - 1)%sf(j, k, l) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/rhok(i) + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rhok(i) ! alpha*rho*e if (model_eqns == 3) then - q_cons_vf(i + intxb - 1)%sf(j, k, l) = q_cons_vf(i + contxb - 1)%sf(j, k, l)*ek(i) + q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, & + & l)*ek(i) end if ! Total entropy - rhos = rhos + q_cons_vf(i + contxb - 1)%sf(j, k, l)*sk(i) + rhos = rhos + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*sk(i) end do end do end do @@ -276,10 +277,10 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! sum of the total alpha*rho*cp of the system - mCP = mCP + q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*gs_min(i) + mCP = mCP + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*cvs(i)*gs_min(i) ! sum of the total alpha*rho*q of the system - mQ = mQ + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) + mQ = mQ + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) end do #:if not MFC_CASE_OPTIMIZATION and USING_AMD @@ -326,9 +327,10 @@ contains gpp = 0.0_wp; gp = 0.0_wp; hp = 0.0_wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - gp = gp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*(rhoe + pS - mQ)/(mCP*(pS + p_infpT(i))) + gp = gp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, & + & l)*cvs(i)*(rhoe + pS - mQ)/(mCP*(pS + p_infpT(i))) - gpp = gpp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + contxb - 1)%sf(j, k, & + gpp = gpp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, & & l)*cvs(i)*(p_infpT(i) - rhoe + mQ)/(mCP*(pS + p_infpT(i))**2) end do @@ -376,7 +378,8 @@ contains 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, & + if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + q_cons_vf(vp + eqn_idx%cont%beg - 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.0e-1_wp))) then ! improve this initial condition pS = 1.0e4_wp @@ -399,31 +402,31 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids ! sum of the total alpha*rho*cp of the system - mCP = mCP + q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*gs_min(i) + mCP = mCP + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*cvs(i)*gs_min(i) ! sum of the total alpha*rho*q of the system - mQ = mQ + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) + mQ = mQ + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) ! These auxiliary variables now need to be updated, as the partial densities now vary at every iteration if ((i /= lp) .and. (i /= vp)) then - mCVGP = mCVGP + q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*(gs_min(i) - 1)/(pS + ps_inf(i)) + mCVGP = mCVGP + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*cvs(i)*(gs_min(i) - 1)/(pS + ps_inf(i)) - mCVGP2 = mCVGP2 + q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*(gs_min(i) - 1)/((pS + ps_inf(i))**2) + mCVGP2 = mCVGP2 + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*cvs(i)*(gs_min(i) - 1)/((pS + ps_inf(i))**2) - mQD = mQD + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) + mQD = mQD + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) ! sum of the total alpha*rho*cp of the system - mCPD = mCPD + q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i)*gs_min(i) + mCPD = mCPD + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*cvs(i)*gs_min(i) end if end do ! calculating the (2D) Jacobian Matrix used in the solution of the pTg-quilibrium model ! mass of the reacting liquid - ml = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + ml = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) ! mass of the two participating fluids - mT = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + q_cons_vf(vp + contxb - 1)%sf(j, k, l) + mT = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) TS = 1/(mT*cvs(vp)*(gs_min(vp) - 1)/(pS + ps_inf(vp)) + ml*(cvs(lp)*(gs_min(lp) - 1)/(pS + ps_inf(lp)) - cvs(vp) & & *(gs_min(vp) - 1)/(pS + ps_inf(vp))) + mCVGP) @@ -479,10 +482,10 @@ contains DeltamP(2) = -1.0_wp*(InvJac(2, 1)*R2D(1) + InvJac(2, 2)*R2D(2)) ! updating two reacting 'masses'. Recall that inert 'masses' do not change during the phase change liquid - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + Om*DeltamP(1) + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + Om*DeltamP(1) ! gas - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = q_cons_vf(vp + contxb - 1)%sf(j, k, l) - Om*DeltamP(1) + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) - Om*DeltamP(1) ! updating pressure pS = pS + Om*DeltamP(2) @@ -491,10 +494,10 @@ contains ! the energy before and after the phase-change process. ! mass of the reacting liquid - ml = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + ml = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) ! mass of the two participating fluids - mT = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + q_cons_vf(vp + contxb - 1)%sf(j, k, l) + mT = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) TS = 1/(mT*cvs(vp)*(gs_min(vp) - 1)/(pS + ps_inf(vp)) + ml*(cvs(lp)*(gs_min(lp) - 1)/(pS + ps_inf(lp)) - cvs(vp) & & *(gs_min(vp) - 1)/(pS + ps_inf(vp))) + mCVGP) @@ -528,13 +531,13 @@ contains integer, intent(in) :: j, k, l !> @} if (rM < 0.0_wp) then - if ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) >= -1.0_wp*mixM) .and. (q_cons_vf(vp + contxb - 1)%sf(j, k, & - & l) >= -1.0_wp*mixM)) then - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = 0.0_wp + if ((q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, & + & l) >= -1.0_wp*mixM) .and. (q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) >= -1.0_wp*mixM)) then + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = 0.0_wp - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = 0.0_wp + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = 0.0_wp - rM = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + q_cons_vf(vp + contxb - 1)%sf(j, k, l) + rM = q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) end if end if @@ -542,14 +545,14 @@ contains MCT = 2*mixM ! correcting the partial densities of the reacting fluids. What to do for the nonreacting ones? - if (q_cons_vf(lp + contxb - 1)%sf(j, k, l) < 0.0_wp) then - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = MCT*rM + if (q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) < 0.0_wp) then + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = MCT*rM - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM - else if (q_cons_vf(vp + contxb - 1)%sf(j, k, l) < 0.0_wp) then - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM + else if (q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) < 0.0_wp) then + q_cons_vf(lp + eqn_idx%cont%beg - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = MCT*rM + q_cons_vf(vp + eqn_idx%cont%beg - 1)%sf(j, k, l) = MCT*rM end if end subroutine s_correct_partial_densities diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e9055e51f0..2417da1adf 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -118,7 +118,7 @@ contains if (hypoelasticity .and. present(G)) then ! Subtract elastic strain energy before computing pressure (hypoelastic model) E_e = 0._wp - do s = stress_idx%beg, stress_idx%end + do s = eqn_idx%stress%beg, eqn_idx%stress%end if (G > 0) then E_e = E_e + ((stress/rho)**2._wp)/(4._wp*G) ! Double for shear stresses @@ -159,8 +159,8 @@ contains ! Transferring the density, the specific heat ratio function and the liquid stiffness function, respectively rho = q_vf(1)%sf(i, j, k) - gamma = q_vf(gamma_idx)%sf(i, j, k) - pi_inf = q_vf(pi_inf_idx)%sf(i, j, k) + gamma = q_vf(eqn_idx%gamma)%sf(i, j, k) + pi_inf = q_vf(eqn_idx%pi_inf)%sf(i, j, k) qv = 0._wp ! keep this value nil for now. For future adjustment ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated @@ -364,7 +364,7 @@ contains if (bubbles_euler) then @:ALLOCATE(bubrs_vc(1:nb)) do i = 1, nb - bubrs_vc(i) = bub_idx%rs(i) + bubrs_vc(i) = qbmm_idx%rs(i) end do $:GPU_UPDATE(device='[bubrs_vc]') end if @@ -411,12 +411,12 @@ contains do l = idwint(3)%beg, idwint(3)%end do k = idwint(2)%beg, idwint(2)%end do j = idwint(1)%beg, idwint(1)%end - nbub_sc = qK_cons_vf(bubxb)%sf(j, k, l) + nbub_sc = qK_cons_vf(eqn_idx%bub%beg)%sf(j, k, l) $:GPU_LOOP(parallelism='[seq]') do i = 1, nb - mu = qK_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp + mu = qK_cons_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc + sig = (qK_cons_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) @@ -441,12 +441,12 @@ contains do l = idwint(3)%beg, idwint(3)%end do k = idwint(2)%beg, idwint(2)%end do j = idwint(1)%beg, idwint(1)%end - nbub_sc = qK_cons_vf(bubxb)%sf(j, k, l) + nbub_sc = qK_cons_vf(eqn_idx%bub%beg)%sf(j, k, l) $:GPU_LOOP(parallelism='[seq]') do i = 1, nb - mu = qK_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp + mu = qK_cons_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc + sig = (qK_cons_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp ! PRESTON (ISOTHERMAL) pb(j, k, l, 1, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 1, & @@ -535,32 +535,32 @@ contains if (relativity) then if (n == 0) then B(1) = Bx0 - B(2) = qK_cons_vf(B_idx%beg)%sf(j, k, l) - B(3) = qK_cons_vf(B_idx%beg + 1)%sf(j, k, l) + B(2) = qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l) + B(3) = qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l) else - B(1) = qK_cons_vf(B_idx%beg)%sf(j, k, l) - B(2) = qK_cons_vf(B_idx%beg + 1)%sf(j, k, l) - B(3) = qK_cons_vf(B_idx%beg + 2)%sf(j, k, l) + B(1) = qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l) + B(2) = qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l) + B(3) = qK_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l) end if B2 = B(1)**2 + B(2)**2 + B(3)**2 m2 = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end m2 = m2 + qK_cons_vf(i)%sf(j, k, l)**2 end do S = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, 3 - S = S + qK_cons_vf(momxb + i - 1)%sf(j, k, l)*B(i) + S = S + qK_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*B(i) end do - E = qK_cons_vf(E_idx)%sf(j, k, l) + E = qK_cons_vf(eqn_idx%E)%sf(j, k, l) D = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end D = D + qK_cons_vf(i)%sf(j, k, l) end do @@ -590,17 +590,18 @@ contains ! Recalculate pressure using converged W Ga = (W + B2)*W/sqrt((W + B2)**2*W**2 - (m2*W**2 + S**2*(2*W + B2))) - qK_prim_vf(E_idx)%sf(j, k, l) = (W - D*Ga)/((gamma_K + 1)*Ga**2) + qK_prim_vf(eqn_idx%E)%sf(j, k, l) = (W - D*Ga)/((gamma_K + 1)*Ga**2) ! Recover the other primitive variables $:GPU_LOOP(parallelism='[seq]') do i = 1, 3 - qK_prim_vf(momxb + i - 1)%sf(j, k, l) = (qK_cons_vf(momxb + i - 1)%sf(j, k, l) + (S/W)*B(i))/(W + B2) + qK_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = (qK_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, & + & l) + (S/W)*B(i))/(W + B2) end do qK_prim_vf(1)%sf(j, k, l) = D/Ga ! Hard-coded for single-component for now $:GPU_LOOP(parallelism='[seq]') - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do @@ -611,23 +612,23 @@ contains ! Reacting flow: recover density from species partial densities, compute mass fractions Y_k = rhoY_k / rho rho_K = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end rho_K = rho_K + max(0._wp, qK_cons_vf(i)%sf(j, k, l)) end do $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end qK_prim_vf(i)%sf(j, k, l) = rho_K end do $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end qK_prim_vf(i)%sf(j, k, l) = max(0._wp, qK_cons_vf(i)%sf(j, k, l)/rho_K) end do else ! Non-reacting: partial densities are directly primitive (alpha_i * rho_i) $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do end if @@ -638,7 +639,7 @@ contains ! Recover velocity from momentum: u = rho*u / rho, and accumulate dynamic pressure 0.5*rho*|u|^2 $:GPU_LOOP(parallelism='[seq]') - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end 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 + 5.e-1_wp*qK_cons_vf(i)%sf(j, k, l)*qK_prim_vf(i)%sf(j, k, l) @@ -651,7 +652,7 @@ contains if (chemistry) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_species - rhoYks(i) = qK_cons_vf(chemxb + i - 1)%sf(j, k, l) + rhoYks(i) = qK_cons_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) end do T = q_T_sf%sf(j, k, l) @@ -659,20 +660,20 @@ contains if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + qK_cons_vf(B_idx%beg)%sf(j, k, l)**2 + qK_cons_vf(B_idx%beg + 1)%sf(j, k, & - & l)**2) + pres_mag = 0.5_wp*(Bx0**2 + qK_cons_vf(eqn_idx%B%beg)%sf(j, k, & + & l)**2 + qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(qK_cons_vf(B_idx%beg)%sf(j, k, l)**2 + qK_cons_vf(B_idx%beg + 1)%sf(j, k, & - & l)**2 + qK_cons_vf(B_idx%beg + 2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, & + & l)**2 + qK_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2) end if else pres_mag = 0._wp end if - call s_compute_pressure(qK_cons_vf(E_idx)%sf(j, k, l), qK_cons_vf(alf_idx)%sf(j, k, l), dyn_pres_K, pi_inf_K, & - & gamma_K, rho_K, qv_K, rhoYks, pres, T, pres_mag=pres_mag) + call s_compute_pressure(qK_cons_vf(eqn_idx%E)%sf(j, k, l), qK_cons_vf(eqn_idx%alf)%sf(j, k, l), dyn_pres_K, & + & pi_inf_K, gamma_K, rho_K, qv_K, rhoYks, pres, T, pres_mag=pres_mag) - qK_prim_vf(E_idx)%sf(j, k, l) = pres + qK_prim_vf(eqn_idx%E)%sf(j, k, l) = pres if (chemistry) then q_T_sf%sf(j, k, l) = T @@ -685,31 +686,31 @@ contains nRtmp(i) = qK_cons_vf(bubrs_vc(i))%sf(j, k, l) end do - vftmp = qK_cons_vf(alf_idx)%sf(j, k, l) + vftmp = qK_cons_vf(eqn_idx%alf)%sf(j, k, l) if (qbmm) then ! Get nb (constant across all R0 bins) - nbub_sc = qK_cons_vf(bubxb)%sf(j, k, l) + nbub_sc = qK_cons_vf(eqn_idx%bub%beg)%sf(j, k, l) ! Convert cons to prim $:GPU_LOOP(parallelism='[seq]') - do i = bubxb, bubxe + do i = eqn_idx%bub%beg, eqn_idx%bub%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/nbub_sc end do ! Need to keep track of nb in the primitive variable list (converted back to true value before output) #ifdef MFC_SIMULATION - qK_prim_vf(bubxb)%sf(j, k, l) = qK_cons_vf(bubxb)%sf(j, k, l) + qK_prim_vf(eqn_idx%bub%beg)%sf(j, k, l) = qK_cons_vf(eqn_idx%bub%beg)%sf(j, k, l) #endif else if (adv_n) then - qK_prim_vf(n_idx)%sf(j, k, l) = qK_cons_vf(n_idx)%sf(j, k, l) - nbub_sc = qK_prim_vf(n_idx)%sf(j, k, l) + qK_prim_vf(eqn_idx%n)%sf(j, k, l) = qK_cons_vf(eqn_idx%n)%sf(j, k, l) + nbub_sc = qK_prim_vf(eqn_idx%n)%sf(j, k, l) else call s_comp_n_from_cons(vftmp, nRtmp, nbub_sc, weight) end if $:GPU_LOOP(parallelism='[seq]') - do i = bubxb, bubxe + do i = eqn_idx%bub%beg, eqn_idx%bub%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/nbub_sc end do end if @@ -717,30 +718,30 @@ contains if (mhd) then $:GPU_LOOP(parallelism='[seq]') - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do end if if (elasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do end if if (hypoelasticity) then - if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(damage_idx)%sf(j, k, l)), 0._wp) + if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp) $:GPU_LOOP(parallelism='[seq]') - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end ! subtracting elastic contribution for pressure calculation if (G_K > verysmall) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, k, & + qK_prim_vf(eqn_idx%E)%sf(j, k, l) = qK_prim_vf(eqn_idx%E)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, k, & & l)**2._wp)/(4._wp*G_K))/gamma_K ! Double for shear stresses if (any(i == shear_indices)) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, k, & - & l)**2._wp)/(4._wp*G_K))/gamma_K + qK_prim_vf(eqn_idx%E)%sf(j, k, l) = qK_prim_vf(eqn_idx%E)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, & + & k, l)**2._wp)/(4._wp*G_K))/gamma_K end if end if end do @@ -748,25 +749,25 @@ contains if (hyperelasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = xibeg, xiend + do i = eqn_idx%xi%beg, eqn_idx%xi%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do end if if (.not. igr .or. num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do end if if (surface_tension) then - qK_prim_vf(c_idx)%sf(j, k, l) = qK_cons_vf(c_idx)%sf(j, k, l) + qK_prim_vf(eqn_idx%c)%sf(j, k, l) = qK_cons_vf(eqn_idx%c)%sf(j, k, l) end if - if (cont_damage) qK_prim_vf(damage_idx)%sf(j, k, l) = qK_cons_vf(damage_idx)%sf(j, k, l) + if (cont_damage) qK_prim_vf(eqn_idx%damage)%sf(j, k, l) = qK_cons_vf(eqn_idx%damage)%sf(j, k, l) - if (hyper_cleaning) qK_prim_vf(psi_idx)%sf(j, k, l) = qK_cons_vf(psi_idx)%sf(j, k, l) + if (hyper_cleaning) qK_prim_vf(eqn_idx%psi)%sf(j, k, l) = qK_cons_vf(eqn_idx%psi)%sf(j, k, l) #ifdef MFC_POST_PROCESS if (bubbles_lagrange) qK_prim_vf(beta_idx)%sf(j, k, l) = qK_cons_vf(beta_idx)%sf(j, k, l) #endif @@ -819,7 +820,7 @@ contains if (.not. igr .or. num_fluids > 1) then ! Transferring the advection equation(s) variable(s) - do i = adv_idx%beg, adv_idx%end + do i = eqn_idx%adv%beg, eqn_idx%adv%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do end if @@ -827,50 +828,52 @@ contains if (relativity) then if (n == 0) then B(1) = Bx0 - B(2) = q_prim_vf(B_idx%beg)%sf(j, k, l) - B(3) = q_prim_vf(B_idx%beg + 1)%sf(j, k, l) + B(2) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) + B(3) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l) else - B(1) = q_prim_vf(B_idx%beg)%sf(j, k, l) - B(2) = q_prim_vf(B_idx%beg + 1)%sf(j, k, l) - B(3) = q_prim_vf(B_idx%beg + 2)%sf(j, k, l) + B(1) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) + B(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l) + B(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l) end if v2 = 0._wp - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end v2 = v2 + q_prim_vf(i)%sf(j, k, l)**2 end do if (v2 >= 1._wp) call s_mpi_abort('Error: v squared > 1 in s_convert_primitive_to_conservative_variables') Ga = 1._wp/sqrt(1._wp - v2) - h = 1._wp + (gamma + 1)*q_prim_vf(E_idx)%sf(j, k, l)/rho ! Assume perfect gas for now + h = 1._wp + (gamma + 1)*q_prim_vf(eqn_idx%E)%sf(j, k, l)/rho ! Assume perfect gas for now B2 = 0._wp - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end B2 = B2 + q_prim_vf(i)%sf(j, k, l)**2 end do if (n == 0) B2 = B2 + Bx0**2 vdotB = 0._wp do i = 1, 3 - vdotB = vdotB + q_prim_vf(momxb + i - 1)%sf(j, k, l)*B(i) + vdotB = vdotB + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*B(i) end do - do i = 1, contxe + do i = 1, eqn_idx%cont%end q_cons_vf(i)%sf(j, k, l) = Ga*q_prim_vf(i)%sf(j, k, l) end do - do i = momxb, momxe - q_cons_vf(i)%sf(j, k, l) = (rho*h*Ga**2 + B2)*q_prim_vf(i)%sf(j, k, l) - vdotB*B(i - momxb + 1) + do i = eqn_idx%mom%beg, eqn_idx%mom%end + q_cons_vf(i)%sf(j, k, l) = (rho*h*Ga**2 + B2)*q_prim_vf(i)%sf(j, k, & + & l) - vdotB*B(i - eqn_idx%mom%beg + 1) end do - q_cons_vf(E_idx)%sf(j, k, l) = rho*h*Ga**2 - q_prim_vf(E_idx)%sf(j, k, l) + 0.5_wp*(B2 + v2*B2 - vdotB**2) + q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*h*Ga**2 - q_prim_vf(eqn_idx%E)%sf(j, k, & + & l) + 0.5_wp*(B2 + v2*B2 - vdotB**2) ! Remove rest energy - do i = 1, contxe - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) - q_cons_vf(i)%sf(j, k, l) + do i = 1, eqn_idx%cont%end + q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) - q_cons_vf(i)%sf(j, k, l) end do - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do @@ -878,7 +881,7 @@ contains end if ! Transferring the continuity equation(s) variable(s) - do i = 1, contxe + do i = 1, eqn_idx%cont%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do @@ -886,69 +889,70 @@ contains dyn_pres = 0._wp ! Computing momenta and dynamic pressure from velocity - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)*q_prim_vf(i)%sf(j, k, l)/2._wp end do if (chemistry) then ! Reacting mixture: compute conserved energy from species mass fractions and temperature - do i = chemxb, chemxe - Ys(i - chemxb + 1) = q_prim_vf(i)%sf(j, k, l) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(j, k, l) q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - T = q_prim_vf(E_idx)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho) + T = q_prim_vf(eqn_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho) call get_mixture_energy_mass(T, Ys, e_mix) - q_cons_vf(E_idx)%sf(j, k, l) = dyn_pres + rho*e_mix + q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + rho*e_mix else ! Computing the energy from the pressure if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + q_prim_vf(B_idx%beg)%sf(j, k, l)**2 + q_prim_vf(B_idx%beg + 1)%sf(j, & - & k, l)**2) + pres_mag = 0.5_wp*(Bx0**2 + q_prim_vf(eqn_idx%B%beg)%sf(j, k, & + & l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(q_prim_vf(B_idx%beg)%sf(j, k, l)**2 + q_prim_vf(B_idx%beg + 1)%sf(j, k, & - & l)**2 + q_prim_vf(B_idx%beg + 2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, & + & k, l)**2 + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2) end if ! MHD energy includes magnetic pressure contribution - q_cons_vf(E_idx)%sf(j, k, l) = gamma*q_prim_vf(E_idx)%sf(j, k, l) + dyn_pres + pres_mag + pi_inf + qv + q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, & + & l) + dyn_pres + pres_mag + pi_inf + qv else if ((model_eqns /= 4) .and. (bubbles_euler .neqv. .true.)) then ! Five-equation model (Allaire et al. JCP 2002): E = Gamma*p + 0.5*rho*|u|^2 + pi_inf + qv - q_cons_vf(E_idx)%sf(j, k, l) = gamma*q_prim_vf(E_idx)%sf(j, k, l) + dyn_pres + pi_inf + qv + q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + dyn_pres + pi_inf + qv else if ((model_eqns /= 4) .and. (bubbles_euler)) then ! Bubble-augmented energy with void fraction correction - q_cons_vf(E_idx)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(alf_idx)%sf(j, k, & - & l))*(gamma*q_prim_vf(E_idx)%sf(j, k, l) + pi_inf) + q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, & + & l))*(gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + pi_inf) else ! Four-equation model (Kapila et al. PoF 2001): Tait EOS, no conserved energy variable - q_cons_vf(E_idx)%sf(j, k, l) = 0._wp + q_cons_vf(eqn_idx%E)%sf(j, k, l) = 0._wp end if end if ! Six-equation model (Saurel et al. JCP 2009): compute per-phase internal energies if (model_eqns == 3) then do i = 1, num_fluids - q_cons_vf(i + intxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, & - & l)*(gammas(i)*q_prim_vf(E_idx)%sf(j, k, & - & l) + pi_infs(i)) + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) + q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l)*(gammas(i)*q_prim_vf(eqn_idx%E)%sf(j, k, & + & l) + pi_infs(i)) + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) end do end if if (bubbles_euler) then ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3} do i = 1, nb - Rtmp(i) = q_prim_vf(bub_idx%rs(i))%sf(j, k, l) + Rtmp(i) = q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l) end do if (.not. qbmm) then if (adv_n) then - q_cons_vf(n_idx)%sf(j, k, l) = q_prim_vf(n_idx)%sf(j, k, l) - nbub = q_prim_vf(n_idx)%sf(j, k, l) + q_cons_vf(eqn_idx%n)%sf(j, k, l) = q_prim_vf(eqn_idx%n)%sf(j, k, l) + nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l) else - call s_comp_n_from_prim(real(q_prim_vf(alf_idx)%sf(j, k, l), kind=wp), Rtmp, nbub, weight) + call s_comp_n_from_prim(real(q_prim_vf(eqn_idx%alf)%sf(j, k, l), kind=wp), Rtmp, nbub, weight) end if else ! Initialize R3 averaging over R0 and R directions @@ -958,37 +962,37 @@ contains R3tmp = R3tmp + weight(i)*0.5_wp*(Rtmp(i) - sigR)**3._wp end do ! Initialize nb - nbub = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*R3tmp) + nbub = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*R3tmp) end if - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub end do end if if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do end if if (elasticity) then ! adding the elastic contribution Multiply \tau to \rho \tau - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do end if if (hypoelasticity) then - if (cont_damage) G = G*max((1._wp - q_prim_vf(damage_idx)%sf(j, k, l)), 0._wp) - do i = strxb, strxe + if (cont_damage) G = G*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp) + do i = eqn_idx%stress%beg, eqn_idx%stress%end ! adding elastic contribution if (G > verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & + q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & & l)**2._wp)/(4._wp*G) ! Double for shear stresses if (any(i == shear_indices)) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & + q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & & l)**2._wp)/(4._wp*G) end if end if @@ -998,18 +1002,18 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then ! Multiply \xi to \rho \xi - do i = xibeg, xiend + do i = eqn_idx%xi%beg, eqn_idx%xi%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do end if if (surface_tension) then - q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) + q_cons_vf(eqn_idx%c)%sf(j, k, l) = q_prim_vf(eqn_idx%c)%sf(j, k, l) end if - if (cont_damage) q_cons_vf(damage_idx)%sf(j, k, l) = q_prim_vf(damage_idx)%sf(j, k, l) + if (cont_damage) q_cons_vf(eqn_idx%damage)%sf(j, k, l) = q_prim_vf(eqn_idx%damage)%sf(j, k, l) - if (hyper_cleaning) q_cons_vf(psi_idx)%sf(j, k, l) = q_prim_vf(psi_idx)%sf(j, k, l) + if (hyper_cleaning) q_cons_vf(eqn_idx%psi)%sf(j, k, l) = q_prim_vf(eqn_idx%psi)%sf(j, k, l) end do end do end do @@ -1024,11 +1028,11 @@ contains !> Convert primitive variables to Eulerian flux variables. subroutine s_convert_primitive_to_flux_variables(qK_prim_vf, FK_vf, FK_src_vf, is1, is2, is3, s2b, s3b) - integer, intent(in) :: s2b, s3b - real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: qK_prim_vf - real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: FK_vf - real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,advxb:), intent(inout) :: FK_src_vf - type(int_bounds_info), intent(in) :: is1, is2, is3 + integer, intent(in) :: s2b, s3b + real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: qK_prim_vf + real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: FK_vf + real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,eqn_idx%adv%beg:), intent(inout) :: FK_src_vf + type(int_bounds_info), intent(in) :: is1, is2, is3 ! Partial densities, density, velocity, pressure, energy, advection variables, the specific heat ratio and liquid stiffness ! functions, the shear and volume Reynolds numbers and the Weber numbers @@ -1071,18 +1075,18 @@ contains do k = is2b, is2e do j = is1b, is1e $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho_K(i) = qK_prim_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe - alpha_K(i - E_idx) = qK_prim_vf(j, k, l, i) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + alpha_K(i - eqn_idx%E) = qK_prim_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - vel_K(i) = qK_prim_vf(j, k, l, contxe + i) + vel_K(i) = qK_prim_vf(j, k, l, eqn_idx%cont%end + i) end do vel_K_sum = 0._wp @@ -1091,7 +1095,7 @@ contains vel_K_sum = vel_K_sum + vel_K(i)**2._wp end do - pres_K = qK_prim_vf(j, k, l, E_idx) + pres_K = qK_prim_vf(j, k, l, eqn_idx%E) if (elasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, alpha_rho_K, & & Re_K, G_K, Gs_vc) @@ -1103,8 +1107,8 @@ contains if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Y_K(i - chemxb + 1) = qK_prim_vf(j, k, l, i) + do i = eqn_idx%species%beg, eqn_idx%species%end + Y_K(i - eqn_idx%species%beg + 1) = qK_prim_vf(j, k, l, i) end do ! Computing the energy from the internal energy of the mixture call get_mixture_molecular_weight(Y_k, mix_mol_weight) @@ -1119,41 +1123,43 @@ contains ! mass flux, this should be \alpha_i \rho_i u_i $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end FK_vf(j, k, l, i) = alpha_rho_K(i)*vel_K(dir_idx(1)) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - FK_vf(j, k, l, contxe + dir_idx(i)) = rho_K*vel_K(dir_idx(1))*vel_K(dir_idx(i)) + pres_K*dir_flg(dir_idx(i)) + FK_vf(j, k, l, & + & eqn_idx%cont%end + dir_idx(i)) = rho_K*vel_K(dir_idx(1))*vel_K(dir_idx(i)) & + & + pres_K*dir_flg(dir_idx(i)) end do ! energy flux, u(E+p) - FK_vf(j, k, l, E_idx) = vel_K(dir_idx(1))*(E_K + pres_K) + FK_vf(j, k, l, eqn_idx%E) = vel_K(dir_idx(1))*(E_K + pres_K) ! Species advection Flux, \rho*u*Y if (chemistry) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_species - FK_vf(j, k, l, i - 1 + chemxb) = vel_K(dir_idx(1))*(rho_K*Y_K(i)) + FK_vf(j, k, l, i - 1 + eqn_idx%species%beg) = vel_K(dir_idx(1))*(rho_K*Y_K(i)) end do end if if (riemann_solver == 1 .or. riemann_solver == 4) then $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end FK_vf(j, k, l, i) = 0._wp - FK_src_vf(j, k, l, i) = alpha_K(i - E_idx) + FK_src_vf(j, k, l, i) = alpha_K(i - eqn_idx%E) end do else ! Could be bubbles_euler! $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe - FK_vf(j, k, l, i) = vel_K(dir_idx(1))*alpha_K(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + FK_vf(j, k, l, i) = vel_K(dir_idx(1))*alpha_K(i - eqn_idx%E) end do $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end FK_src_vf(j, k, l, i) = vel_K(dir_idx(1)) end do end if @@ -1180,24 +1186,24 @@ contains real(wp) :: alpha_K_sum if (num_fluids == 1) then - alpha_rho_K(1) = q_vf(contxb)%sf(k, l, r) + alpha_rho_K(1) = q_vf(eqn_idx%cont%beg)%sf(k, l, r) if (igr .or. bubbles_euler) then alpha_K(1) = 1._wp else - alpha_K(1) = q_vf(advxb)%sf(k, l, r) + alpha_K(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r) end if else if (igr) then do i = 1, num_fluids - 1 alpha_rho_K(i) = q_vf(i)%sf(k, l, r) - alpha_K(i) = q_vf(advxb + i - 1)%sf(k, l, r) + alpha_K(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r) end do alpha_rho_K(num_fluids) = q_vf(num_fluids)%sf(k, l, r) alpha_K(num_fluids) = 1._wp - sum(alpha_K(1:num_fluids - 1)) else do i = 1, num_fluids alpha_rho_K(i) = q_vf(i)%sf(k, l, r) - alpha_K(i) = q_vf(advxb + i - 1)%sf(k, l, r) + alpha_K(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r) end do end if end if @@ -1212,7 +1218,7 @@ contains alpha_K = alpha_K/max(alpha_K_sum, 1.e-16_wp) end if - if (num_fluids == 1 .and. bubbles_euler) alpha_K(1) = q_vf(advxb)%sf(k, l, r) + if (num_fluids == 1 .and. bubbles_euler) alpha_K(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r) end subroutine s_compute_species_fraction diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index bdec65ba74..3e7057ea09 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -247,15 +247,15 @@ contains if (relativity .and. (rho_wrt .or. prim_vars_wrt)) dbvars = dbvars + 1 if (relativity .and. (rho_wrt .or. cons_vars_wrt)) dbvars = dbvars + 1 - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (mom_wrt(i) .or. cons_vars_wrt) dbvars = dbvars + 1 end do - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (vel_wrt(i) .or. prim_vars_wrt) dbvars = dbvars + 1 end do - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (flux_wrt(i)) dbvars = dbvars + 1 end do @@ -1179,8 +1179,8 @@ contains do k = 0, p do j = 0, n do i = 0, m - if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) + if (q_prim_vf(eqn_idx%E + 2)%sf(i, j, k) > maxalph_loc) then + maxalph_loc = q_prim_vf(eqn_idx%E + 2)%sf(i, j, k) end if end do end do @@ -1200,10 +1200,10 @@ contains thres = 0.9_wp*maxalph_glb do k = 0, n do j = 0, m - axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) - ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) + axp = q_prim_vf(eqn_idx%E + 2)%sf(j + 1, k, cent) + axm = q_prim_vf(eqn_idx%E + 2)%sf(j, k, cent) + ayp = q_prim_vf(eqn_idx%E + 2)%sf(j, k + 1, cent) + aym = q_prim_vf(eqn_idx%E + 2)%sf(j, k, cent) if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) .or. (ayp > thres .and. aym < thres) & & .or. (ayp < thres .and. aym > thres)) then if (counter == 0) then @@ -1283,18 +1283,18 @@ contains gamma = 0._wp pi_inf = 0._wp qv = 0._wp - pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(gammas(2)*pres)*dV + pres = q_prim_vf(eqn_idx%E)%sf(i, j, k) + Egint = Egint + q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*(gammas(2)*pres)*dV do s = 1, num_vels vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - Egk = Egk + 0.5_wp*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV - Elk = Elk + 0.5_wp*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + Egk = Egk + 0.5_wp*q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5_wp*q_prim_vf(eqn_idx%E + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV if (abs(vel(s)) > maxvel) then maxvel = abs(vel(s)) end if end do - do l = 1, adv_idx%end - E_idx - adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + do l = 1, eqn_idx%adv%end - eqn_idx%E + adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) gamma = gamma + adv(l)*gammas(l) pi_inf = pi_inf + adv(l)*pi_infs(l) rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) @@ -1312,7 +1312,7 @@ contains Vl = Vl + adv(1)*dV Vb = Vb + adv(2)*dV pres_av = pres_av + adv(1)*pres*dV - Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV + Et = Et + q_cons_vf(eqn_idx%E)%sf(i, j, k)*dV end do end do end do diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index ccd1af2ff8..9676e44396 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -108,13 +108,13 @@ contains do j = -offset_y%beg, n + offset_y%end do i = -offset_x%beg, m + offset_x%end if (alt_soundspeed .neqv. .true.) then - q_sf(i, j, k) = (((gamma_sf(i, j, k) + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + pi_inf_sf(i, j, & + q_sf(i, j, k) = (((gamma_sf(i, j, k) + 1._wp)*q_prim_vf(eqn_idx%E)%sf(i, j, k) + pi_inf_sf(i, j, & & k))/(gamma_sf(i, j, k)*rho_sf(i, j, k))) else - blkmod1 = ((gammas(1) + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + pi_infs(2))/gammas(2) - q_sf(i, j, k) = (1._wp/(rho_sf(i, j, k)*(q_prim_vf(adv_idx%beg)%sf(i, j, & - & k)/blkmod1 + (1._wp - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) + blkmod1 = ((gammas(1) + 1._wp)*q_prim_vf(eqn_idx%E)%sf(i, j, k) + pi_infs(1))/gammas(1) + blkmod2 = ((gammas(2) + 1._wp)*q_prim_vf(eqn_idx%E)%sf(i, j, k) + pi_infs(2))/gammas(2) + q_sf(i, j, k) = (1._wp/(rho_sf(i, j, k)*(q_prim_vf(eqn_idx%adv%beg)%sf(i, j, & + & k)/blkmod1 + (1._wp - q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k))/blkmod2))) end if if (mixture_err .and. q_sf(i, j, k) < 0._wp) then @@ -144,28 +144,28 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end if (i == 1) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - q_prim_vf(adv_idx%beg)%sf(j - 1, k, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j - 1, k, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j + 2, k, l) - q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j + 2, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if else if (i == 2) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - q_prim_vf(adv_idx%beg)%sf(j, k - 1, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k - 1, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j, k + 2, l) - q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 2, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if else - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - q_prim_vf(adv_idx%beg)%sf(j, k, l - 1) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l - 1) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j, k, l + 2) - q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 2) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if end if @@ -219,11 +219,11 @@ contains do r = -fd_number, fd_number if (grid_geometry == 3) then q_sf(j, k, l) = q_sf(j, k, l) + 1._wp/y_cc(k)*(fd_coeff_y(r, & - & k)*y_cc(r + k)*q_prim_vf(mom_idx%end)%sf(j, r + k, l) - fd_coeff_z(r, & - & l)*q_prim_vf(mom_idx%beg + 1)%sf(j, k, r + l)) + & k)*y_cc(r + k)*q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, l) - fd_coeff_z(r, & + & l)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, r + l)) else - q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_y(r, k)*q_prim_vf(mom_idx%end)%sf(j, r + k, & - & l) - fd_coeff_z(r, l)*q_prim_vf(mom_idx%beg + 1)%sf(j, k, r + l) + q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_y(r, k)*q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, & + & l) - fd_coeff_z(r, l)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, r + l) end if end do end do @@ -237,11 +237,11 @@ contains do r = -fd_number, fd_number if (grid_geometry == 3) then - q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)/y_cc(k)*q_prim_vf(mom_idx%beg)%sf(j, k, & - & r + l) - fd_coeff_x(r, j)*q_prim_vf(mom_idx%end)%sf(r + j, k, l) + q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)/y_cc(k)*q_prim_vf(eqn_idx%mom%beg)%sf(j, k, & + & r + l) - fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%end)%sf(r + j, k, l) else - q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)*q_prim_vf(mom_idx%beg)%sf(j, k, & - & r + l) - fd_coeff_x(r, j)*q_prim_vf(mom_idx%end)%sf(r + j, k, l) + q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_z(r, l)*q_prim_vf(eqn_idx%mom%beg)%sf(j, k, & + & r + l) - fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%end)%sf(r + j, k, l) end if end do end do @@ -254,8 +254,8 @@ contains q_sf(j, k, l) = 0._wp do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_x(r, j)*q_prim_vf(mom_idx%beg + 1)%sf(r + j, k, & - & l) - fd_coeff_y(r, k)*q_prim_vf(mom_idx%beg)%sf(j, r + k, l) + q_sf(j, k, l) = q_sf(j, k, l) + fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(r + j, k, & + & l) - fd_coeff_y(r, k)*q_prim_vf(eqn_idx%mom%beg)%sf(j, r + k, l) end do end do end do @@ -286,13 +286,13 @@ contains do jj = 1, 3 ! d()/dx q_jacobian_sf(jj, 1) = q_jacobian_sf(jj, 1) + fd_coeff_x(r, & - & j)*q_prim_vf(mom_idx%beg + jj - 1)%sf(r + j, k, l) + & j)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(r + j, k, l) ! d()/dy - q_jacobian_sf(jj, 2) = q_jacobian_sf(jj, 2) + fd_coeff_y(r, k)*q_prim_vf(mom_idx%beg + jj - 1)%sf(j, & - & r + k, l) + q_jacobian_sf(jj, 2) = q_jacobian_sf(jj, 2) + fd_coeff_y(r, & + & k)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, r + k, l) ! d()/dz - q_jacobian_sf(jj, 3) = q_jacobian_sf(jj, 3) + fd_coeff_z(r, l)*q_prim_vf(mom_idx%beg + jj - 1)%sf(j, & - & k, r + l) + q_jacobian_sf(jj, 3) = q_jacobian_sf(jj, 3) + fd_coeff_z(r, & + & l)*q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, k, r + l) end do end do @@ -363,11 +363,11 @@ contains do r = -fd_number, fd_number do i = 1, 3 ! d()/dx - vgt(i, 1) = vgt(i, 1) + fd_coeff_x(r, j)*q_prim_vf(mom_idx%beg + i - 1)%sf(r + j, k, l) + vgt(i, 1) = vgt(i, 1) + fd_coeff_x(r, j)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(r + j, k, l) ! d()/dy - vgt(i, 2) = vgt(i, 2) + fd_coeff_y(r, k)*q_prim_vf(mom_idx%beg + i - 1)%sf(j, r + k, l) + vgt(i, 2) = vgt(i, 2) + fd_coeff_y(r, k)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, r + k, l) ! d()/dz - vgt(i, 3) = vgt(i, 3) + fd_coeff_z(r, l)*q_prim_vf(mom_idx%beg + i - 1)%sf(j, k, r + l) + vgt(i, 3) = vgt(i, 3) + fd_coeff_z(r, l)*q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, r + l) end do end do @@ -495,9 +495,9 @@ contains do j = -offset_x%beg, m + offset_x%end q_sf(j, k, l) = 0._wp - do i = 1, adv_idx%end - E_idx - q_sf(j, k, l) = q_sf(j, k, l) - schlieren_alpha(i)*q_cons_vf(i + E_idx)%sf(j, k, l)*gm_rho_sf(j, k, & - & l)/gm_rho_max(1) + do i = 1, eqn_idx%adv%end - eqn_idx%E + q_sf(j, k, l) = q_sf(j, k, l) - schlieren_alpha(i)*q_cons_vf(i + eqn_idx%E)%sf(j, k, l)*gm_rho_sf(j, & + & k, l)/gm_rho_max(1) end do end do end do diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 0530c31081..9dec6f9434 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -112,24 +112,9 @@ module m_global_parameters integer :: avg_state !< Average state evaluation method !> @name Annotations of the structure, i.e. the organization, of the state vectors !> @{ - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of energy equation - integer :: n_idx !< Index of number density - integer :: beta_idx !< Index of lagrange bubbles beta - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: alf_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: B_idx !< Indexes of first and last magnetic field eqns. - type(int_bounds_info) :: stress_idx !< Indices of elastic stresses - type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of color function - type(int_bounds_info) :: species_idx !< Indexes of first & last concentration eqns. - integer :: damage_idx !< Index of damage state variable (D) for continuum damage model - integer :: psi_idx !< Index of hyperbolic cleaning state variable for MHD + type(eqn_idx_info) :: eqn_idx !< All conserved-variable equation index ranges and scalars. + type(qbmm_idx_info) :: qbmm_idx !< QBMM moment index mappings. + integer :: beta_idx !< Index of lagrange bubbles beta !> @} ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). Stands for "InDices With BUFFer". @@ -277,18 +262,6 @@ module m_global_parameters logical :: surface_tension !> @} - !> @name Index variables used for m_variables_conversion - !> @{ - integer :: momxb, momxe - integer :: advxb, advxe - integer :: contxb, contxe - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe - integer :: xibeg, xiend - integer :: chemxb, chemxe - !> @} - !> @name Lagrangian bubbles !> @{ logical :: bubbles_lagrange @@ -511,46 +484,46 @@ contains ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end ! Volume Fraction Model (5-equation model) else if (model_eqns == 2) then ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 if (igr) then ! Volume fractions are stored in the indices immediately following the energy equation. IGR tracks a total of (N-1) - ! volume fractions for N fluids, hence the "-1" in adv_idx%end. If num_fluids = 1 then adv_idx%end < adv_idx%beg, - ! which skips all loops over the volume fractions since there is no volume fraction to track - adv_idx%beg = E_idx + 1 ! Alpha for fluid 1 - adv_idx%end = E_idx + num_fluids - 1 + ! volume fractions for N fluids, hence the "-1" in eqn_idx%adv%end. If num_fluids = 1 then eqn_idx%adv%end < + ! eqn_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track + eqn_idx%adv%beg = eqn_idx%E + 1 ! Alpha for fluid 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids - 1 else ! Volume fractions are stored in the indices immediately following the energy equation. WENO/MUSCL + Riemann tracks - ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in adv_idx%end - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in eqn_idx%adv%end + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (qbmm) then @@ -558,34 +531,34 @@ contains end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = sys_size + 1 if (qbmm) then - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) + allocate (qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - bub_idx%moms(i, j) = bub_idx%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%rs(i) = bub_idx%moms(i, 2) - bub_idx%vs(i) = bub_idx%moms(i, 3) + qbmm_idx%rs(i) = qbmm_idx%moms(i, 2) + qbmm_idx%vs(i) = qbmm_idx%moms(i, 3) end do else do i = 1, nb @@ -595,12 +568,12 @@ contains fac = 2 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (polytropic .neqv. .true.) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do end if @@ -612,51 +585,51 @@ contains end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = eqn_idx%B%end end if ! Volume Fraction Model (6-equation model) else if (model_eqns == 3) then ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - alf_idx = 1 ! dummy, cannot actually have a void fraction + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%int_en%beg = eqn_idx%adv%end + 1 + eqn_idx%int_en%end = eqn_idx%adv%end + num_fluids + sys_size = eqn_idx%int_en%end + eqn_idx%alf = 1 ! dummy, cannot actually have a void fraction else if (model_eqns == 4) then - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 ! num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - alf_idx = adv_idx%end - sys_size = alf_idx ! adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 ! num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg ! one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + sys_size = eqn_idx%alf ! eqn_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (polytropic .neqv. .true.) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) allocate (weight(nb), R0(nb)) do i = 1, nb @@ -666,12 +639,12 @@ contains fac = 2 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (polytropic .neqv. .true.) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do @@ -692,24 +665,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = sys_size + 1 + eqn_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2,1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1,1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2,1:2) = shear_indices((/1, 3/)) @@ -719,42 +692,42 @@ contains end if if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%xi%beg = sys_size + 1 + eqn_idx%xi%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + sys_size = eqn_idx%xi%end + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage else - damage_idx = dflt_int + eqn_idx%damage = dflt_int end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi else - psi_idx = dflt_int + eqn_idx%psi = dflt_int end if end if if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = sys_size + 1 + eqn_idx%species%end = sys_size + num_species + sys_size = eqn_idx%species%end else - species_idx%beg = 1 - species_idx%end = 1 + eqn_idx%species%beg = 1 + eqn_idx%species%end = 1 end if if (output_partial_domain) then @@ -766,23 +739,6 @@ contains z_output_idx%end = 0 end if - momxb = mom_idx%beg - momxe = mom_idx%end - advxb = adv_idx%beg - advxe = adv_idx%end - contxb = cont_idx%beg - contxe = cont_idx%end - bubxb = bub_idx%beg - bubxe = bub_idx%end - strxb = stress_idx%beg - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end - xibeg = xi_idx%beg - xiend = xi_idx%end - chemxb = species_idx%beg - chemxe = species_idx%end - #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*nnode)) @@ -934,6 +890,11 @@ contains integer :: i + if (bubbles_euler) then + deallocate (qbmm_idx%rs, qbmm_idx%vs, qbmm_idx%ps, qbmm_idx%ms) + if (qbmm) deallocate (qbmm_idx%moms) + end if + ! Deallocating the grid variables for the x-coordinate direction deallocate (x_cc, x_cb, dx) diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index 3436634d14..48fe35abc1 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -276,9 +276,9 @@ contains varname(:) = ' ' end if - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (mom_wrt(i) .or. cons_vars_wrt) then - q_sf(:,:,:) = q_cons_vf(i + cont_idx%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(i + eqn_idx%cont%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'mom', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -286,9 +286,9 @@ contains end if end do - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (vel_wrt(i) .or. prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(i + cont_idx%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(i + eqn_idx%cont%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'vel', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -299,7 +299,7 @@ contains if (chemistry) then do i = 1, num_species if (chem_wrt_Y(i) .or. prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(chemxb + i - 1)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,A)') 'Y_', trim(species_names(i)) call s_write_variable_to_formatted_database_file(varname, t_step) @@ -316,7 +316,7 @@ contains end if end if - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (flux_wrt(i)) then call s_derive_flux_limiter(i, q_prim_vf, q_sf) @@ -328,7 +328,7 @@ contains end do if (E_wrt .or. cons_vars_wrt) then - q_sf(:,:,:) = q_cons_vf(E_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A)') 'E' call s_write_variable_to_formatted_database_file(varname, t_step) @@ -338,7 +338,7 @@ contains if (model_eqns == 3) then do i = 1, num_fluids if (alpha_rho_e_wrt(i) .or. cons_vars_wrt) then - q_sf = q_cons_vf(i + intxb - 1)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf = q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'alpha_rho_e', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -351,7 +351,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(mom_idx%beg)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), 0._wp) + data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), & + & 0._wp) end do end do end do @@ -363,8 +364,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(mom_idx%beg + 1)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), & - & 0._wp) + data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, & + & l), 0._wp) end do end do end do @@ -376,8 +377,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(mom_idx%beg + 2)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), & - & 0._wp) + data_cmplx(j + 1, k + 1, l + 1) = cmplx(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, & + & l), 0._wp) end do end do end do @@ -453,21 +454,21 @@ contains end if if (mhd .and. prim_vars_wrt) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end q_sf(:,:,:) = q_prim_vf(i)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) ! 1D: output By, Bz if (n == 0) then - if (i == B_idx%beg) then + if (i == eqn_idx%B%beg) then write (varname, '(A)') 'By' else write (varname, '(A)') 'Bz' end if ! 2D/3D: output Bx, By, Bz else - if (i == B_idx%beg) then + if (i == eqn_idx%B%beg) then write (varname, '(A)') 'Bx' - else if (i == B_idx%beg + 1) then + else if (i == eqn_idx%B%beg + 1) then write (varname, '(A)') 'By' else write (varname, '(A)') 'Bz' @@ -480,9 +481,9 @@ contains end if if (elasticity) then - do i = 1, stress_idx%end - stress_idx%beg + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 if (prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(i - 1 + stress_idx%beg)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(i - 1 + eqn_idx%stress%beg)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'tau', i call s_write_variable_to_formatted_database_file(varname, t_step) end if @@ -491,9 +492,9 @@ contains end if if (hyperelasticity) then - do i = 1, xiend - xibeg + 1 + do i = 1, eqn_idx%xi%end - eqn_idx%xi%beg + 1 if (prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(i - 1 + xibeg)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(i - 1 + eqn_idx%xi%beg)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) end if @@ -502,7 +503,7 @@ contains end if if (cont_damage) then - q_sf(:,:,:) = q_cons_vf(damage_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(eqn_idx%damage)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A)') 'damage_state' call s_write_variable_to_formatted_database_file(varname, t_step) @@ -510,7 +511,7 @@ contains end if if (hyper_cleaning) then - q_sf = q_cons_vf(psi_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf = q_cons_vf(eqn_idx%psi)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A)') 'psi' call s_write_variable_to_formatted_database_file(varname, t_step) @@ -518,7 +519,7 @@ contains end if if (pres_wrt .or. prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(E_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A)') 'pres' call s_write_variable_to_formatted_database_file(varname, t_step) @@ -528,7 +529,7 @@ contains if (((model_eqns == 2) .and. (bubbles_euler .neqv. .true.)) .or. (model_eqns == 3)) then do i = 1, num_fluids - 1 if (alpha_wrt(i) .or. (cons_vars_wrt .or. prim_vars_wrt)) then - q_sf(:,:,:) = q_cons_vf(i + E_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(i + eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'alpha', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -543,13 +544,13 @@ contains do i = x_beg, x_end q_sf(i, j, k) = 1._wp do l = 1, num_fluids - 1 - q_sf(i, j, k) = q_sf(i, j, k) - q_cons_vf(E_idx + l)%sf(i, j, k) + q_sf(i, j, k) = q_sf(i, j, k) - q_cons_vf(eqn_idx%E + l)%sf(i, j, k) end do end do end do end do else - q_sf(:,:,:) = q_cons_vf(adv_idx%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(eqn_idx%adv%end)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) end if write (varname, '(A,I0)') 'alpha', num_fluids call s_write_variable_to_formatted_database_file(varname, t_step) @@ -596,11 +597,11 @@ contains do k = -offset_z%beg, p + offset_z%end do j = -offset_y%beg, n + offset_y%end do i = -offset_x%beg, m + offset_x%end - do l = 1, adv_idx%end - E_idx - adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + do l = 1, eqn_idx%adv%end - eqn_idx%E + adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) end do - pres = q_prim_vf(E_idx)%sf(i, j, k) + pres = q_prim_vf(eqn_idx%E)%sf(i, j, k) H = ((gamma_sf(i, j, k) + 1._wp)*pres + pi_inf_sf(i, j, k) + qv_sf(i, j, k))/rho_sf(i, j, k) @@ -675,16 +676,16 @@ contains end if if (cf_wrt) then - q_sf(:,:,:) = q_cons_vf(c_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(eqn_idx%c)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I0)') 'color_function' call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' end if if (bubbles_euler) then - do i = adv_idx%beg, adv_idx%end + do i = eqn_idx%adv%beg, eqn_idx%adv%end q_sf(:,:,:) = q_cons_vf(i)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) - write (varname, '(A,I0)') 'alpha', i - E_idx + write (varname, '(A,I0)') 'alpha', i - eqn_idx%E call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' end do @@ -693,7 +694,7 @@ contains if (bubbles_euler) then ! nR do i = 1, nb - q_sf(:,:,:) = q_cons_vf(bub_idx%rs(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(qbmm_idx%rs(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I3.3)') 'nR', i call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' @@ -701,7 +702,7 @@ contains ! nRdot do i = 1, nb - q_sf(:,:,:) = q_cons_vf(bub_idx%vs(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(qbmm_idx%vs(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I3.3)') 'nV', i call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' @@ -709,7 +710,7 @@ contains if ((polytropic .neqv. .true.) .and. (.not. qbmm)) then ! nP do i = 1, nb - q_sf(:,:,:) = q_cons_vf(bub_idx%ps(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(qbmm_idx%ps(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I3.3)') 'nP', i call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' @@ -717,7 +718,7 @@ contains ! nM do i = 1, nb - q_sf(:,:,:) = q_cons_vf(bub_idx%ms(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(qbmm_idx%ms(i))%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A,I3.3)') 'nM', i call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' @@ -726,7 +727,7 @@ contains ! number density if (adv_n) then - q_sf(:,:,:) = q_cons_vf(n_idx)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(eqn_idx%n)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) write (varname, '(A)') 'n' call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index bd0c4ef884..5e250310b7 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -95,19 +95,19 @@ contains q_prim_vf(1)%sf(j, k, l) = eta*patch_icpp(patch_id)%rho + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg q_prim_vf(i + 1)%sf(j, k, l) = 1._wp/q_prim_vf(1)%sf(j, k, & & l)*(eta*patch_icpp(patch_id)%rho*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*patch_icpp(smooth_patch_id) & & %rho*patch_icpp(smooth_patch_id)%vel(i)) end do - q_prim_vf(gamma_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%gamma + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma + q_prim_vf(eqn_idx%gamma)%sf(j, k, l) = eta*patch_icpp(patch_id)%gamma + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma - q_prim_vf(E_idx)%sf(j, k, l) = 1._wp/q_prim_vf(gamma_idx)%sf(j, k, & + q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(eqn_idx%gamma)%sf(j, k, & & l)*(eta*patch_icpp(patch_id)%gamma*patch_icpp(patch_id)%pres + (1._wp - eta)*patch_icpp(smooth_patch_id) & & %gamma*patch_icpp(smooth_patch_id)%pres) - q_prim_vf(pi_inf_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%pi_inf + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf + q_prim_vf(eqn_idx%pi_inf)%sf(j, k, l) = eta*patch_icpp(patch_id)%pi_inf + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf if (chemistry) then block @@ -116,15 +116,15 @@ contains sum = 0._wp do i = 1, num_species term = eta*patch_icpp(patch_id)%Y(i) + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i) - q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term + q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = term sum = sum + term end do sum = max(sum, verysmall) do i = 1, num_species - q_prim_vf(chemxb + i - 1)%sf(j, k, l) = q_prim_vf(chemxb + i - 1)%sf(j, k, l)/sum - Ys(i) = q_prim_vf(chemxb + i - 1)%sf(j, k, l) + q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)/sum + Ys(i) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) end do end block end if @@ -147,13 +147,13 @@ contains B_tait = ps_inf(1) if (j < 177) then - q_prim_vf(E_idx)%sf(j, k, l) = 0.5_wp*q_prim_vf(E_idx)%sf(j, k, l) + q_prim_vf(eqn_idx%E)%sf(j, k, l) = 0.5_wp*q_prim_vf(eqn_idx%E)%sf(j, k, l) end if if (qbmm) then do i = 1, nb - q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, & - & l)*((p0 - bub_pp%pv)/(q_prim_vf(E_idx)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp) + q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, & + & k, l)*((p0 - bub_pp%pv)/(q_prim_vf(eqn_idx%E)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp) end do end if @@ -161,44 +161,44 @@ contains if (qbmm) then do i = 1, nb - R3bar = R3bar + weight(i)*0.5_wp*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*0.5_wp*(q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp end do else do i = 1, nb if (polytropic) then - R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*2)%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*(q_prim_vf(eqn_idx%bub%beg + (i - 1)*2)%sf(j, k, l))**3._wp else - R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*4)%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*(q_prim_vf(eqn_idx%bub%beg + (i - 1)*4)%sf(j, k, l))**3._wp end if end do end if - n0 = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*R3bar) + n0 = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*R3bar) - ratio = ((1._wp + B_tait)/(q_prim_vf(E_idx)%sf(j, k, l) + B_tait))**(1._wp/n_tait) + ratio = ((1._wp + B_tait)/(q_prim_vf(eqn_idx%E)%sf(j, k, l) + B_tait))**(1._wp/n_tait) - nH = n0/((1._wp - q_prim_vf(alf_idx)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*R3bar) + nH = n0/((1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*R3bar) vfH = (4._wp*pi/3._wp)*nH*R3bar rhoH = (1._wp - vfH)/ratio - deno = 1._wp - (1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/rhoH + deno = 1._wp - (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))/rhoH if (f_approx_equal(deno, 0._wp)) then 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 = (q_prim_vf(eqn_idx%E)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))/deno velH = sqrt(velH) velH = velH*deno end if - do i = cont_idx%beg, cont_idx%end + do i = eqn_idx%cont%beg, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = rhoH end do - do i = mom_idx%beg, mom_idx%end + do i = eqn_idx%mom%beg, eqn_idx%mom%end q_prim_vf(i)%sf(j, k, l) = velH end do - q_prim_vf(alf_idx)%sf(j, k, l) = vfH + q_prim_vf(eqn_idx%alf)%sf(j, k, l) = vfH end subroutine s_perturb_primitive @@ -246,37 +246,37 @@ contains if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf)/alf_sum%sf + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf end do end if call s_convert_to_mixture_variables(q_prim_vf, j, k, l, orig_rho, orig_gamma, orig_pi_inf, orig_qv) if (.not. igr .or. num_fluids > 1) then - do i = adv_idx%beg, adv_idx%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - eqn_idx%E) end do end if if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf)/alf_sum%sf + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf end do end if if (model_eqns /= 4) then - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha_rho(i) end do end if @@ -285,26 +285,26 @@ contains & patch_icpp(patch_id)%pi_inf, patch_icpp(patch_id)%qv) if (model_eqns /= 4) then - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha_rho(i) end do end if if (.not. igr .or. num_fluids > 1) then - do i = adv_idx%beg, adv_idx%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - eqn_idx%E) end do end if if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf)/alf_sum%sf + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf end do end if @@ -315,26 +315,26 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) 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) = 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) = muR**2 + (sigR*R0ref)**2 - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) - q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**2 + q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 + q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) + q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**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) = 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) = 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*sqrt(p0ref/rho0ref))**2 + q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**2 end if else - q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = muR - q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l) = muR + q_prim_vf(qbmm_idx%vs(i))%sf(j, k, l) = muV if (.not. polytropic) then - q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 - q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 + q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if end do @@ -343,9 +343,9 @@ contains ! Initialize number density R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*R3bar) + q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if end if @@ -353,29 +353,32 @@ contains & patch_icpp(smooth_patch_id)%gamma, patch_icpp(smooth_patch_id)%pi_inf, & & patch_icpp(smooth_patch_id)%qv) - q_prim_vf(E_idx)%sf(j, k, l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(E_idx)) + q_prim_vf(eqn_idx%E)%sf(j, k, l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(eqn_idx%E)) if (.not. igr .or. num_fluids > 1) then - do i = adv_idx%beg, adv_idx%end - q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha(i - E_idx) + (1._wp - eta)*orig_prim_vf(i) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha(i - eqn_idx%E) + (1._wp - eta)*orig_prim_vf(i) end do end if if (mhd) then if (n == 0) then ! 1D: By, Bz - q_prim_vf(B_idx%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(B_idx%beg) - q_prim_vf(B_idx%beg + 1)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(B_idx%beg + 1) + q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg) + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz - q_prim_vf(B_idx%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(B_idx%beg) - q_prim_vf(B_idx%beg + 1)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(B_idx%beg + 1) - q_prim_vf(B_idx%beg + 2)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(B_idx%beg + 2) + q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg) + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1) + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 2) end if end if if (elasticity) then - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, & - & l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + do i = 1, (eqn_idx%stress%end - eqn_idx%stress%beg) + 1 + q_prim_vf(i + eqn_idx%stress%beg - 1)%sf(j, k, & + & l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%stress%beg - 1)) end do end if @@ -397,25 +400,25 @@ contains ! assigning the reference map to the q_prim vector field do i = 1, num_dims - q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + (1._wp - eta)*orig_prim_vf(i + xibeg - 1) + q_prim_vf(i + eqn_idx%xi%beg - 1)%sf(j, k, l) = eta*xi_cart(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%xi%beg - 1) end do end if if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf)/alf_sum%sf + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf end do end if if (model_eqns /= 4) then ! mixture density is an input - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha_rho(i) + (1._wp - eta)*orig_prim_vf(i) end do else @@ -425,15 +428,15 @@ contains lit_gamma = gs_min(1) ! \rho = (( p_l + pi_inf)/( p_ref + pi_inf))**(1/little_gam) * rhoref(1-alf) - q_prim_vf(1)%sf(j, k, l) = (((q_prim_vf(E_idx)%sf(j, k, & - & l) + pi_inf)/(pref + pi_inf))**(1/lit_gamma))*rhoref*(1 - q_prim_vf(alf_idx)%sf(j, k, l)) + q_prim_vf(1)%sf(j, k, l) = (((q_prim_vf(eqn_idx%E)%sf(j, k, & + & l) + pi_inf)/(pref + pi_inf))**(1/lit_gamma))*rhoref*(1 - q_prim_vf(eqn_idx%alf)%sf(j, k, l)) end if call s_convert_to_mixture_variables(q_prim_vf, j, k, l, rho, gamma, pi_inf, qv) - do i = 1, E_idx - mom_idx%beg - q_prim_vf(i + cont_idx%end)%sf(j, k, & - & l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + cont_idx%end)) + do i = 1, eqn_idx%E - eqn_idx%mom%beg + q_prim_vf(i + eqn_idx%cont%end)%sf(j, k, & + & l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + eqn_idx%cont%end)) end do if (chemistry) then @@ -443,7 +446,7 @@ contains sum = 0._wp do i = 1, num_species term = eta*patch_icpp(patch_id)%Y(i) + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i) - q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term + q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = term sum = sum + term end do @@ -452,23 +455,23 @@ contains end if do i = 1, num_species - q_prim_vf(chemxb + i - 1)%sf(j, k, l) = q_prim_vf(chemxb + i - 1)%sf(j, k, l)/sum - Ys(i) = q_prim_vf(chemxb + i - 1)%sf(j, k, l) + q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)/sum + Ys(i) = q_prim_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l) end do end block end if ! Set streamwise velocity to hyperbolic tangent function of y if (mixlayer_vel_profile) then - q_prim_vf(1 + cont_idx%end)%sf(j, k, & + q_prim_vf(1 + eqn_idx%cont%end)%sf(j, k, & & l) = (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) + (1._wp - eta)*orig_prim_vf(1 & - & + cont_idx%end)) + & + eqn_idx%cont%end)) end if ! Set partial pressures to mixture pressure for the 6-eqn model if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end - q_prim_vf(i)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) + do i = eqn_idx%int_en%beg, eqn_idx%int_en%end + q_prim_vf(i)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, l) end do end if @@ -479,27 +482,27 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) 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) = 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) = muR**2 + (sigR*R0ref)**2 - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) - q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**2 + q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 + q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) + q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**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) = 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) = 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*sqrt(p0ref/rho0ref))**2 + q_prim_vf(qbmm_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(qbmm_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(qbmm_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(qbmm_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(qbmm_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + (sigV*sqrt(p0ref/rho0ref))**2 end if else - q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = muR - q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muV + q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l) = muR + q_prim_vf(qbmm_idx%vs(i))%sf(j, k, l) = muV if (.not. polytropic) then - q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 - q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 + q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if end do @@ -508,37 +511,37 @@ contains ! Initialize number density R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*R3bar) + q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if end if if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf)/alf_sum%sf + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf)/alf_sum%sf end do end if if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm)) then do i = 1, nb - if (f_is_default(real(q_prim_vf(bub_idx%ps(i))%sf(j, k, l), kind=wp))) then - q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = pb0(i) + if (f_is_default(real(q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l), kind=wp))) then + q_prim_vf(qbmm_idx%ps(i))%sf(j, k, l) = pb0(i) end if - if (f_is_default(real(q_prim_vf(bub_idx%ms(i))%sf(j, k, l), kind=wp))) then - q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = mass_v0(i) + if (f_is_default(real(q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l), kind=wp))) then + q_prim_vf(qbmm_idx%ms(i))%sf(j, k, l) = mass_v0(i) end if end do end if if (surface_tension) then - q_prim_vf(c_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(c_idx) + q_prim_vf(eqn_idx%c)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(eqn_idx%c) end if if (1._wp - eta < 1.e-16_wp) patch_id_fp(j, k, l) = patch_id diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index ab3257a77b..6b37933e89 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -168,7 +168,7 @@ contains do j = 0, m if (chemistry) then do c = 1, num_species - rhoYks(c) = q_cons_vf(chemxb + c - 1)%sf(j, 0, 0) + rhoYks(c) = q_cons_vf(eqn_idx%species%beg + c - 1)%sf(j, 0, 0) end do end if @@ -176,53 +176,54 @@ contains lit_gamma = 1._wp/gamma + 1._wp - if ((i >= chemxb) .and. (i <= chemxe)) then + if ((i >= eqn_idx%species%beg) .and. (i <= eqn_idx%species%end)) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/rho - else if (((i >= cont_idx%beg) .and. (i <= cont_idx%end)) .or. ((i >= adv_idx%beg) .and. (i <= adv_idx%end) & - & ) .or. ((i >= chemxb) .and. (i <= chemxe))) then + else if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & + & .and. (i <= eqn_idx%adv%end)) .or. ((i >= eqn_idx%species%beg) .and. (i <= eqn_idx%species%end) & + & )) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) - else if (i == mom_idx%beg) then ! u - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg)%sf(j, 0, 0)/rho - else if (i == stress_idx%beg) then ! tau_e - write (2, FMT) x_cb(j), q_cons_vf(stress_idx%beg)%sf(j, 0, 0)/rho - else if (i == E_idx) then ! p + else if (i == eqn_idx%mom%beg) then ! u + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%stress%beg) then ! tau_e + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%stress%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%E) then ! p if (mhd) then - pres_mag = 0.5_wp*(Bx0**2 + q_cons_vf(B_idx%beg)%sf(j, 0, 0)**2 + q_cons_vf(B_idx%beg + 1)%sf(j, & - & 0, 0)**2) + pres_mag = 0.5_wp*(Bx0**2 + q_cons_vf(eqn_idx%B%beg)%sf(j, 0, & + & 0)**2 + q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)**2) end if - call s_compute_pressure(q_cons_vf(E_idx)%sf(j, 0, 0), q_cons_vf(alf_idx)%sf(j, 0, 0), & - & 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, 0, 0)**2._wp)/rho, pi_inf, gamma, rho, & - & qv, rhoYks, pres, T, pres_mag=pres_mag) + call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j, 0, 0), q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), & + & 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)**2._wp)/rho, pi_inf, gamma, & + & rho, qv, rhoYks, pres, T, pres_mag=pres_mag) write (2, FMT) x_cb(j), pres else if (mhd) then - if (i == mom_idx%beg + 1) then ! v - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg + 1)%sf(j, 0, 0)/rho - else if (i == mom_idx%beg + 2) then ! w - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg + 2)%sf(j, 0, 0)/rho - else if (i == B_idx%beg) then ! By - write (2, FMT) x_cb(j), q_cons_vf(B_idx%beg)%sf(j, 0, 0)/rho - else if (i == B_idx%beg + 1) then ! Bz - write (2, FMT) x_cb(j), q_cons_vf(B_idx%beg + 1)%sf(j, 0, 0)/rho + if (i == eqn_idx%mom%beg + 1) then ! v + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, 0, 0)/rho + else if (i == eqn_idx%mom%beg + 2) then ! w + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, 0, 0)/rho + else if (i == eqn_idx%B%beg) then ! By + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%B%beg + 1) then ! Bz + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)/rho end if - else if ((i >= bub_idx%beg) .and. (i <= bub_idx%end) .and. bubbles_euler) then + else if ((i >= eqn_idx%bub%beg) .and. (i <= eqn_idx%bub%end) .and. bubbles_euler) then if (qbmm) then - nbub = q_cons_vf(bubxb)%sf(j, 0, 0) + nbub = q_cons_vf(eqn_idx%bub%beg)%sf(j, 0, 0) else if (adv_n) then - nbub = q_cons_vf(n_idx)%sf(j, 0, 0) + nbub = q_cons_vf(eqn_idx%n)%sf(j, 0, 0) else do k = 1, nb - nRtmp(k) = q_cons_vf(bub_idx%rs(k))%sf(j, 0, 0) + nRtmp(k) = q_cons_vf(qbmm_idx%rs(k))%sf(j, 0, 0) end do - call s_comp_n_from_cons(real(q_cons_vf(alf_idx)%sf(j, 0, 0), kind=wp), nRtmp, nbub, weight) + call s_comp_n_from_cons(real(q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), kind=wp), nRtmp, nbub, weight) end if end if write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/nbub - else if (i == n_idx .and. adv_n .and. bubbles_euler) then + else if (i == eqn_idx%n .and. adv_n .and. bubbles_euler) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) - else if (i == damage_idx) then + else if (i == eqn_idx%damage) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) end if end do @@ -576,7 +577,7 @@ contains character(len=15) :: temp character(LEN=1), dimension(3), parameter :: coord = (/'x', 'y', 'z'/) logical :: dir_check - integer :: i + integer :: i, iu integer :: m_ds, n_ds, p_ds if (parallel_io .neqv. .true.) then @@ -611,46 +612,47 @@ contains s_write_data_files => s_write_parallel_data_files end if - open (1, FILE='indices.dat', STATUS='unknown') + open (newunit=iu, file='indices.dat', status='unknown') - write (1, '(A)') "Warning: The creation of file is currently experimental." - write (1, '(A)') "This file may contain errors and not support all features." + write (iu, '(A)') "Warning: The creation of file is currently experimental." + write (iu, '(A)') "This file may contain errors and not support all features." - write (1, '(A3,A20,A20)') "#", "Conservative", "Primitive" - write (1, '(A)') " " - do i = contxb, contxe - write (temp, '(I0)') i - contxb + 1 - write (1, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "} \rho_{" // trim(temp) // "}", & + write (iu, '(A3,A20,A20)') "#", "Conservative", "Primitive" + write (iu, '(A)') " " + do i = eqn_idx%cont%beg, eqn_idx%cont%end + write (temp, '(I0)') i - eqn_idx%cont%beg + 1 + write (iu, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "} \rho_{" // trim(temp) // "}", & & "\alpha_{" // trim(temp) // "} \rho" end do - do i = momxb, momxe - write (1, '(I3,A20,A20)') i, "\rho u_" // coord(i - momxb + 1), "u_" // coord(i - momxb + 1) + do i = eqn_idx%mom%beg, eqn_idx%mom%end + write (iu, '(I3,A20,A20)') i, "\rho u_" // coord(i - eqn_idx%mom%beg + 1), "u_" // coord(i - eqn_idx%mom%beg + 1) end do - do i = E_idx, E_idx - write (1, '(I3,A20,A20)') i, "\rho U", "p" - end do - do i = advxb, advxe - write (temp, '(I0)') i - contxb + 1 - write (1, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "}", "\alpha_{" // trim(temp) // "}" + if (eqn_idx%E /= 0) write (iu, '(I3,A20,A20)') eqn_idx%E, "\rho U", "p" + do i = eqn_idx%adv%beg, eqn_idx%adv%end + write (temp, '(I0)') i - eqn_idx%cont%beg + 1 + write (iu, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "}", "\alpha_{" // trim(temp) // "}" end do if (chemistry) then do i = 1, num_species - write (1, '(I3,A20,A20)') chemxb + i - 1, "Y_{" // trim(species_names(i)) // "} \rho", & + write (iu, '(I3,A20,A20)') eqn_idx%species%beg + i - 1, "Y_{" // trim(species_names(i)) // "} \rho", & & "Y_{" // trim(species_names(i)) // "}" end do end if - write (1, '(A)') "" - if (momxb /= 0) write (1, '("[",I2,",",I2,"]",A)') momxb, momxe, " Momentum" - if (E_idx /= 0) write (1, '("[",I2,",",I2,"]",A)') E_idx, E_idx, " Energy/Pressure" - if (advxb /= 0) write (1, '("[",I2,",",I2,"]",A)') advxb, advxe, " Advection" - if (contxb /= 0) write (1, '("[",I2,",",I2,"]",A)') contxb, contxe, " Continuity" - if (bubxb /= 0) write (1, '("[",I2,",",I2,"]",A)') bubxb, bubxe, " Bubbles_euler" - if (strxb /= 0) write (1, '("[",I2,",",I2,"]",A)') strxb, strxe, " Stress" - if (intxb /= 0) write (1, '("[",I2,",",I2,"]",A)') intxb, intxe, " Internal Energies" - if (chemxb /= 0) write (1, '("[",I2,",",I2,"]",A)') chemxb, chemxe, " Chemistry" - - close (1) + write (iu, '(A)') "" + call write_range(eqn_idx%cont%beg, eqn_idx%cont%end, " Continuity") + call write_range(eqn_idx%mom%beg, eqn_idx%mom%end, " Momentum") + call write_range(eqn_idx%E, eqn_idx%E, " Energy/Pressure") + call write_range(eqn_idx%adv%beg, eqn_idx%adv%end, " Advection") + call write_range(eqn_idx%bub%beg, eqn_idx%bub%end, " Bubbles") + call write_range(eqn_idx%stress%beg, eqn_idx%stress%end, " Stress") + call write_range(eqn_idx%int_en%beg, eqn_idx%int_en%end, " Internal Energies") + call write_range(eqn_idx%xi%beg, eqn_idx%xi%end, " Reference Map") + call write_range(eqn_idx%B%beg, eqn_idx%B%end, " Magnetic Field") + call write_range(eqn_idx%c, eqn_idx%c, " Color Function") + call write_range(eqn_idx%species%beg, eqn_idx%species%end, " Chemistry") + + close (iu) if (down_sample) then m_ds = int((m + 1)/3) - 1 @@ -663,6 +665,17 @@ contains end do end if + contains + + subroutine write_range(beg, end, label) + + integer, intent(in) :: beg, end + character(*), intent(in) :: label + + if (beg /= 0) write (iu, '("[",I0,",",I0,"]",A)') beg, end, label + + end subroutine write_range + end subroutine s_initialize_data_output_module !> Resets s_write_data_files pointer diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 077262aece..4105e7aa91 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -82,23 +82,8 @@ module m_global_parameters integer :: igr_order !< IGR reconstruction order logical, parameter :: chemistry = .${chemistry}$. !< Chemistry modeling ! Annotations of the structure, i.e. the organization, of the state vectors - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of total energy equation - integer :: alf_idx !< Index of void fraction - integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: B_idx !< Indexes of first and last magnetic field eqns. - type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. - type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of the color function - type(int_bounds_info) :: species_idx !< Indexes of first & last concentration eqns. - integer :: damage_idx !< Index of damage state variable (D) for continuum damage model - integer :: psi_idx !< Index of hyperbolic cleaning state variable for MHD + type(eqn_idx_info) :: eqn_idx !< All conserved-variable equation index ranges and scalars. + type(qbmm_idx_info) :: qbmm_idx !< QBMM moment index mappings. ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). Stands for "InDices With BUFFer". type(int_bounds_info) :: idwint(1:3) @@ -195,18 +180,6 @@ module m_global_parameters logical :: surface_tension !> @} - !> @name Index variables used for m_variables_conversion - !> @{ - integer :: momxb, momxe - integer :: advxb, advxe - integer :: contxb, contxe - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe - integer :: xibeg, xiend - integer :: chemxb, chemxe - !> @} - integer, allocatable, dimension(:,:,:) :: logic_grid type(pres_field) :: pb type(pres_field) :: mv @@ -563,87 +536,87 @@ contains ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end ! Volume Fraction Model (5-equation model) else if (model_eqns == 2) then ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 if (igr) then ! Volume fractions are stored in the indices immediately following the energy equation. IGR tracks a total of (N-1) - ! volume fractions for N fluids, hence the "-1" in adv_idx%end. If num_fluids = 1 then adv_idx%end < adv_idx%beg, - ! which skips all loops over the volume fractions since there is no volume fraction to track - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - 1 + ! volume fractions for N fluids, hence the "-1" in eqn_idx%adv%end. If num_fluids = 1 then eqn_idx%adv%end < + ! eqn_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids - 1 else ! Volume fractions are stored in the indices immediately following the energy equation. WENO/MUSCL + Riemann tracks - ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in adv_idx%end - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in eqn_idx%adv%end + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = sys_size + 1 if (qbmm) then if (nnode == 4) then nmom = 6 !< Already set as a parameter end if - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) - allocate (bub_idx%fullmom(nb,0:nmom,0:nmom)) + allocate (qbmm_idx%moms(nb, nmom)) + allocate (qbmm_idx%fullmom(nb,0:nmom,0:nmom)) do i = 1, nb do j = 1, nmom - bub_idx%moms(i, j) = bub_idx%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%fullmom(i, 0, 0) = bub_idx%moms(i, 1) - bub_idx%fullmom(i, 1, 0) = bub_idx%moms(i, 2) - bub_idx%fullmom(i, 0, 1) = bub_idx%moms(i, 3) - bub_idx%fullmom(i, 2, 0) = bub_idx%moms(i, 4) - bub_idx%fullmom(i, 1, 1) = bub_idx%moms(i, 5) - bub_idx%fullmom(i, 0, 2) = bub_idx%moms(i, 6) - bub_idx%rs(i) = bub_idx%fullmom(i, 1, 0) + qbmm_idx%fullmom(i, 0, 0) = qbmm_idx%moms(i, 1) + qbmm_idx%fullmom(i, 1, 0) = qbmm_idx%moms(i, 2) + qbmm_idx%fullmom(i, 0, 1) = qbmm_idx%moms(i, 3) + qbmm_idx%fullmom(i, 2, 0) = qbmm_idx%moms(i, 4) + qbmm_idx%fullmom(i, 1, 1) = qbmm_idx%moms(i, 5) + qbmm_idx%fullmom(i, 0, 2) = qbmm_idx%moms(i, 6) + qbmm_idx%rs(i) = qbmm_idx%fullmom(i, 1, 0) end do else do i = 1, nb @@ -653,63 +626,63 @@ contains fac = 2 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do end if end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = eqn_idx%B%end end if ! Volume Fraction Model (6-equation model) else if (model_eqns == 3) then ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%int_en%beg = eqn_idx%adv%end + 1 + eqn_idx%int_en%end = eqn_idx%adv%end + num_fluids + sys_size = eqn_idx%int_en%end else if (model_eqns == 4) then ! 4 equation model with subgrid bubbles_euler - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 ! num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each direction - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - alf_idx = adv_idx%end - sys_size = alf_idx ! adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 ! num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each direction + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg ! one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + sys_size = eqn_idx%alf ! eqn_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) allocate (weight(nb), R0(nb)) do i = 1, nb @@ -719,12 +692,12 @@ contains fac = 2 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do @@ -745,24 +718,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = sys_size + 1 + eqn_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2,1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1,1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2,1:2) = shear_indices((/1, 3/)) @@ -775,51 +748,34 @@ contains ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%xi%beg = sys_size + 1 + eqn_idx%xi%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi end if end if if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = sys_size + 1 + eqn_idx%species%end = sys_size + num_species + sys_size = eqn_idx%species%end end if - momxb = mom_idx%beg - momxe = mom_idx%end - advxb = adv_idx%beg - advxe = adv_idx%end - contxb = cont_idx%beg - contxe = cont_idx%end - bubxb = bub_idx%beg - bubxe = bub_idx%end - strxb = stress_idx%beg - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end - xibeg = xi_idx%beg - xiend = xi_idx%end - chemxb = species_idx%beg - chemxe = species_idx%end - call s_configure_coordinate_bounds(recon_type, weno_polyn, muscl_polyn, igr_order, buff_size, idwint, idwbuff, viscous, & & bubbles_lagrange, m, n, p, num_dims, igr, ib) @@ -909,6 +865,11 @@ contains integer :: i + if (bubbles_euler) then + deallocate (qbmm_idx%rs, qbmm_idx%vs, qbmm_idx%ps, qbmm_idx%ms) + if (qbmm) deallocate (qbmm_idx%moms, qbmm_idx%fullmom) + end if + ! Deallocating grid variables for the x-direction deallocate (x_cc, x_cb) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 8d92745595..75104dda37 100644 --- a/src/pre_process/m_icpp_patches.fpp +++ b/src/pre_process/m_icpp_patches.fpp @@ -379,7 +379,7 @@ contains ! Updating the patch identities bookkeeping variable if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id - q_prim_vf(alf_idx)%sf(i, j, & + q_prim_vf(eqn_idx%alf)%sf(i, j, & & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -441,7 +441,7 @@ contains ! Updating the patch identities bookkeeping variable if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id - q_prim_vf(alf_idx)%sf(i, j, & + q_prim_vf(eqn_idx%alf)%sf(i, j, & & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -633,8 +633,8 @@ contains if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then ! zero density, reassign according to Tait EOS - q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(E_idx)%sf(i, j, & - & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(alf_idx) & + q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(eqn_idx%E)%sf(i, j, & + & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(eqn_idx%alf) & & %sf(i, j, 0)) end if @@ -764,9 +764,9 @@ contains if (1._wp - eta < sgm_eps) 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) - q_prim_vf(mom_idx%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) - q_prim_vf(E_idx)%sf(i, j, & + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) + q_prim_vf(eqn_idx%E)%sf(i, j, & & 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/L0 + cos(2*y_cc(j))/L0)*(q_prim_vf(1)%sf(i, j, & & 0)*U0*U0)/16 end if diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 0b5a6ba40a..29a2747832 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -102,14 +102,14 @@ contains ! Initial damage state is always zero if (cont_damage) then - q_cons_vf(damage_idx)%sf = 0._wp - q_prim_vf(damage_idx)%sf = 0._wp + q_cons_vf(eqn_idx%damage)%sf = 0._wp + q_prim_vf(eqn_idx%damage)%sf = 0._wp end if ! Initial hyper_cleaning state is always zero TODO more general if (hyper_cleaning) then - q_cons_vf(psi_idx)%sf = 0._wp - q_prim_vf(psi_idx)%sf = 0._wp + q_cons_vf(eqn_idx%psi)%sf = 0._wp + q_prim_vf(eqn_idx%psi)%sf = 0._wp end if ! Setting default values for patch identities bookkeeping variable. This is necessary to avoid any confusion in the diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 516fc3a6ce..6c3b74ad3b 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -43,13 +43,13 @@ contains do i = 0, m call random_number(rand_real) - perturb_alpha = q_prim_vf(E_idx + perturb_sph_fluid)%sf(i, j, k) + perturb_alpha = q_prim_vf(eqn_idx%E + perturb_sph_fluid)%sf(i, j, k) ! Perturb partial density fields to match perturbed volume fraction fields when the volume fraction is not near ! 0 or 1 if ((.not. f_approx_equal(perturb_alpha, 0._wp)) .and. (.not. f_approx_equal(perturb_alpha, 1._wp))) then do l = 1, num_fluids - q_prim_vf(l)%sf(i, j, k) = q_prim_vf(E_idx + l)%sf(i, j, k)*fluid_rho(l) + q_prim_vf(l)%sf(i, j, k) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k)*fluid_rho(l) end do end if end do @@ -72,10 +72,10 @@ contains do i = 0, m call random_number(rand_real) rand_real = rand_real*perturb_flow_mag - q_prim_vf(mom_idx%end)%sf(i, j, k) = rand_real*q_prim_vf(mom_idx%beg)%sf(i, j, k) - q_prim_vf(mom_idx%beg)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(mom_idx%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = rand_real*q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) + q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) if (bubbles_euler) then - q_prim_vf(alf_idx)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(alf_idx)%sf(i, j, k) + q_prim_vf(eqn_idx%alf)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(eqn_idx%alf)%sf(i, j, k) end if end do end do @@ -181,11 +181,12 @@ contains vel_rsm = 0._wp do q = 1, num_dims - vel_rsm = vel_rsm + q_prim_vf(momxb + q - 1)%sf(j, k, l)**2._wp + vel_rsm = vel_rsm + q_prim_vf(eqn_idx%mom%beg + q - 1)%sf(j, k, l)**2._wp end do vel_rsm = sqrt(vel_rsm) - q_prim_vf(momxb + i - 1)%sf(j, k, l) = q_prim_vf(momxb + i - 1)%sf(j, k, l) + vel_rsm*scale*mag + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, & + & l) + vel_rsm*scale*mag end do end do end do @@ -215,8 +216,8 @@ contains zl = freq*(z_cc(l) + ofs(i, 3)) mag = f_simplex3d(xl, yl, zl) end if - q_prim_vf(contxb + i - 1)%sf(j, k, l) = q_prim_vf(contxb + i - 1)%sf(j, k, & - & l) + q_prim_vf(contxb + i - 1)%sf(j, k, l)*scale*mag + q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l) = q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, & + & l) + q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l)*scale*mag end do end do end do @@ -295,9 +296,9 @@ contains alpha = k(i)*(khat(1)*x_cc(j) + khat(2)*y_cc(r) + khat(3)*z_cc(l)) + 2._wp*pi*phi velfluc = 2._wp*q*sig*cos(alpha) velfluc = matmul(Lmat, velfluc) - q_prim_vf(momxb)%sf(j, r, l) = q_prim_vf(momxb)%sf(j, r, l) + velfluc(1) - q_prim_vf(momxb + 1)%sf(j, r, l) = q_prim_vf(momxb + 1)%sf(j, r, l) + velfluc(2) - q_prim_vf(momxb + 2)%sf(j, r, l) = q_prim_vf(momxb + 2)%sf(j, r, l) + velfluc(3) + q_prim_vf(eqn_idx%mom%beg)%sf(j, r, l) = q_prim_vf(eqn_idx%mom%beg)%sf(j, r, l) + velfluc(1) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, r, l) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, r, l) + velfluc(2) + q_prim_vf(eqn_idx%mom%beg + 2)%sf(j, r, l) = q_prim_vf(eqn_idx%mom%beg + 2)%sf(j, r, l) + velfluc(3) end do end do end do diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 0cf3a475f3..b0a2eeef7e 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -547,15 +547,15 @@ contains ! hard-coded psi if (hyper_cleaning) then - @:ASSERT(psi_idx > 0, "hyper_cleaning requires psi_idx to be set") + @:ASSERT(eqn_idx%psi > 0, "hyper_cleaning requires eqn_idx%psi to be set") do l = 0, p do k = 0, n do j = 0, m r2 = x_cc(j)**2 if (n > 0) r2 = r2 + y_cc(k)**2 if (p > 0) r2 = r2 + z_cc(l)**2 - q_cons_vf(psi_idx)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2)) - q_prim_vf(psi_idx)%sf(j, k, l) = q_cons_vf(psi_idx)%sf(j, k, l) + q_cons_vf(eqn_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2)) + q_prim_vf(eqn_idx%psi)%sf(j, k, l) = q_cons_vf(eqn_idx%psi)%sf(j, k, l) end do end do end do diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 41c897cfd3..9b2a969aa4 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -222,7 +222,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = 1, num_fluids myalpha_rho(q) = q_cons_vf(q)%sf(j, k, l) - myalpha(q) = q_cons_vf(advxb + q - 1)%sf(j, k, l) + myalpha(q) = q_cons_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l) end do if (bubbles_euler) then @@ -250,7 +250,7 @@ contains end if small_gamma = 1._wp/small_gamma + 1._wp - c = sqrt(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(eqn_idx%E)%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) @@ -315,14 +315,14 @@ contains do k = 0, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do q = contxb, contxe + do q = eqn_idx%cont%beg, eqn_idx%cont%end rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mass_src(j, k, l) end do $:GPU_LOOP(parallelism='[seq]') - do q = momxb, momxe - rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mom_src(q - contxe, j, k, l) + do q = eqn_idx%mom%beg, eqn_idx%mom%end + rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mom_src(q - eqn_idx%cont%end, j, k, l) end do - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, l) + e_src(j, k, l) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + e_src(j, k, l) end do end do end do diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index 7200390c2c..fb5320f09e 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -66,7 +66,7 @@ contains do j = 0, m rhoM(j, k, l) = 0._wp do i = 1, num_fluids - rhoM(j, k, l) = rhoM(j, k, l) + q_cons_vf(contxb + i - 1)%sf(j, k, l) + rhoM(j, k, l) = rhoM(j, k, l) + q_cons_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l) end do end do end do @@ -87,7 +87,7 @@ contains call s_compute_mixture_density(q_cons_vf) $:GPU_PARALLEL_LOOP(private='[i, j, k, l]', collapse=4) - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -104,8 +104,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(1) - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, l) + q_cons_vf(momxb)%sf(j, k, l)*accel_bf(1) + rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(1) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%beg)%sf(j, k, & + & l)*accel_bf(1) end do end do end do @@ -118,8 +119,10 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(2) - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, l) + q_cons_vf(momxb + 1)%sf(j, k, l)*accel_bf(2) + rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) + rhoM(j, k, & + & l)*accel_bf(2) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, & + & l)*accel_bf(2) end do end do end do @@ -132,8 +135,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(momxe)%sf(j, k, l) = rhs_vf(momxe)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(3) - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, l) + q_cons_vf(momxe)%sf(j, k, l)*accel_bf(3) + rhs_vf(eqn_idx%mom%end)%sf(j, k, l) = rhs_vf(eqn_idx%mom%end)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(3) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(eqn_idx%mom%end)%sf(j, k, & + & l)*accel_bf(3) end do end do end do diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp index c80753fdb3..a15156405b 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -38,11 +38,11 @@ contains @:ALLOCATE(ms(1:nb)) do l = 1, nb - rs(l) = bub_idx%rs(l) - vs(l) = bub_idx%vs(l) + rs(l) = qbmm_idx%rs(l) + vs(l) = qbmm_idx%vs(l) if (.not. polytropic) then - ps(l) = bub_idx%ps(l) - ms(l) = bub_idx%ms(l) + ps(l) = qbmm_idx%ps(l) + ms(l) = qbmm_idx%ms(l) else ps(l) = rs(l) ms(l) = rs(l) @@ -81,7 +81,7 @@ contains do i = 1, nb nR3bar = nR3bar + weight(i)*(q_cons_vf(rs(i))%sf(j, k, l))**3._wp end do - q_cons_vf(alf_idx)%sf(j, k, l) = (4._wp*pi*nR3bar)/(3._wp*q_cons_vf(n_idx)%sf(j, k, l)**2._wp) + q_cons_vf(eqn_idx%alf)%sf(j, k, l) = (4._wp*pi*nR3bar)/(3._wp*q_cons_vf(eqn_idx%n)%sf(j, k, l)**2._wp) end do end do end do @@ -104,8 +104,8 @@ contains do k = 0, n do j = 0, m divu_in%sf(j, k, l) = 0._wp - divu_in%sf(j, k, l) = 5.e-1_wp/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, & - & l) - q_prim_vf(contxe + idir)%sf(j - 1, k, l)) + divu_in%sf(j, k, l) = 5.e-1_wp/dx(j)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j + 1, k, & + & l) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j - 1, k, l)) end do end do end do @@ -116,8 +116,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, & - & l) - q_prim_vf(contxe + idir)%sf(j, k - 1, l)) + divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dy(k)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, & + & k + 1, l) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k - 1, l)) end do end do end do @@ -127,8 +127,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, & - & l + 1) - q_prim_vf(contxe + idir)%sf(j, k, l - 1)) + divu_in%sf(j, k, l) = divu_in%sf(j, k, l) + 5.e-1_wp/dz(l)*(q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & + & l + 1) - q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, l - 1)) end do end do end do @@ -188,7 +188,7 @@ contains do k = 0, n do j = 0, m if (adv_n) then - nbub = q_prim_vf(n_idx)%sf(j, k, l) + nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l) else $:GPU_LOOP(parallelism='[seq]') do q = 1, nb @@ -203,7 +203,7 @@ contains R3 = R3 + weight(q)*Rtmp(q)**3._wp end do - nbub = (3._wp/(4._wp*pi))*q_prim_vf(alf_idx)%sf(j, k, l)/R3 + nbub = (3._wp/(4._wp*pi))*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/R3 end if if (.not. adap_dt) then @@ -222,7 +222,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do ii = 1, num_fluids myalpha_rho(ii) = q_cons_vf(ii)%sf(j, k, l) - myalpha(ii) = q_cons_vf(advxb + ii - 1)%sf(j, k, l) + myalpha(ii) = q_cons_vf(eqn_idx%adv%beg + ii - 1)%sf(j, k, l) end do if (num_fluids == 1) then @@ -245,8 +245,8 @@ contains n_tait = 1._wp/n_tait + 1._wp ! make this the usual little 'gamma' B_tait = B_tait*(n_tait - 1)/n_tait ! make this the usual pi_inf - myP = q_prim_vf(E_idx)%sf(j, k, l) - alf = q_prim_vf(alf_idx)%sf(j, k, l) + myP = q_prim_vf(eqn_idx%E)%sf(j, k, l) + alf = q_prim_vf(eqn_idx%alf)%sf(j, k, l) myR = q_prim_vf(rs(q))%sf(j, k, l) myV = q_prim_vf(vs(q))%sf(j, k, l) @@ -303,8 +303,9 @@ contains do l = 0, p do q = 0, n do i = 0, m - rhs_vf(alf_idx)%sf(i, q, l) = rhs_vf(alf_idx)%sf(i, q, l) + bub_adv_src(i, q, l) - if (num_fluids > 1) rhs_vf(advxb)%sf(i, q, l) = rhs_vf(advxb)%sf(i, q, l) - bub_adv_src(i, q, l) + rhs_vf(eqn_idx%alf)%sf(i, q, l) = rhs_vf(eqn_idx%alf)%sf(i, q, l) + bub_adv_src(i, q, l) + if (num_fluids > 1) rhs_vf(eqn_idx%adv%beg)%sf(i, q, l) = rhs_vf(eqn_idx%adv%beg)%sf(i, q, & + & l) - bub_adv_src(i, q, l) $:GPU_LOOP(parallelism='[seq]') do k = 1, nb rhs_vf(rs(k))%sf(i, q, l) = rhs_vf(rs(k))%sf(i, q, l) + bub_r_src(i, q, l, k) diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index ab7dcd6366..b44eb617b1 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -279,10 +279,10 @@ contains call s_convert_to_mixture_variables(q_cons_vf, cell(1), cell(2), cell(3), rhol, gamma, pi_inf, qv, Re) dynP = 0._wp do i = 1, num_dims - dynP = dynP + 0.5_wp*q_cons_vf(contxe + i)%sf(cell(1), cell(2), cell(3))**2/rhol + dynP = dynP + 0.5_wp*q_cons_vf(eqn_idx%cont%end + i)%sf(cell(1), cell(2), cell(3))**2/rhol end do - pliq = (q_cons_vf(E_idx)%sf(cell(1), cell(2), cell(3)) - dynP - pi_inf)/gamma - if (pliq < 0) print *, "Negative pressure", proc_rank, q_cons_vf(E_idx)%sf(cell(1), cell(2), cell(3)), pi_inf, gamma, & + pliq = (q_cons_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3)) - dynP - pi_inf)/gamma + if (pliq < 0) print *, "Negative pressure", proc_rank, q_cons_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3)), pi_inf, gamma, & & pliq, cell, dynP ! Initial particle pressure @@ -619,7 +619,7 @@ contains do k = 0, p do j = 0, n do i = 0, m - do l = 1, E_idx + do l = 1, eqn_idx%E if (q_beta(1)%sf(i, j, k) > (1._wp - lag_params%valmaxvoid)) then rhs_vf(l)%sf(i, j, k) = rhs_vf(l)%sf(i, j, k) + q_cons_vf(l)%sf(i, j, k)*(q_beta(2)%sf(i, j, & & k) + q_beta(5)%sf(i, j, k)) @@ -634,7 +634,7 @@ contains do k = 0, p do j = 0, n do i = 0, m - do l = 1, E_idx + do l = 1, eqn_idx%E if (q_beta(1)%sf(i, j, k) > (1._wp - lag_params%valmaxvoid)) then rhs_vf(l)%sf(i, j, k) = rhs_vf(l)%sf(i, j, k) + q_cons_vf(l)%sf(i, j, k)/q_beta(1)%sf(i, j, & & k)*q_beta(2)%sf(i, j, k) @@ -647,7 +647,7 @@ contains end if do l = 1, num_dims - call s_gradient_dir(q_prim_vf(E_idx)%sf, q_beta(3)%sf, l) + call s_gradient_dir(q_prim_vf(eqn_idx%E)%sf, q_beta(3)%sf, l) ! (q / (1 - beta)) * d(beta)/dt source $:GPU_PARALLEL_LOOP(private='[i, j, k]', collapse=3) @@ -655,8 +655,8 @@ contains do j = 0, n do i = 0, m if (q_beta(1)%sf(i, j, k) > (1._wp - lag_params%valmaxvoid)) then - rhs_vf(contxe + l)%sf(i, j, k) = rhs_vf(contxe + l)%sf(i, j, k) - (1._wp - q_beta(1)%sf(i, j, & - & k))/q_beta(1)%sf(i, j, k)*q_beta(3)%sf(i, j, k) + rhs_vf(eqn_idx%cont%end + l)%sf(i, j, k) = rhs_vf(eqn_idx%cont%end + l)%sf(i, j, & + & k) - (1._wp - q_beta(1)%sf(i, j, k))/q_beta(1)%sf(i, j, k)*q_beta(3)%sf(i, j, k) end if end do end do @@ -668,7 +668,7 @@ contains do k = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(2)%beg, idwbuff(2)%end do i = idwbuff(1)%beg, idwbuff(1)%end - q_beta(3)%sf(i, j, k) = q_prim_vf(E_idx)%sf(i, j, k)*q_prim_vf(contxe + l)%sf(i, j, k) + q_beta(3)%sf(i, j, k) = q_prim_vf(eqn_idx%E)%sf(i, j, k)*q_prim_vf(eqn_idx%cont%end + l)%sf(i, j, k) end do end do end do @@ -682,7 +682,7 @@ contains do j = 0, n do i = 0, m if (q_beta(1)%sf(i, j, k) > (1._wp - lag_params%valmaxvoid)) then - rhs_vf(E_idx)%sf(i, j, k) = rhs_vf(E_idx)%sf(i, j, k) - q_beta(4)%sf(i, j, & + rhs_vf(eqn_idx%E)%sf(i, j, k) = rhs_vf(eqn_idx%E)%sf(i, j, k) - q_beta(4)%sf(i, j, & & k)*(1._wp - q_beta(1)%sf(i, j, k))/q_beta(1)%sf(i, j, k) end if end do @@ -714,7 +714,7 @@ contains vel(:) = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel(i) = q_prim_vf(i + contxe)%sf(cell(1), cell(2), cell(3)) + vel(i) = q_prim_vf(i + eqn_idx%cont%end)%sf(cell(1), cell(2), cell(3)) end do E = gamma*pinf + pi_inf + 0.5_wp*rhol*dot_product(vel, vel) H = (E + pinf)/rhol @@ -842,19 +842,19 @@ contains !> Perform bilinear interpolation if (p == 0) then ! 2D - f_pinfl = q_prim_vf(E_idx)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1), cell(2) + 1, cell(3))*(1._wp - psi(1))*psi(2) + f_pinfl = q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2) + 1, cell(3))*(1._wp - psi(1))*psi(2) else ! 3D - f_pinfl = q_prim_vf(E_idx)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2))*(1._wp - psi(3)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2))*(1._wp - psi(3)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2)*(1._wp - psi(3)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1), cell(2) + 1, cell(3))*(1._wp - psi(1))*psi(2)*(1._wp - psi(3)) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1), cell(2), cell(3) + 1)*(1._wp - psi(1))*(1._wp - psi(2))*psi(3) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2), cell(3) + 1)*psi(1)*(1._wp - psi(2))*psi(3) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1) + 1, cell(2) + 1, cell(3) + 1)*psi(1)*psi(2)*psi(3) - f_pinfl = f_pinfl + q_prim_vf(E_idx)%sf(cell(1), cell(2) + 1, cell(3) + 1)*(1._wp - psi(1))*psi(2)*psi(3) + f_pinfl = q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2))*(1._wp - psi(3)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2))*(1._wp - psi(3)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2)*(1._wp - psi(3)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2) + 1, cell(3))*(1._wp - psi(1))*psi(2)*(1._wp - psi(3)) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3) + 1)*(1._wp - psi(1))*(1._wp - psi(2))*psi(3) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2), cell(3) + 1)*psi(1)*(1._wp - psi(2))*psi(3) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1) + 1, cell(2) + 1, cell(3) + 1)*psi(1)*psi(2)*psi(3) + f_pinfl = f_pinfl + q_prim_vf(eqn_idx%E)%sf(cell(1), cell(2) + 1, cell(3) + 1)*(1._wp - psi(1))*psi(2)*psi(3) end if ! R_Omega @@ -925,9 +925,9 @@ contains end if !> Update values charvol = charvol + vol - charpres = charpres + q_prim_vf(E_idx)%sf(cellaux(1), cellaux(2), cellaux(3))*vol + charpres = charpres + q_prim_vf(eqn_idx%E)%sf(cellaux(1), cellaux(2), cellaux(3))*vol charvol2 = charvol2 + vol*q_beta(1)%sf(cellaux(1), cellaux(2), cellaux(3)) - charpres2 = charpres2 + q_prim_vf(E_idx)%sf(cellaux(1), cellaux(2), & + charpres2 = charpres2 + q_prim_vf(eqn_idx%E)%sf(cellaux(1), cellaux(2), & & cellaux(3))*vol*q_beta(1)%sf(cellaux(1), cellaux(2), cellaux(3)) end if end do diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 0e36c48fbf..d703a3c1e3 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -69,10 +69,9 @@ module m_cbc $:GPU_DECLARE(create='[is1, is2, is3]') integer :: dj - integer :: bcxb, bcxe, bcyb, bcye, bczb, bcze integer :: cbc_dir, cbc_loc integer :: flux_cbc_index - $:GPU_DECLARE(create='[dj, bcxb, bcxe, bcyb, bcye, bczb, bcze]') + $:GPU_DECLARE(create='[dj]') $:GPU_DECLARE(create='[cbc_dir, cbc_loc, flux_cbc_index]') ! GRCBC inputs for subsonic inflow and outflow conditions consisting of inflow velocities, pressure, density and void fraction @@ -97,7 +96,7 @@ contains if (chemistry) then flux_cbc_index = sys_size else - flux_cbc_index = adv_idx%end + flux_cbc_index = eqn_idx%adv%end end if $:GPU_UPDATE(device='[flux_cbc_index]') @@ -125,12 +124,12 @@ contains if (weno_order > 1 .or. muscl_order > 1) then @:ALLOCATE(F_rsx_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(F_src_rsx_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(F_src_rsx_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @:ALLOCATE(flux_rsx_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(flux_src_rsx_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(flux_src_rsx_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) if (n > 0) then if (m == 0) then @@ -153,12 +152,12 @@ contains if (weno_order > 1 .or. muscl_order > 1) then @:ALLOCATE(F_rsy_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(F_src_rsy_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(F_src_rsy_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @:ALLOCATE(flux_rsy_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(flux_src_rsy_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(flux_src_rsy_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if if (p > 0) then @@ -182,12 +181,12 @@ contains if (weno_order > 1 .or. muscl_order > 1) then @:ALLOCATE(F_rsz_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(F_src_rsz_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(F_src_rsz_vf(0:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @:ALLOCATE(flux_rsz_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, 1:flux_cbc_index)) - @:ALLOCATE(flux_src_rsz_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + @:ALLOCATE(flux_src_rsz_vf_l(-1:buff_size, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if ! Allocating the cell-width distribution in the s-direction @@ -294,28 +293,6 @@ contains $:GPU_UPDATE(device='[fd_coef_x, fd_coef_y, fd_coef_z, pi_coef_x, pi_coef_y, pi_coef_z]') - ! Associating the procedural pointer to the appropriate subroutine that will be utilized in the conversion to the mixture - ! variables - - bcxb = bc_x%beg - bcxe = bc_x%end - - $:GPU_UPDATE(device='[bcxb, bcxe]') - - if (n > 0) then - bcyb = bc_y%beg - bcye = bc_y%end - - $:GPU_UPDATE(device='[bcyb, bcye]') - end if - - if (p > 0) then - bczb = bc_z%beg - bcze = bc_z%end - - $:GPU_UPDATE(device='[bczb, bcze]') - end if - ! Allocate GRCBC inputs @:ALLOCATE(pres_in(1:num_dims), pres_out(1:num_dims)) @:ALLOCATE(Del_in(1:num_dims), Del_out(1:num_dims)) @@ -568,7 +545,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(private='[i, r, k]', collapse=3) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end flux_src_rs${XYZ}$_vf_l(0, k, r, i) = F_src_rs${XYZ}$_vf(0, k, r, i) + (F_src_rs${XYZ}$_vf(1, k, & @@ -601,7 +578,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(private='[i, j, r, k]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do j = 0, 1 do r = is3%beg, is3%end do k = is2%beg, is2%end @@ -628,13 +605,13 @@ contains do k = is2%beg, is2%end ! Transferring the Primitive Variables $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho(i) = q_prim_rs${XYZ}$_vf(0, k, r, i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel(i) = q_prim_rs${XYZ}$_vf(0, k, r, contxe + i) + vel(i) = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%cont%end + i) end do vel_K_sum = 0._wp @@ -643,24 +620,24 @@ contains vel_K_sum = vel_K_sum + vel(i)**2._wp end do - pres = q_prim_rs${XYZ}$_vf(0, k, r, E_idx) + pres = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E) $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx - adv_local(i) = q_prim_rs${XYZ}$_vf(0, k, r, E_idx + i) + do i = 1, eqn_idx%adv%end - eqn_idx%E + adv_local(i) = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E + i) end do call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, adv_local, alpha_rho, Re_cbc) $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end mf(i) = alpha_rho(i)/rho end do if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys(i - chemxb + 1) = q_prim_rs${XYZ}$_vf(0, k, r, i) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys(i - eqn_idx%species%beg + 1) = q_prim_rs${XYZ}$_vf(0, k, r, i) end do call get_mixture_molecular_weight(Ys, Mw) @@ -692,7 +669,7 @@ contains ! First-Order Spatial Derivatives of Primitive Variables $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end dalpha_rho_ds(i) = 0._wp end do @@ -703,7 +680,7 @@ contains dpres_ds = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx + do i = 1, eqn_idx%adv%end - eqn_idx%E dadv_ds(i) = 0._wp end do @@ -717,24 +694,25 @@ contains $:GPU_LOOP(parallelism='[seq]') do j = 0, buff_size $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end dalpha_rho_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, i)*fd_coef_${XYZ}$ (j, cbc_loc) + dalpha_rho_ds(i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - dvel_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, contxe + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dvel_ds(i) + dvel_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%cont%end + i)*fd_coef_${XYZ}$ (j, & + & cbc_loc) + dvel_ds(i) end do - dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, E_idx)*fd_coef_${XYZ}$ (j, cbc_loc) + dpres_ds + dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%E)*fd_coef_${XYZ}$ (j, cbc_loc) + dpres_ds $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx - dadv_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, E_idx + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dadv_ds(i) + do i = 1, eqn_idx%adv%end - eqn_idx%E + dadv_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%E + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dadv_ds(i) end do if (chemistry) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_species - dYs_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, chemxb - 1 + i)*fd_coef_${XYZ}$ (j, & + dYs_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%species%beg - 1 + i)*fd_coef_${XYZ}$ (j, & & cbc_loc) + dYs_ds(i) end do end if @@ -747,84 +725,87 @@ contains Ma = vel(dir_idx(1))/c - if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_SLIP_WALL) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_SLIP_WALL)) then + if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SLIP_WALL) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SLIP_WALL)) then call s_compute_slip_wall_L(lambda, L, rho, c, dpres_ds, dvel_ds) - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_NR_SUB_BUFFER) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_NR_SUB_BUFFER)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_BUFFER) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_BUFFER)) then call s_compute_nonreflecting_subsonic_buffer_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds, dYs_ds) - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_NR_SUB_INFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_NR_SUB_INFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_INFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_INFLOW)) then call s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, dpres_ds, dvel_ds) ! Add GRCBC for Subsonic Inflow if (bc_${XYZ}$%grcbc_in) then $:GPU_LOOP(parallelism='[seq]') - do i = 2, momxb + do i = 2, eqn_idx%mom%beg L(i) = c**3._wp*Ma*(alpha_rho(i - 1) - alpha_rho_in(i - 1, & & ${CBC_DIR}$))/Del_in(${CBC_DIR}$) - c*Ma*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) end do if (n > 0) then - L(momxb + 1) = c*Ma*(vel(dir_idx(2)) - vel_in(${CBC_DIR}$, dir_idx(2)))/Del_in(${CBC_DIR}$) + L(eqn_idx%mom%beg + 1) = c*Ma*(vel(dir_idx(2)) - vel_in(${CBC_DIR}$, & + & dir_idx(2)))/Del_in(${CBC_DIR}$) if (p > 0) then - L(momxb + 2) = c*Ma*(vel(dir_idx(3)) - vel_in(${CBC_DIR}$, dir_idx(3)))/Del_in(${CBC_DIR}$) + L(eqn_idx%mom%beg + 2) = c*Ma*(vel(dir_idx(3)) - vel_in(${CBC_DIR}$, & + & dir_idx(3)))/Del_in(${CBC_DIR}$) end if end if $:GPU_LOOP(parallelism='[seq]') - do i = E_idx, advxe - 1 - L(i) = c*Ma*(adv_local(i + 1 - E_idx) - alpha_in(i + 1 - E_idx, & + do i = eqn_idx%E, eqn_idx%adv%end - 1 + L(i) = c*Ma*(adv_local(i + 1 - eqn_idx%E) - alpha_in(i + 1 - eqn_idx%E, & & ${CBC_DIR}$))/Del_in(${CBC_DIR}$) end do - L(advxe) = rho*c**2._wp*(1._wp + Ma)*(vel(dir_idx(1)) + vel_in(${CBC_DIR}$, dir_idx(1))*sign(1, & + L(eqn_idx%adv%end) = rho*c**2._wp*(1._wp + Ma)*(vel(dir_idx(1)) + vel_in(${CBC_DIR}$, & + & dir_idx(1))*sign(1, & & cbc_loc))/Del_in(${CBC_DIR}$) + c*(1._wp + Ma)*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) end if - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_NR_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_NR_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_NR_SUB_OUTFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_NR_SUB_OUTFLOW)) then call s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds, dYs_ds) ! Add GRCBC for Subsonic Outflow (Pressure) if (bc_${XYZ}$%grcbc_out) then - L(advxe) = c*(1._wp - Ma)*(pres - pres_out(${CBC_DIR}$))/Del_out(${CBC_DIR}$) + L(eqn_idx%adv%end) = c*(1._wp - Ma)*(pres - pres_out(${CBC_DIR}$))/Del_out(${CBC_DIR}$) ! Add GRCBC for Subsonic Outflow (Normal Velocity) if (bc_${XYZ}$%grcbc_vel_out) then - L(advxe) = L(advxe) + rho*c**2._wp*(1._wp - Ma)*(vel(dir_idx(1)) + vel_out(${CBC_DIR}$, & - & dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) + L(eqn_idx%adv%end) = L(eqn_idx%adv%end) + rho*c**2._wp*(1._wp - Ma)*(vel(dir_idx(1)) & + & + vel_out(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) end if end if - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_FF_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_FF_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_FF_SUB_OUTFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_FF_SUB_OUTFLOW)) then call s_compute_force_free_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, & & dadv_ds) - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_CP_SUB_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_CP_SUB_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_CP_SUB_OUTFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_CP_SUB_OUTFLOW)) then call s_compute_constant_pressure_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, & & dvel_ds, dadv_ds) - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_SUP_INFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_SUP_INFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_INFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SUP_INFLOW)) then call s_compute_supersonic_inflow_L(L) - else if ((cbc_loc == -1 .and. bc${XYZ}$b == BC_CHAR_SUP_OUTFLOW) & - & .or. (cbc_loc == 1 .and. bc${XYZ}$e == BC_CHAR_SUP_OUTFLOW)) then + else if ((cbc_loc == -1 .and. bc_${XYZ}$%beg == BC_CHAR_SUP_OUTFLOW) & + & .or. (cbc_loc == 1 .and. bc_${XYZ}$%end == BC_CHAR_SUP_OUTFLOW)) then call s_compute_supersonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, & & dYs_ds) end if ! Be careful about the cylindrical coordinate! if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then - dpres_dt = -5.e-1_wp*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1))/y_cc(n) + dpres_dt = -5.e-1_wp*(L(eqn_idx%adv%end) + L(1)) + rho*c*c*vel(dir_idx(1))/y_cc(n) else - dpres_dt = -5.e-1_wp*(L(advxe) + L(1)) + dpres_dt = -5.e-1_wp*(L(eqn_idx%adv%end) + L(1)) end if $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end dalpha_rho_dt(i) = -(L(i + 1) - mf(i)*dpres_dt)/(c*c) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - dvel_dt(dir_idx(i)) = dir_flg(dir_idx(i))*(L(1) - L(advxe))/(2._wp*rho*c) + (dir_flg(dir_idx(i)) & - & - 1._wp)*L(momxb + i - 1) + dvel_dt(dir_idx(i)) = dir_flg(dir_idx(i))*(L(1) - L(eqn_idx%adv%end))/(2._wp*rho*c) & + & + (dir_flg(dir_idx(i)) - 1._wp)*L(eqn_idx%mom%beg + i - 1) end do vel_dv_dt_sum = 0._wp @@ -836,20 +817,20 @@ contains if (chemistry) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_species - dYs_dt(i) = -1._wp*L(chemxb + i - 1) + dYs_dt(i) = -1._wp*L(eqn_idx%species%beg + i - 1) end do end if ! The treatment of void fraction source is unclear if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx - dadv_dt(i) = -L(momxe + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) + do i = 1, eqn_idx%adv%end - eqn_idx%E + dadv_dt(i) = -L(eqn_idx%mom%end + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) end do else $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx - dadv_dt(i) = -L(momxe + i) + do i = 1, eqn_idx%adv%end - eqn_idx%E + dadv_dt(i) = -L(eqn_idx%mom%end + i) end do end if @@ -873,14 +854,14 @@ contains ! flux_rs_vf_l and flux_src_rs_vf_l at j = -1/2 $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf_l(-1, k, r, i) = flux_rs${XYZ}$_vf_l(0, k, r, i) + ds(0)*dalpha_rho_dt(i) end do $:GPU_LOOP(parallelism='[seq]') - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end flux_rs${XYZ}$_vf_l(-1, k, r, i) = flux_rs${XYZ}$_vf_l(0, k, r, & - & i) + ds(0)*(vel(i - contxe)*drho_dt + rho*dvel_dt(i - contxe)) + & i) + ds(0)*(vel(i - eqn_idx%cont%end)*drho_dt + rho*dvel_dt(i - eqn_idx%cont%end)) end do if (chemistry) then @@ -899,41 +880,41 @@ contains sum_Enthalpies = sum_Enthalpies + (rho*h_k(i) - pres*Mw/molecular_weights(i)*Cp/R_gas)*dYs_dt(i) #:endif end do - flux_rs${XYZ}$_vf_l(-1, k, r, E_idx) = flux_rs${XYZ}$_vf_l(0, k, r, & - & E_idx) + ds(0)*((E/rho + pres/rho)*drho_dt + rho*vel_dv_dt_sum + Cp*T*L(2)/(c*c) & - & + sum_Enthalpies) + flux_rs${XYZ}$_vf_l(-1, k, r, eqn_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & + & eqn_idx%E) + ds(0)*((E/rho + pres/rho)*drho_dt + rho*vel_dv_dt_sum + Cp*T*L(2) & + & /(c*c) + sum_Enthalpies) $:GPU_LOOP(parallelism='[seq]') do i = 1, num_species - flux_rs${XYZ}$_vf_l(-1, k, r, i - 1 + chemxb) = flux_rs${XYZ}$_vf_l(0, k, r, & - & chemxb + i - 1) + ds(0)*(drho_dt*Ys(i) + rho*dYs_dt(i)) + flux_rs${XYZ}$_vf_l(-1, k, r, i - 1 + eqn_idx%species%beg) = flux_rs${XYZ}$_vf_l(0, k, r, & + & eqn_idx%species%beg + i - 1) + ds(0)*(drho_dt*Ys(i) + rho*dYs_dt(i)) end do else - flux_rs${XYZ}$_vf_l(-1, k, r, E_idx) = flux_rs${XYZ}$_vf_l(0, k, r, & - & E_idx) + ds(0)*(pres*dgamma_dt + gamma*dpres_dt + dpi_inf_dt + dqv_dt & + flux_rs${XYZ}$_vf_l(-1, k, r, eqn_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & + & eqn_idx%E) + ds(0)*(pres*dgamma_dt + gamma*dpres_dt + dpi_inf_dt + dqv_dt & & + rho*vel_dv_dt_sum + 5.e-1_wp*drho_dt*vel_K_sum) end if if (riemann_solver == 1) then $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf_l(-1, k, r, i) = 0._wp end do $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_src_rs${XYZ}$_vf_l(-1, k, r, i) = 1._wp/max(abs(vel(dir_idx(1))), sgm_eps)*sign(1._wp, & & vel(dir_idx(1)))*(flux_rs${XYZ}$_vf_l(0, k, r, & & i) + vel(dir_idx(1))*flux_src_rs${XYZ}$_vf_l(0, k, r, & - & i) + ds(0)*dadv_dt(i - E_idx)) + & i) + ds(0)*dadv_dt(i - eqn_idx%E)) end do else $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe - flux_rs${XYZ}$_vf_l(-1, k, r, i) = flux_rs${XYZ}$_vf_l(0, k, r, i) + ds(0)*dadv_dt(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + flux_rs${XYZ}$_vf_l(-1, k, r, i) = flux_rs${XYZ}$_vf_l(0, k, r, i) + ds(0)*dadv_dt(i - eqn_idx%E) end do $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_src_rs${XYZ}$_vf_l(-1, k, r, i) = flux_src_rs${XYZ}$_vf_l(0, k, r, i) end do end if @@ -998,7 +979,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size - q_prim_rsx_vf(j, k, r, momxb) = q_prim_vf(momxb)%sf(dj*(m - 2*j) + j, k, r)*sign(1._wp, -1._wp*cbc_loc) + q_prim_rsx_vf(j, k, r, eqn_idx%mom%beg) = q_prim_vf(eqn_idx%mom%beg)%sf(dj*(m - 2*j) + j, k, & + & r)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1020,7 +1002,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_rsx_vf_l(j, k, r, momxb) = flux_vf(momxb)%sf(dj*((m - 1) - 2*j) + j, k, r) + flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg) = flux_vf(eqn_idx%mom%beg)%sf(dj*((m - 1) - 2*j) + j, k, r) end do end do end do @@ -1028,7 +1010,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1043,8 +1025,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_rsx_vf_l(j, k, r, advxb) = flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_rsx_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(dj*((m - 1) - 2*j) + j, & + & k, r)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1071,8 +1053,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size - q_prim_rsy_vf(j, k, r, momxb + 1) = q_prim_vf(momxb + 1)%sf(k, dj*(n - 2*j) + j, r)*sign(1._wp, & - & -1._wp*cbc_loc) + q_prim_rsy_vf(j, k, r, eqn_idx%mom%beg + 1) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, dj*(n - 2*j) + j, & + & r)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1094,7 +1076,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_rsy_vf_l(j, k, r, momxb + 1) = flux_vf(momxb + 1)%sf(k, dj*((n - 1) - 2*j) + j, r) + flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1) = flux_vf(eqn_idx%mom%beg + 1)%sf(k, dj*((n - 1) - 2*j) + j, r) end do end do end do @@ -1102,7 +1084,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1117,8 +1099,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_rsy_vf_l(j, k, r, advxb) = flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_rsy_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(k, & + & dj*((n - 1) - 2*j) + j, r)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1145,7 +1127,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size - q_prim_rsz_vf(j, k, r, momxe) = q_prim_vf(momxe)%sf(r, k, dj*(p - 2*j) + j)*sign(1._wp, -1._wp*cbc_loc) + q_prim_rsz_vf(j, k, r, eqn_idx%mom%end) = q_prim_vf(eqn_idx%mom%end)%sf(r, k, & + & dj*(p - 2*j) + j)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1167,7 +1150,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_rsz_vf_l(j, k, r, momxe) = flux_vf(momxe)%sf(r, k, dj*((p - 1) - 2*j) + j) + flux_rsz_vf_l(j, k, r, eqn_idx%mom%end) = flux_vf(eqn_idx%mom%end)%sf(r, k, dj*((p - 1) - 2*j) + j) end do end do end do @@ -1175,7 +1158,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1190,8 +1173,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_rsz_vf_l(j, k, r, advxb) = flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_rsz_vf_l(j, k, r, eqn_idx%adv%beg) = flux_src_vf(eqn_idx%adv%beg)%sf(r, k, & + & dj*((p - 1) - 2*j) + j)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1232,7 +1215,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_vf(momxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_rsx_vf_l(j, k, r, momxb) + flux_vf(eqn_idx%mom%beg)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_rsx_vf_l(j, k, r, eqn_idx%mom%beg) end do end do end do @@ -1240,7 +1223,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1255,8 +1238,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_src_rsx_vf_l(j, k, r, advxb)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_vf(eqn_idx%adv%beg)%sf(dj*((m - 1) - 2*j) + j, k, r) = flux_src_rsx_vf_l(j, k, r, & + & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1282,7 +1265,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_vf(momxb + 1)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_rsy_vf_l(j, k, r, momxb + 1) + flux_vf(eqn_idx%mom%beg + 1)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_rsy_vf_l(j, k, r, eqn_idx%mom%beg + 1) end do end do end do @@ -1290,7 +1273,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1305,8 +1288,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_src_rsy_vf_l(j, k, r, advxb)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_vf(eqn_idx%adv%beg)%sf(k, dj*((n - 1) - 2*j) + j, r) = flux_src_rsy_vf_l(j, k, r, & + & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1333,7 +1316,7 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_vf(momxe)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_rsz_vf_l(j, k, r, momxe) + flux_vf(eqn_idx%mom%end)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_rsz_vf_l(j, k, r, eqn_idx%mom%end) end do end do end do @@ -1341,7 +1324,7 @@ contains if (riemann_solver == 1) then $:GPU_PARALLEL_LOOP(private='[i, j, k, r]', collapse=4) - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size @@ -1356,8 +1339,8 @@ contains do r = is3%beg, is3%end do k = is2%beg, is2%end do j = -1, buff_size - flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_src_rsz_vf_l(j, k, r, advxb)*sign(1._wp, & - & -1._wp*cbc_loc) + flux_src_vf(eqn_idx%adv%beg)%sf(r, k, dj*((p - 1) - 2*j) + j) = flux_src_rsz_vf_l(j, k, r, & + & eqn_idx%adv%beg)*sign(1._wp, -1._wp*cbc_loc) end do end do end do diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 152589ca6d..c2c415b1d3 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -52,7 +52,7 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = 2, momxb + do i = 2, eqn_idx%mom%beg L(i) = lambda_factor*lambda2*(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds) end do @@ -76,8 +76,8 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = momxb + 1, momxe - L(i) = lambda_factor*lambda2*dvel_ds(dir_idx(i - contxe)) + do i = eqn_idx%mom%beg + 1, eqn_idx%mom%end + L(i) = lambda_factor*lambda2*dvel_ds(dir_idx(i - eqn_idx%cont%end)) end do end subroutine s_fill_velocity_L @@ -100,8 +100,8 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = E_idx, advxe - 1 - L(i) = lambda_factor*lambda2*dadv_ds(i - momxe) + do i = eqn_idx%E, eqn_idx%adv%end - 1 + L(i) = lambda_factor*lambda2*dadv_ds(i - eqn_idx%mom%end) end do end subroutine s_fill_advection_L @@ -126,8 +126,8 @@ contains if (.not. chemistry) return ! $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - L(i) = lambda_factor*lambda2*dYs_ds(i - chemxb + 1) + do i = eqn_idx%species%beg, eqn_idx%species%end + L(i) = lambda_factor*lambda2*dYs_ds(i - eqn_idx%species%beg + 1) end do end subroutine s_fill_chemistry_L @@ -151,8 +151,8 @@ contains real(wp), intent(in) :: rho, c, dpres_ds L(1) = f_base_L1(lambda, rho, c, dpres_ds, dvel_ds) - L(2:advxe - 1) = 0._wp - L(advxe) = L(1) + L(2:eqn_idx%adv%end - 1) = 0._wp + L(eqn_idx%adv%end) = L(1) end subroutine s_compute_slip_wall_L @@ -192,7 +192,7 @@ contains call s_fill_chemistry_L(L, lambda_factor, lambda(2), dYs_ds) lambda_factor = (5.e-1_wp - 5.e-1_wp*sign(1._wp, lambda(3))) - L(advxe) = lambda_factor*lambda(3)*(dpres_ds + rho*c*dvel_ds(dir_idx(1))) + L(eqn_idx%adv%end) = lambda_factor*lambda(3)*(dpres_ds + rho*c*dvel_ds(dir_idx(1))) end subroutine s_compute_nonreflecting_subsonic_buffer_L @@ -215,8 +215,8 @@ contains real(wp), intent(in) :: rho, c, dpres_ds L(1) = f_base_L1(lambda, rho, c, dpres_ds, dvel_ds) - L(2:advxe) = 0._wp - if (chemistry) L(chemxb:chemxe) = 0._wp + L(2:eqn_idx%adv%end) = 0._wp + if (chemistry) L(eqn_idx%species%beg:eqn_idx%species%end) = 0._wp end subroutine s_compute_nonreflecting_subsonic_inflow_L @@ -250,7 +250,7 @@ contains call s_fill_velocity_L(L, 1._wp, lambda(2), dvel_ds) call s_fill_advection_L(L, 1._wp, lambda(2), dadv_ds) call s_fill_chemistry_L(L, 1._wp, lambda(2), dYs_ds) - L(advxe) = 0._wp + L(eqn_idx%adv%end) = 0._wp end subroutine s_compute_nonreflecting_subsonic_outflow_L @@ -281,7 +281,7 @@ contains call s_fill_density_L(L, 1._wp, lambda(2), c, mf, dalpha_rho_ds, dpres_ds) call s_fill_velocity_L(L, 1._wp, lambda(2), dvel_ds) call s_fill_advection_L(L, 1._wp, lambda(2), dadv_ds) - L(advxe) = L(1) + 2._wp*rho*c*lambda(2)*dvel_ds(dir_idx(1)) + L(eqn_idx%adv%end) = L(1) + 2._wp*rho*c*lambda(2)*dvel_ds(dir_idx(1)) end subroutine s_compute_force_free_subsonic_outflow_L @@ -312,7 +312,7 @@ contains call s_fill_density_L(L, 1._wp, lambda(2), c, mf, dalpha_rho_ds, dpres_ds) call s_fill_velocity_L(L, 1._wp, lambda(2), dvel_ds) call s_fill_advection_L(L, 1._wp, lambda(2), dadv_ds) - L(advxe) = -L(1) + L(eqn_idx%adv%end) = -L(1) end subroutine s_compute_constant_pressure_subsonic_outflow_L @@ -325,8 +325,8 @@ contains #:else real(wp), dimension(sys_size), intent(inout) :: L #:endif - L(1:advxe) = 0._wp - if (chemistry) L(chemxb:chemxe) = 0._wp + L(1:eqn_idx%adv%end) = 0._wp + if (chemistry) L(eqn_idx%species%beg:eqn_idx%species%end) = 0._wp end subroutine s_compute_supersonic_inflow_L @@ -360,7 +360,7 @@ contains call s_fill_velocity_L(L, 1._wp, lambda(2), dvel_ds) call s_fill_advection_L(L, 1._wp, lambda(2), dadv_ds) call s_fill_chemistry_L(L, 1._wp, lambda(2), dYs_ds) - L(advxe) = lambda(3)*(dpres_ds + rho*c*dvel_ds(dir_idx(1))) + L(eqn_idx%adv%end) = lambda(3)*(dpres_ds + rho*c*dvel_ds(dir_idx(1))) end subroutine s_compute_supersonic_outflow_L diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 01f0d95100..80b11544ea 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -400,9 +400,10 @@ contains do i = 1, sys_size $:GPU_UPDATE(host='[q_prim_vf(i)%sf(:, :, :)]') end do - ! q_prim_vf(bubxb) stores the value of nb needed in riemann solvers, so replace with true primitive value (=1._wp) + ! q_prim_vf(eqn_idx%bub%beg) stores the value of nb needed in riemann solvers, so replace with true primitive value + ! (=1._wp) if (qbmm) then - q_prim_vf(bubxb)%sf = 1._wp + q_prim_vf(eqn_idx%bub%beg)%sf = 1._wp end if end if @@ -414,7 +415,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m ! todo: revisit change here - if (((i >= adv_idx%beg) .and. (i <= adv_idx%end))) then + if (((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end))) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) else write (2, FMT) x_cb(j), q_prim_vf(i)%sf(j, 0, 0) @@ -532,8 +533,8 @@ contains do j = 0, m do k = 0, n - if (((i >= cont_idx%beg) .and. (i <= cont_idx%end)) .or. ((i >= adv_idx%beg) .and. (i <= adv_idx%end)) & - & ) then + if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & + & .and. (i <= eqn_idx%adv%end))) then write (2, FMT) x_cb(j), y_cb(k), q_cons_vf(i)%sf(j, k, 0) else write (2, FMT) x_cb(j), y_cb(k), q_prim_vf(i)%sf(j, k, 0) @@ -627,8 +628,9 @@ contains do j = 0, m do k = 0, n do l = 0, p - if (((i >= cont_idx%beg) .and. (i <= cont_idx%end)) .or. ((i >= adv_idx%beg) & - & .and. (i <= adv_idx%end)) .or. ((i >= chemxb) .and. (i <= chemxe))) then + if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & + & .and. (i <= eqn_idx%adv%end)) .or. ((i >= eqn_idx%species%beg) & + & .and. (i <= eqn_idx%species%end))) then write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_cons_vf(i)%sf(j, k, l) else write (2, FMT) x_cb(j), y_cb(k), z_cb(l), q_prim_vf(i)%sf(j, k, l) @@ -1050,7 +1052,7 @@ contains if (chemistry) then do d = 1, num_species - rhoYks(d) = q_cons_vf(chemxb + d - 1)%sf(j - 2, k, l) + rhoYks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k, l) end do end if @@ -1062,43 +1064,44 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, rho, gamma, pi_inf, qv) end if do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k, l)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(damage_idx)%sf(j - 2, k, l) + damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k, l) G_local = G_local*max((1._wp - damage_state), 0._wp) end if - call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k, l), q_cons_vf(alf_idx)%sf(j - 2, k, l), dyn_p, pi_inf, & - & gamma, rho, qv, rhoYks(:), pres, T, q_cons_vf(stress_idx%beg)%sf(j - 2, k, l), & - & q_cons_vf(mom_idx%beg)%sf(j - 2, k, l), G_local) + call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l), dyn_p, & + & pi_inf, gamma, rho, qv, rhoYks(:), pres, T, & + & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k, l), & + & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k, l), G_local) else - call s_compute_pressure(q_cons_vf(E_idx)%sf(j - 2, k, l), q_cons_vf(alf_idx)%sf(j - 2, k, l), dyn_p, & - & pi_inf, gamma, rho, qv, rhoYks, pres, T) + call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l), & + & dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T) end if if (model_eqns == 4) then lit_gamma = gammas(1) else if (elasticity) then - tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho + tau_e(1) = q_cons_vf(eqn_idx%stress%end)%sf(j - 2, k, l)/rho end if if (bubbles_euler) then - alf = q_cons_vf(alf_idx)%sf(j - 2, k, l) + alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l) if (num_fluids == 3) then - alfgr = q_cons_vf(alf_idx - 1)%sf(j - 2, k, l) + alfgr = q_cons_vf(eqn_idx%alf - 1)%sf(j - 2, k, l) end if do s = 1, nb - nR(s) = q_cons_vf(bub_idx%rs(s))%sf(j - 2, k, l) - nRdot(s) = q_cons_vf(bub_idx%vs(s))%sf(j - 2, k, l) + nR(s) = q_cons_vf(qbmm_idx%rs(s))%sf(j - 2, k, l) + nRdot(s) = q_cons_vf(qbmm_idx%vs(s))%sf(j - 2, k, l) end do if (adv_n) then - nbub = q_cons_vf(n_idx)%sf(j - 2, k, l) + nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k, l) else nR3 = 0._wp do s = 1, nb @@ -1111,11 +1114,11 @@ contains print *, 'In probe, nbub: ', nbub #endif if (qbmm) then - M00 = q_cons_vf(bub_idx%moms(1, 1))%sf(j - 2, k, l)/nbub - M10 = q_cons_vf(bub_idx%moms(1, 2))%sf(j - 2, k, l)/nbub - M01 = q_cons_vf(bub_idx%moms(1, 3))%sf(j - 2, k, l)/nbub - M20 = q_cons_vf(bub_idx%moms(1, 4))%sf(j - 2, k, l)/nbub - M02 = q_cons_vf(bub_idx%moms(1, 6))%sf(j - 2, k, l)/nbub + M00 = q_cons_vf(qbmm_idx%moms(1, 1))%sf(j - 2, k, l)/nbub + M10 = q_cons_vf(qbmm_idx%moms(1, 2))%sf(j - 2, k, l)/nbub + M01 = q_cons_vf(qbmm_idx%moms(1, 3))%sf(j - 2, k, l)/nbub + M20 = q_cons_vf(qbmm_idx%moms(1, 4))%sf(j - 2, k, l)/nbub + M02 = q_cons_vf(qbmm_idx%moms(1, 6))%sf(j - 2, k, l)/nbub M10 = M10/M00 M01 = M01/M00 @@ -1141,7 +1144,7 @@ contains else if (p == 0) then if (chemistry) then do d = 1, num_species - rhoYks(d) = q_cons_vf(chemxb + d - 1)%sf(j - 2, k - 2, l) + rhoYks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k - 2, l) end do end if @@ -1165,24 +1168,24 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l, rho, gamma, pi_inf, qv, Re, G_local, & & fluid_pp(:)%G) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(damage_idx)%sf(j - 2, k - 2, l) + damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k - 2, l) G_local = G_local*max((1._wp - damage_state), 0._wp) end if - call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l), q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & + call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l), & & dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, & - & q_cons_vf(stress_idx%beg)%sf(j - 2, k - 2, l), & - & q_cons_vf(mom_idx%beg)%sf(j - 2, k - 2, l), G_local) + & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k - 2, l), & + & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k - 2, l), G_local) else - call s_compute_pressure(q_cons_vf(E_idx)%sf(j - 2, k - 2, l), q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & - & dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T) + call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k - 2, l), q_cons_vf(eqn_idx%alf)%sf(j - 2, & + & k - 2, l), dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T) end if if (model_eqns == 4) then @@ -1194,14 +1197,14 @@ contains end if if (bubbles_euler) then - alf = q_cons_vf(alf_idx)%sf(j - 2, k - 2, l) + alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l) do s = 1, nb - nR(s) = q_cons_vf(bub_idx%rs(s))%sf(j - 2, k - 2, l) - nRdot(s) = q_cons_vf(bub_idx%vs(s))%sf(j - 2, k - 2, l) + nR(s) = q_cons_vf(qbmm_idx%rs(s))%sf(j - 2, k - 2, l) + nRdot(s) = q_cons_vf(qbmm_idx%vs(s))%sf(j - 2, k - 2, l) end do if (adv_n) then - nbub = q_cons_vf(n_idx)%sf(j - 2, k - 2, l) + nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k - 2, l) else nR3 = 0._wp do s = 1, nb @@ -1246,30 +1249,31 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l - 2, rho, gamma, pi_inf, qv, Re, & & G_local, fluid_pp(:)%G) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l - 2)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l - 2)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (chemistry) then do d = 1, num_species - rhoYks(d) = q_cons_vf(chemxb + d - 1)%sf(j - 2, k - 2, l - 2) + rhoYks(d) = q_cons_vf(eqn_idx%species%beg + d - 1)%sf(j - 2, k - 2, l - 2) end do end if if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(damage_idx)%sf(j - 2, k - 2, l - 2) + damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k - 2, l - 2) G_local = G_local*max((1._wp - damage_state), 0._wp) end if - call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l - 2), q_cons_vf(alf_idx)%sf(j - 2, k - 2, & - & l - 2), dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, & - & q_cons_vf(stress_idx%beg)%sf(j - 2, k - 2, l - 2), & - & q_cons_vf(mom_idx%beg)%sf(j - 2, k - 2, l - 2), G_local) + call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l - 2), q_cons_vf(eqn_idx%alf)%sf(j - 2, & + & k - 2, l - 2), dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, & + & q_cons_vf(eqn_idx%stress%beg)%sf(j - 2, k - 2, l - 2), & + & q_cons_vf(eqn_idx%mom%beg)%sf(j - 2, k - 2, l - 2), G_local) else - call s_compute_pressure(q_cons_vf(E_idx)%sf(j - 2, k - 2, l - 2), q_cons_vf(alf_idx)%sf(j - 2, & - & k - 2, l - 2), dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T) + call s_compute_pressure(q_cons_vf(eqn_idx%E)%sf(j - 2, k - 2, l - 2), & + & q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l - 2), dyn_p, pi_inf, gamma, & + & rho, qv, rhoYks, pres, T) end if ! Compute mixture sound speed @@ -1389,11 +1393,11 @@ contains npts = npts + 1 call s_convert_to_mixture_variables(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv, Re) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho end do - pres = ((q_cons_vf(E_idx)%sf(j, k, l) - 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, & - & l)**2._wp)/rho)/(1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - pi_inf - qv)/gamma + pres = ((q_cons_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, & + & l)**2._wp)/rho)/(1._wp - q_cons_vf(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma int_pres = int_pres + (pres - 1._wp)**2._wp end if end do @@ -1452,11 +1456,11 @@ contains npts = npts + 1 call s_convert_to_mixture_variables(q_cons_vf, j, k, l, rho, gamma, pi_inf, qv, Re) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho end do - pres = ((q_cons_vf(E_idx)%sf(j, k, l) - 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, & - & l)**2._wp)/rho)/(1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - pi_inf - qv)/gamma + pres = ((q_cons_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, & + & l)**2._wp)/rho)/(1._wp - q_cons_vf(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma int_pres = int_pres + abs(pres - 1._wp) max_pres = max(max_pres, abs(pres - 1._wp)) end if diff --git a/src/simulation/m_derived_variables.fpp b/src/simulation/m_derived_variables.fpp index d0be1a8426..22c0477065 100644 --- a/src/simulation/m_derived_variables.fpp +++ b/src/simulation/m_derived_variables.fpp @@ -159,8 +159,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(momxb)%sf(j, k, l) - 18._wp*q_prim_vf1(momxb)%sf(j, k, & - & l) + 9._wp*q_prim_vf2(momxb)%sf(j, k, l) - 2._wp*q_prim_vf3(momxb)%sf(j, k, l))/(6._wp*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, & + & l) - 18._wp*q_prim_vf1(eqn_idx%mom%beg)%sf(j, k, l) + 9._wp*q_prim_vf2(eqn_idx%mom%beg)%sf(j, k, & + & l) - 2._wp*q_prim_vf3(eqn_idx%mom%beg)%sf(j, k, l))/(6._wp*dt) end do end do end do @@ -172,8 +173,8 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb)%sf(r + j, k, l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg)%sf(r + j, k, l) end do end do end do @@ -185,9 +186,9 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxb)%sf(j, r + k, l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & + & l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, r + k, l) end do end do end do @@ -200,10 +201,11 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxb)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, l)*fd_coeff_z(r, & - & l)*q_prim_vf0(momxb)%sf(j, k, r + l)/y_cc(k) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, & + & k, l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, r + k, & + & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & + & l)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, r + l)/y_cc(k) end do end do end do @@ -215,10 +217,11 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxb)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, l)*fd_coeff_z(r, & - & l)*q_prim_vf0(momxb)%sf(j, k, r + l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, & + & k, l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, r + k, & + & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & + & l)*q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, r + l) end do end do end do @@ -232,8 +235,10 @@ contains do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(momxb + 1)%sf(j, k, l) - 18._wp*q_prim_vf1(momxb + 1)%sf(j, k, & - & l) + 9._wp*q_prim_vf2(momxb + 1)%sf(j, k, l) - 2._wp*q_prim_vf3(momxb + 1)%sf(j, k, l))/(6._wp*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & + & l) - 18._wp*q_prim_vf1(eqn_idx%mom%beg + 1)%sf(j, k, & + & l) + 9._wp*q_prim_vf2(eqn_idx%mom%beg + 1)%sf(j, k, & + & l) - 2._wp*q_prim_vf3(eqn_idx%mom%beg + 1)%sf(j, k, l))/(6._wp*dt) end do end do end do @@ -245,9 +250,9 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb + 1)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxb + 1)%sf(j, r + k, l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, & + & k, l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, r + k, l) end do end do end do @@ -260,11 +265,12 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb + 1)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, & - & l)*fd_coeff_y(r, k)*q_prim_vf0(momxb + 1)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, & - & l)*fd_coeff_z(r, l)*q_prim_vf0(momxb + 1)%sf(j, k, & - & r + l)/y_cc(k) - (q_prim_vf0(momxe)%sf(j, k, l)**2._wp)/y_cc(k) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(r + j, k, & + & l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l)*fd_coeff_y(r, & + & k)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, r + k, l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, & + & k, l)*fd_coeff_z(r, l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & + & r + l)/y_cc(k) - (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)**2._wp)/y_cc(k) end do end do end do @@ -276,10 +282,11 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxb + 1)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, & - & l)*fd_coeff_y(r, k)*q_prim_vf0(momxb + 1)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, & - & l)*fd_coeff_z(r, l)*q_prim_vf0(momxb + 1)%sf(j, k, r + l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(r + j, k, & + & l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l)*fd_coeff_y(r, & + & k)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, r + k, l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, & + & k, l)*fd_coeff_z(r, l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, r + l) end do end do end do @@ -293,8 +300,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(momxe)%sf(j, k, l) - 18._wp*q_prim_vf1(momxe)%sf(j, k, & - & l) + 9._wp*q_prim_vf2(momxe)%sf(j, k, l) - 2._wp*q_prim_vf3(momxe)%sf(j, k, l))/(6._wp*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & + & l) - 18._wp*q_prim_vf1(eqn_idx%mom%end)%sf(j, k, l) + 9._wp*q_prim_vf2(eqn_idx%mom%end)%sf(j, k, & + & l) - 2._wp*q_prim_vf3(eqn_idx%mom%end)%sf(j, k, l))/(6._wp*dt) end do end do end do @@ -306,11 +314,13 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxe)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxe)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, l)*fd_coeff_z(r, & - & l)*q_prim_vf0(momxe)%sf(j, k, r + l)/y_cc(k) + (q_prim_vf0(momxe)%sf(j, k, & - & l)*q_prim_vf0(momxb + 1)%sf(j, k, l))/y_cc(k) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%end)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & + & l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%end)%sf(j, r + k, & + & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & + & l)*q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & + & r + l)/y_cc(k) + (q_prim_vf0(eqn_idx%mom%end)%sf(j, k, & + & l)*q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, l))/y_cc(k) end do end do end do @@ -322,10 +332,11 @@ contains do k = 0, n do j = 0, m do r = -fd_number, fd_number - q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(momxb)%sf(j, k, l)*fd_coeff_x(r, & - & j)*q_prim_vf0(momxe)%sf(r + j, k, l) + q_prim_vf0(momxb + 1)%sf(j, k, l)*fd_coeff_y(r, & - & k)*q_prim_vf0(momxe)%sf(j, r + k, l) + q_prim_vf0(momxe)%sf(j, k, l)*fd_coeff_z(r, & - & l)*q_prim_vf0(momxe)%sf(j, k, r + l) + q_sf(j, k, l) = q_sf(j, k, l) + q_prim_vf0(eqn_idx%mom%beg)%sf(j, k, l)*fd_coeff_x(r, & + & j)*q_prim_vf0(eqn_idx%mom%end)%sf(r + j, k, l) + q_prim_vf0(eqn_idx%mom%beg + 1)%sf(j, k, & + & l)*fd_coeff_y(r, k)*q_prim_vf0(eqn_idx%mom%end)%sf(j, r + k, & + & l) + q_prim_vf0(eqn_idx%mom%end)%sf(j, k, l)*fd_coeff_z(r, & + & l)*q_prim_vf0(eqn_idx%mom%end)%sf(j, k, r + l) end do end do end do @@ -365,7 +376,7 @@ contains c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ! Volume fraction $:GPU_ATOMIC(atomic='update') - c_m(i, 5) = c_m(i, 5) + q_vf(i + advxb - 1)%sf(j, k, l)*dV + c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV end do end do end do @@ -390,7 +401,7 @@ contains c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ! Volume fraction $:GPU_ATOMIC(atomic='update') - c_m(i, 5) = c_m(i, 5) + q_vf(i + advxb - 1)%sf(j, k, l)*dV + c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV end do end do end do @@ -418,7 +429,7 @@ contains c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) ! Volume fraction $:GPU_ATOMIC(atomic='update') - c_m(i, 5) = c_m(i, 5) + q_vf(i + advxb - 1)%sf(j, k, l)*dV + c_m(i, 5) = c_m(i, 5) + q_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*dV end do end do end do diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 079d36ebc2..9107a0869c 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -249,30 +249,13 @@ module m_global_parameters !> @name Annotations of the structure of the state and flux vectors in terms of the size and the configuration of the system of !! equations to which they belong !> @{ - integer :: sys_size !< Number of unknowns in system of eqns. - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of energy equation - integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: alf_idx !< Index of void fraction - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: B_idx !< Indexes of first and last magnetic field eqns. - type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. - type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: b_size !< Number of elements in the symmetric b tensor, plus one - integer :: tensor_size !< Number of elements in the full tensor plus one - type(int_bounds_info) :: species_idx !< Indexes of first & last concentration eqns. - integer :: c_idx !< Index of color function - integer :: damage_idx !< Index of damage state variable (D) for continuum damage model - integer :: psi_idx !< Index of hyperbolic cleaning state variable for MHD + integer :: sys_size !< Number of unknowns in system of eqns. + type(eqn_idx_info) :: eqn_idx !< All conserved-variable equation index ranges and scalars. + type(qbmm_idx_info) :: qbmm_idx !< QBMM moment index mappings (allocatable; GPU-managed separately). + integer :: b_size !< Number of elements in the symmetric b tensor, plus one + integer :: tensor_size !< Number of elements in the full tensor plus one !> @} - $:GPU_DECLARE(create='[sys_size, E_idx, n_idx, bub_idx, alf_idx, gamma_idx]') - $:GPU_DECLARE(create='[pi_inf_idx, B_idx, stress_idx, xi_idx, b_size]') - $:GPU_DECLARE(create='[tensor_size, species_idx, c_idx]') + $:GPU_DECLARE(create='[sys_size, eqn_idx, b_size, tensor_size]') ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). Stands for "InDices With INTerior". type(int_bounds_info) :: idwint(1:3) @@ -444,19 +427,6 @@ module m_global_parameters $:GPU_DECLARE(create='[sigma, surface_tension]') !> @} - integer :: momxb, momxe - integer :: advxb, advxe - integer :: contxb, contxe - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe - integer :: chemxb, chemxe - integer :: xibeg, xiend - $:GPU_DECLARE(create='[momxb, momxe, advxb, advxe, contxb, contxe]') - $:GPU_DECLARE(create='[intxb, intxe, bubxb, bubxe]') - $:GPU_DECLARE(create='[strxb, strxe, chemxb, chemxe]') - $:GPU_DECLARE(create='[xibeg, xiend]') - real(wp), allocatable, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps $:GPU_DECLARE(create='[gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps]') @@ -871,83 +841,83 @@ contains if (model_eqns == 1) then ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end ! Volume Fraction Model else ! Annotating structure of the state and flux vectors belonging to the system of equations defined by the selected number ! of spatial dimensions and the volume fraction model if (model_eqns == 2) then - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 if (igr) then ! IGR: volume fractions after energy (N-1 for N fluids; skipped when num_fluids=1) - adv_idx%beg = E_idx + 1 ! Alpha for fluid 1 - adv_idx%end = E_idx + num_fluids - 1 + eqn_idx%adv%beg = eqn_idx%E + 1 ! Alpha for fluid 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids - 1 else ! Volume fractions are stored in the indices immediately following the energy equation. WENO/MUSCL + Riemann - ! tracks a total of (N) volume fractions for N fluids, hence the lack of "-1" in adv_idx%end - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + ! tracks a total of (N) volume fractions for N fluids, hence the lack of "-1" in eqn_idx%adv%end + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = sys_size + 1 if (qbmm) then nmomsp = 4 ! number of special moments if (nnode == 4) then ! nmom = 6 : It is already a parameter nmomtot = nmom*nb end if - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + @:ALLOCATE(qbmm_idx%ps(nb), qbmm_idx%ms(nb)) gam = bub_pp%gam_g if (qbmm) then - @:ALLOCATE(bub_idx%moms(nb, nmom)) + @:ALLOCATE(qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - bub_idx%moms(i, j) = bub_idx%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%rs(i) = bub_idx%moms(i, 2) - bub_idx%vs(i) = bub_idx%moms(i, 3) + qbmm_idx%rs(i) = qbmm_idx%moms(i, 2) + qbmm_idx%vs(i) = qbmm_idx%moms(i, 3) end do else do i = 1, nb @@ -957,59 +927,59 @@ contains fac = 2 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do end if end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = eqn_idx%B%end end if else if (model_eqns == 3) then - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - alf_idx = adv_idx%end - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%alf = eqn_idx%adv%end + eqn_idx%int_en%beg = eqn_idx%adv%end + 1 + eqn_idx%int_en%end = eqn_idx%adv%end + num_fluids + sys_size = eqn_idx%int_en%end else if (model_eqns == 4) then - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 ! num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each direction - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - alf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 ! num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each direction + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg ! one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + @:ALLOCATE(qbmm_idx%ps(nb), qbmm_idx%ms(nb)) do i = 1, nb if (polytropic) then @@ -1018,12 +988,12 @@ contains fac = 4 end if - bub_idx%rs(i) = bub_idx%beg + (i - 1)*fac - bub_idx%vs(i) = bub_idx%rs(i) + 1 + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - bub_idx%ps(i) = bub_idx%vs(i) + 1 - bub_idx%ms(i) = bub_idx%ps(i) + 1 + qbmm_idx%ps(i) = qbmm_idx%vs(i) + 1 + qbmm_idx%ms(i) = qbmm_idx%ps(i) + 1 end if end do end if @@ -1066,24 +1036,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = sys_size + 1 + eqn_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2,1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1,1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2,1:2) = shear_indices((/1, 3/)) @@ -1098,34 +1068,34 @@ contains b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%xi%beg = sys_size + 1 + eqn_idx%xi%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi end if end if ! END: Volume Fraction Model if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = sys_size + 1 + eqn_idx%species%end = sys_size + num_species + sys_size = eqn_idx%species%end end if if (bubbles_euler .and. qbmm .and. .not. polytropic) then @@ -1200,35 +1170,15 @@ contains grid_geometry = 3 end if - momxb = mom_idx%beg - momxe = mom_idx%end - advxb = adv_idx%beg - advxe = adv_idx%end - contxb = cont_idx%beg - contxe = cont_idx%end - bubxb = bub_idx%beg - bubxe = bub_idx%end - strxb = stress_idx%beg - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end - xibeg = xi_idx%beg - xiend = xi_idx%end - chemxb = species_idx%beg - chemxe = species_idx%end - - $:GPU_UPDATE(device='[momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, & - & alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, c_idx, adap_dt_tol, & - & adap_dt_max_iters]') - $:GPU_UPDATE(device='[b_size, xibeg, xiend, tensor_size]') - - $:GPU_UPDATE(device='[species_idx]') + $:GPU_UPDATE(device='[sys_size, buff_size, eqn_idx, adv_n, adap_dt, pi_fac, adap_dt_tol, adap_dt_max_iters]') + $:GPU_UPDATE(device='[b_size, tensor_size]') + $:GPU_UPDATE(device='[cfl_target, m, n, p]') $:GPU_UPDATE(device='[alt_soundspeed, acoustic_source, num_source]') - $:GPU_UPDATE(device='[dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, & - & bubbles_euler, hypoelasticity, alt_soundspeed, avg_state, model_eqns, mixture_err, grid_geometry, & - & cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, hyper_model, elasticity, xi_idx, B_idx, low_Mach]') + $:GPU_UPDATE(device='[dt, sys_size, buff_size, pref, rhoref, eqn_idx, mpp_lim, bubbles_euler, hypoelasticity, & + & alt_soundspeed, avg_state, model_eqns, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, & + & hyperelasticity, hyper_model, elasticity, low_Mach]') $:GPU_UPDATE(device='[Bx0]') @@ -1326,6 +1276,13 @@ contains @:DEALLOCATE(Re_idx) end if + if (bubbles_euler) then + @:DEALLOCATE(qbmm_idx%rs, qbmm_idx%vs, qbmm_idx%ps, qbmm_idx%ms) + if (qbmm) then + @:DEALLOCATE(qbmm_idx%moms) + end if + end if + deallocate (proc_coords) if (parallel_io) then deallocate (start_idx) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 22c2aace73..90e78d04df 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -116,17 +116,17 @@ contains $:GPU_LOOP(parallelism='[seq]') do r = -fd_number, fd_number ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) - tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) + tensora(1) = tensora(1) + q_prim_vf(eqn_idx%xi%beg)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) + tensora(2) = tensora(2) + q_prim_vf(eqn_idx%xi%beg + 1)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) + tensora(3) = tensora(3) + q_prim_vf(eqn_idx%xi%end)%sf(j + r, k, l)*fd_coeff_x_hyper(r, j) ! derivatives in the y-direction - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) + tensora(4) = tensora(4) + q_prim_vf(eqn_idx%xi%beg)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) + tensora(5) = tensora(5) + q_prim_vf(eqn_idx%xi%beg + 1)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) + tensora(6) = tensora(6) + q_prim_vf(eqn_idx%xi%end)%sf(j, k + r, l)*fd_coeff_y_hyper(r, k) ! derivatives in the z-direction - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) + tensora(7) = tensora(7) + q_prim_vf(eqn_idx%xi%beg)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) + tensora(8) = tensora(8) + q_prim_vf(eqn_idx%xi%beg + 1)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) + tensora(9) = tensora(9) + q_prim_vf(eqn_idx%xi%end)%sf(j, k, l + r)*fd_coeff_z_hyper(r, l) end do ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) @@ -173,12 +173,13 @@ contains call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G_local, j, k, l) end if ! STEP 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - G_local*q_prim_vf(xiend + 1)%sf(j, k, & - & l)/gamma + q_prim_vf(eqn_idx%E)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, & + & l) - G_local*q_prim_vf(eqn_idx%xi%end + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field $:GPU_LOOP(parallelism='[seq]') do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + q_cons_vf(eqn_idx%stress%beg + i - 1)%sf(j, k, & + & l) = rho*q_prim_vf(eqn_idx%stress%beg + i - 1)%sf(j, k, l) end do end if end if @@ -210,10 +211,10 @@ contains ! dividing by the jacobian for neo-Hookean model setting the tensor to the stresses for riemann solver $:GPU_LOOP(parallelism='[seq]') do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = G_param*btensor_in(i)%sf(j, k, l)/btensor_in(b_size)%sf(j, k, l) + q_prim_vf(eqn_idx%stress%beg + i - 1)%sf(j, k, l) = G_param*btensor_in(i)%sf(j, k, l)/btensor_in(b_size)%sf(j, k, l) end do ! First invariant strain energy: W = G/2 * (I1 - 3), neo-Hookean model - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5_wp*(trace - 3.0_wp)/btensor_in(b_size)%sf(j, k, l) + q_prim_vf(eqn_idx%xi%end + 1)%sf(j, k, l) = 0.5_wp*(trace - 3.0_wp)/btensor_in(b_size)%sf(j, k, l) end subroutine s_neoHookean_cauchy_solver @@ -239,10 +240,10 @@ contains ! dividing by the jacobian for neo-Hookean model setting the tensor to the stresses for riemann solver $:GPU_LOOP(parallelism='[seq]') do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = G_param*btensor_in(i)%sf(j, k, l)/btensor_in(b_size)%sf(j, k, l) + q_prim_vf(eqn_idx%stress%beg + i - 1)%sf(j, k, l) = G_param*btensor_in(i)%sf(j, k, l)/btensor_in(b_size)%sf(j, k, l) end do ! First invariant strain energy: W = G/2 * (I1 - 3), neo-Hookean model - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5_wp*(trace - 3.0_wp)/btensor_in(b_size)%sf(j, k, l) + q_prim_vf(eqn_idx%xi%end + 1)%sf(j, k, l) = 0.5_wp*(trace - 3.0_wp)/btensor_in(b_size)%sf(j, k, l) end subroutine s_Mooney_Rivlin_cauchy_solver diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index d38741934e..0db72fa50e 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -109,7 +109,8 @@ contains do k = 0, m $:GPU_LOOP(parallelism='[seq]') do r = -fd_number, fd_number - du_dx_hypo(k, l, q) = du_dx_hypo(k, l, q) + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x_hypo(r, k) + du_dx_hypo(k, l, q) = du_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k + r, l, & + & q)*fd_coeff_x_hypo(r, k) end do end do end do @@ -133,10 +134,11 @@ contains do k = 0, m $:GPU_LOOP(parallelism='[seq]') do r = -fd_number, fd_number - du_dy_hypo(k, l, q) = du_dy_hypo(k, l, q) + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y_hypo(r, l) - dv_dx_hypo(k, l, q) = dv_dx_hypo(k, l, q) + q_prim_vf(momxb + 1)%sf(k + r, l, & + du_dy_hypo(k, l, q) = du_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k, l + r, & + & q)*fd_coeff_y_hypo(r, l) + dv_dx_hypo(k, l, q) = dv_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k + r, l, & & q)*fd_coeff_x_hypo(r, k) - dv_dy_hypo(k, l, q) = dv_dy_hypo(k, l, q) + q_prim_vf(momxb + 1)%sf(k, l + r, & + dv_dy_hypo(k, l, q) = dv_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l + r, & & q)*fd_coeff_y_hypo(r, l) end do end do @@ -163,15 +165,15 @@ contains do k = 0, m $:GPU_LOOP(parallelism='[seq]') do r = -fd_number, fd_number - du_dz_hypo(k, l, q) = du_dz_hypo(k, l, q) + q_prim_vf(momxb)%sf(k, l, & + du_dz_hypo(k, l, q) = du_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg)%sf(k, l, & & q + r)*fd_coeff_z_hypo(r, q) - dv_dz_hypo(k, l, q) = dv_dz_hypo(k, l, q) + q_prim_vf(momxb + 1)%sf(k, l, & + dv_dz_hypo(k, l, q) = dv_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, & & q + r)*fd_coeff_z_hypo(r, q) - dw_dx_hypo(k, l, q) = dw_dx_hypo(k, l, q) + q_prim_vf(momxe)%sf(k + r, l, & + dw_dx_hypo(k, l, q) = dw_dx_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k + r, l, & & q)*fd_coeff_x_hypo(r, k) - dw_dy_hypo(k, l, q) = dw_dy_hypo(k, l, q) + q_prim_vf(momxe)%sf(k, l + r, & + dw_dy_hypo(k, l, q) = dw_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k, l + r, & & q)*fd_coeff_y_hypo(r, l) - dw_dz_hypo(k, l, q) = dw_dz_hypo(k, l, q) + q_prim_vf(momxe)%sf(k, l, & + dw_dz_hypo(k, l, q) = dw_dz_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%end)%sf(k, l, & & q + r)*fd_coeff_z_hypo(r, q) end do end do @@ -188,11 +190,11 @@ contains rho_K = 0._wp; G_K = 0._wp do i = 1, num_fluids rho_K = rho_K + q_prim_vf(i)%sf(k, l, q) ! alpha_rho_K(1) - G_K = G_K + q_prim_vf(advxb - 1 + i)%sf(k, l, q)*Gs_hypo(i) ! alpha_K(1) * Gs_hypo(1) + G_K = G_K + q_prim_vf(eqn_idx%adv%beg - 1 + i)%sf(k, l, q)*Gs_hypo(i) ! alpha_K(1) * Gs_hypo(1) end do ! Continuum damage: (1-D) scales effective stiffness, D in [0,1] - if (cont_damage) G_K = G_K*max((1._wp - q_prim_vf(damage_idx)%sf(k, l, q)), 0._wp) + if (cont_damage) G_K = G_K*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(k, l, q)), 0._wp) rho_K_field(k, l, q) = rho_K G_K_field(k, l, q) = G_K @@ -211,8 +213,9 @@ contains do q = 0, p do l = 0, n do k = 0, m - rhs_vf(strxb)%sf(k, l, q) = rhs_vf(strxb)%sf(k, l, q) + rho_K_field(k, l, q)*((4._wp*G_K_field(k, l, & - & q)/3._wp) + q_prim_vf(strxb)%sf(k, l, q))*du_dx_hypo(k, l, q) + rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_K_field(k, l, & + & q)*((4._wp*G_K_field(k, l, q)/3._wp) + q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q))*du_dx_hypo(k, & + & l, q) end do end do end do @@ -222,25 +225,27 @@ contains do q = 0, p do l = 0, n do k = 0, m - rhs_vf(strxb)%sf(k, l, q) = rhs_vf(strxb)%sf(k, l, q) + rho_K_field(k, l, q)*(q_prim_vf(strxb + 1)%sf(k, & - & l, q)*du_dy_hypo(k, l, q) + q_prim_vf(strxb + 1)%sf(k, l, q)*du_dy_hypo(k, l, & - & q) - q_prim_vf(strxb)%sf(k, l, q)*dv_dy_hypo(k, l, q) - 2._wp*G_K_field(k, l, & + rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_K_field(k, l, & + & q)*(q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dy_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dy_hypo(k, l, q) - 2._wp*G_K_field(k, l, & & q)*(1._wp/3._wp)*dv_dy_hypo(k, l, q)) - rhs_vf(strxb + 1)%sf(k, l, q) = rhs_vf(strxb + 1)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 1)%sf(k, l, q)*du_dx_hypo(k, l, q) + q_prim_vf(strxb)%sf(k, l, & - & q)*dv_dx_hypo(k, l, q) - q_prim_vf(strxb + 1)%sf(k, l, q)*du_dx_hypo(k, l, & - & q) + q_prim_vf(strxb + 2)%sf(k, l, q)*du_dy_hypo(k, l, q) + q_prim_vf(strxb + 1)%sf(k, l, & - & q)*dv_dy_hypo(k, l, q) - q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dy_hypo(k, l, & - & q) + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dy_hypo(k, l, q) + dv_dx_hypo(k, l, q))) - - rhs_vf(strxb + 2)%sf(k, l, q) = rhs_vf(strxb + 2)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dx_hypo(k, l, q) + q_prim_vf(strxb + 1)%sf(k, l, & - & q)*dv_dx_hypo(k, l, q) - q_prim_vf(strxb + 2)%sf(k, l, q)*du_dx_hypo(k, l, & - & q) + q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy_hypo(k, l, q) + q_prim_vf(strxb + 2)%sf(k, l, & - & q)*dv_dy_hypo(k, l, q) - q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy_hypo(k, l, & - & q) + 2._wp*G_K_field(k, l, q)*(dv_dy_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, & - & q) + dv_dy_hypo(k, l, q)))) + rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dv_dx_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dy_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dy_hypo(k, l, q) + 2._wp*G_K_field(k, l, & + & q)*(1._wp/2._wp)*(du_dy_hypo(k, l, q) + dv_dx_hypo(k, l, q))) + + rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dv_dx_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dv_dy_hypo(k, l, q) + 2._wp*G_K_field(k, l, & + & q)*(dv_dy_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q)))) end do end do end do @@ -250,46 +255,56 @@ contains do q = 0, p do l = 0, n do k = 0, m - rhs_vf(strxb)%sf(k, l, q) = rhs_vf(strxb)%sf(k, l, q) + rho_K_field(k, l, q)*(q_prim_vf(strxb + 3)%sf(k, & - & l, q)*du_dz_hypo(k, l, q) + q_prim_vf(strxb + 3)%sf(k, l, q)*du_dz_hypo(k, l, & - & q) - q_prim_vf(strxb)%sf(k, l, q)*dw_dz_hypo(k, l, q) - 2._wp*G_K_field(k, l, & + rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) + rho_K_field(k, l, & + & q)*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*du_dz_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*du_dz_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dw_dz_hypo(k, l, q) - 2._wp*G_K_field(k, l, & + & q)*(1._wp/3._wp)*dw_dz_hypo(k, l, q)) + + rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dz_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dz_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dz_hypo(k, l, q)) + + rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dv_dz_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dv_dz_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dw_dz_hypo(k, l, q) - 2._wp*G_K_field(k, l, & & q)*(1._wp/3._wp)*dw_dz_hypo(k, l, q)) - rhs_vf(strxb + 1)%sf(k, l, q) = rhs_vf(strxb + 1)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 4)%sf(k, l, q)*du_dz_hypo(k, l, q) + q_prim_vf(strxb + 3)%sf(k, l, & - & q)*dv_dz_hypo(k, l, q) - q_prim_vf(strxb + 1)%sf(k, l, q)*dw_dz_hypo(k, l, q)) - - rhs_vf(strxb + 2)%sf(k, l, q) = rhs_vf(strxb + 2)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 4)%sf(k, l, q)*dv_dz_hypo(k, l, q) + q_prim_vf(strxb + 4)%sf(k, l, & - & q)*dv_dz_hypo(k, l, q) - q_prim_vf(strxb + 2)%sf(k, l, q)*dw_dz_hypo(k, l, & - & q) - 2._wp*G_K_field(k, l, q)*(1._wp/3._wp)*dw_dz_hypo(k, l, q)) - - rhs_vf(strxb + 3)%sf(k, l, q) = rhs_vf(strxb + 3)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 3)%sf(k, l, q)*du_dx_hypo(k, l, q) + q_prim_vf(strxb)%sf(k, l, & - & q)*dw_dx_hypo(k, l, q) - q_prim_vf(strxb + 3)%sf(k, l, q)*du_dx_hypo(k, l, & - & q) + q_prim_vf(strxb + 4)%sf(k, l, q)*du_dy_hypo(k, l, q) + q_prim_vf(strxb + 1)%sf(k, l, & - & q)*dw_dy_hypo(k, l, q) - q_prim_vf(strxb + 3)%sf(k, l, q)*dv_dy_hypo(k, l, & - & q) + q_prim_vf(strxb + 5)%sf(k, l, q)*du_dz_hypo(k, l, q) + q_prim_vf(strxb + 3)%sf(k, l, & - & q)*dw_dz_hypo(k, l, q) - q_prim_vf(strxb + 3)%sf(k, l, q)*dw_dz_hypo(k, l, & - & q) + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dz_hypo(k, l, q) + dw_dx_hypo(k, l, q))) - - rhs_vf(strxb + 4)%sf(k, l, q) = rhs_vf(strxb + 4)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(q_prim_vf(strxb + 3)%sf(k, l, q)*dv_dx_hypo(k, l, q) + q_prim_vf(strxb + 1)%sf(k, l, & - & q)*dw_dx_hypo(k, l, q) - q_prim_vf(strxb + 4)%sf(k, l, q)*du_dx_hypo(k, l, & - & q) + q_prim_vf(strxb + 4)%sf(k, l, q)*dv_dy_hypo(k, l, q) + q_prim_vf(strxb + 2)%sf(k, l, & - & q)*dw_dy_hypo(k, l, q) - q_prim_vf(strxb + 4)%sf(k, l, q)*dv_dy_hypo(k, l, & - & q) + q_prim_vf(strxb + 5)%sf(k, l, q)*dv_dz_hypo(k, l, q) + q_prim_vf(strxb + 4)%sf(k, l, & - & q)*dw_dz_hypo(k, l, q) - q_prim_vf(strxb + 4)%sf(k, l, q)*dw_dz_hypo(k, l, & - & q) + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(dv_dz_hypo(k, l, q) + dw_dy_hypo(k, l, q))) - - rhs_vf(strxe)%sf(k, l, q) = rhs_vf(strxe)%sf(k, l, q) + rho_K_field(k, l, q)*(q_prim_vf(strxe - 2)%sf(k, & - & l, q)*dw_dx_hypo(k, l, q) + q_prim_vf(strxe - 2)%sf(k, l, q)*dw_dx_hypo(k, l, & - & q) - q_prim_vf(strxe)%sf(k, l, q)*du_dx_hypo(k, l, q) + q_prim_vf(strxe - 1)%sf(k, l, & - & q)*dw_dy_hypo(k, l, q) + q_prim_vf(strxe - 1)%sf(k, l, q)*dw_dy_hypo(k, l, & - & q) - q_prim_vf(strxe)%sf(k, l, q)*dv_dy_hypo(k, l, q) + q_prim_vf(strxe)%sf(k, l, & - & q)*dw_dz_hypo(k, l, q) + q_prim_vf(strxe)%sf(k, l, q)*dw_dz_hypo(k, l, & - & q) - q_prim_vf(strxe)%sf(k, l, q)*dw_dz_hypo(k, l, q) + 2._wp*G_K_field(k, l, q)*(dw_dz_hypo(k, & - & l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q) + dw_dz_hypo(k, l, q)))) + rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg)%sf(k, l, q)*dw_dx_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dy_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)*du_dz_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dw_dz_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dw_dz_hypo(k, l, q) + 2._wp*G_K_field(k, l, & + & q)*(1._wp/2._wp)*(du_dz_hypo(k, l, q) + dw_dx_hypo(k, l, q))) + + rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q)*dv_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)*dw_dx_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dv_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)*dw_dy_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dv_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 5)%sf(k, l, q)*dv_dz_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dw_dz_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%beg + 4)%sf(k, l, q)*dw_dz_hypo(k, l, q) + 2._wp*G_K_field(k, l, & + & q)*(1._wp/2._wp)*(dv_dz_hypo(k, l, q) + dw_dy_hypo(k, l, q))) + + rhs_vf(eqn_idx%stress%end)%sf(k, l, q) = rhs_vf(eqn_idx%stress%end)%sf(k, l, q) + rho_K_field(k, l, & + & q)*(q_prim_vf(eqn_idx%stress%end - 2)%sf(k, l, q)*dw_dx_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%end - 2)%sf(k, l, q)*dw_dx_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*du_dx_hypo(k, l, & + & q) + 2._wp*q_prim_vf(eqn_idx%stress%end - 1)%sf(k, l, q)*dw_dy_hypo(k, l, & + & q) - q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*dv_dy_hypo(k, l, & + & q) + q_prim_vf(eqn_idx%stress%end)%sf(k, l, q)*dw_dz_hypo(k, l, q) + 2._wp*G_K_field(k, l, & + & q)*(dw_dz_hypo(k, l, q) - (1._wp/3._wp)*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, & + & q) + dw_dz_hypo(k, l, q)))) end do end do end do @@ -302,24 +317,27 @@ contains do l = 0, n do k = 0, m ! S_xx -= rho * v/r * (tau_xx + 2/3*G) - rhs_vf(strxb)%sf(k, l, q) = rhs_vf(strxb)%sf(k, l, q) - rho_K_field(k, l, q)*q_prim_vf(momxb + 1)%sf(k, & - & l, q)/y_cc(l)*(q_prim_vf(strxb)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, q)) ! tau_xx + 2/3*G + rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg)%sf(k, l, q) - rho_K_field(k, l, & + & q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg)%sf(k, l, & + & q) + (2._wp/3._wp)*G_K_field(k, l, q)) ! tau_xx + 2/3*G ! S_xr -= rho * v/r * tau_xr - rhs_vf(strxb + 1)%sf(k, l, q) = rhs_vf(strxb + 1)%sf(k, l, q) - rho_K_field(k, l, & - & q)*q_prim_vf(momxb + 1)%sf(k, l, q)/y_cc(l)*q_prim_vf(strxb + 1)%sf(k, l, q) ! tau_xx + rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) - rho_K_field(k, & + & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)*q_prim_vf(eqn_idx%stress%beg + 1)%sf(k, & + & l, q) ! tau_xx ! S_rr -= rho * v/r * (tau_rr + 2/3*G) - rhs_vf(strxb + 2)%sf(k, l, q) = rhs_vf(strxb + 2)%sf(k, l, q) - rho_K_field(k, l, & - & q)*q_prim_vf(momxb + 1)%sf(k, l, q)/y_cc(l)*(q_prim_vf(strxb + 2)%sf(k, l, & - & q) + (2._wp/3._wp)*G_K_field(k, l, q)) ! tau_rr + 2/3*G + rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) - rho_K_field(k, & + & l, q)*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, & + & q)/y_cc(l)*(q_prim_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, & + & q)) ! tau_rr + 2/3*G ! S_thetatheta += rho * ( -(tau_thetatheta + 2/3*G)*(du/dx + dv/dr + v/r) + 2*(tau_thetatheta + G)*v/r ) - rhs_vf(strxb + 3)%sf(k, l, q) = rhs_vf(strxb + 3)%sf(k, l, q) + rho_K_field(k, l, & - & q)*(-(q_prim_vf(strxb + 3)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, q))*(du_dx_hypo(k, l, & - & q) + dv_dy_hypo(k, l, q) + q_prim_vf(momxb + 1)%sf(k, l, & - & q)/y_cc(l)) + 2._wp*(q_prim_vf(strxb + 3)%sf(k, l, q) + G_K_field(k, l, & - & q))*q_prim_vf(momxb + 1)%sf(k, l, q)/y_cc(l)) + rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) = rhs_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + rho_K_field(k, & + & l, q)*(-(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + (2._wp/3._wp)*G_K_field(k, l, & + & q))*(du_dx_hypo(k, l, q) + dv_dy_hypo(k, l, q) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, & + & q)/y_cc(l)) + 2._wp*(q_prim_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + G_K_field(k, l, & + & q))*q_prim_vf(eqn_idx%mom%beg + 1)%sf(k, l, q)/y_cc(l)) end do end do end do @@ -360,7 +378,7 @@ contains l = 0; q = 0 $:GPU_PARALLEL_LOOP() do k = 0, m - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(abs(real(q_cons_vf(stress_idx%beg)%sf(k, l, q), & + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(abs(real(q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q), & & kind=wp)) - tau_star, 0._wp))**cont_damage_s end do $:END_GPU_PARALLEL_LOOP() @@ -370,11 +388,12 @@ contains do l = 0, n do k = 0, m ! Maximum principal stress - tau_p = 0.5_wp*(q_cons_vf(stress_idx%beg)%sf(k, l, q) + q_cons_vf(stress_idx%beg + 2)%sf(k, l, & - & q)) + sqrt((q_cons_vf(stress_idx%beg)%sf(k, l, q) - q_cons_vf(stress_idx%beg + 2)%sf(k, l, & - & q))**2.0_wp + 4._wp*q_cons_vf(stress_idx%beg + 1)%sf(k, l, q)**2.0_wp)/2._wp + tau_p = 0.5_wp*(q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q) + q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, & + & q)) + sqrt((q_cons_vf(eqn_idx%stress%beg)%sf(k, l, & + & q) - q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, & + & q))**2.0_wp + 4._wp*q_cons_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)**2.0_wp)/2._wp - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s end do end do $:END_GPU_PARALLEL_LOOP() @@ -384,12 +403,12 @@ contains do q = 0, p do l = 0, n do k = 0, m - tau_xx = q_cons_vf(stress_idx%beg)%sf(k, l, q) - tau_xy = q_cons_vf(stress_idx%beg + 1)%sf(k, l, q) - tau_yy = q_cons_vf(stress_idx%beg + 2)%sf(k, l, q) - tau_xz = q_cons_vf(stress_idx%beg + 3)%sf(k, l, q) - tau_yz = q_cons_vf(stress_idx%beg + 4)%sf(k, l, q) - tau_zz = q_cons_vf(stress_idx%beg + 5)%sf(k, l, q) + tau_xx = q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q) + tau_xy = q_cons_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + tau_yy = q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + tau_xz = q_cons_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + tau_yz = q_cons_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) + tau_zz = q_cons_vf(eqn_idx%stress%beg + 5)%sf(k, l, q) ! Invariants of the stress tensor I1 = tau_xx + tau_yy + tau_zz @@ -411,7 +430,7 @@ contains tau_p = I1/3.0_wp end if - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s end do end do end do diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 1323235887..d4d20b9b3f 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,22 +165,22 @@ contains ! set the Moving IBM interior conservative variables - $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[E_idx, momxb]', collapse=3) + $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', collapse=3) do l = 0, p do k = 0, n do j = 0, m patch_id = ib_markers%sf(j, k, l) if (patch_id /= 0) then - q_prim_vf(E_idx)%sf(j, k, l) = 1._wp + q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp rho = 0._wp do i = 1, num_fluids - rho = rho + q_prim_vf(contxb + i - 1)%sf(j, k, l) + rho = rho + q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l) end do ! Sets the momentum do i = 1, num_dims - q_cons_vf(momxb + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i)*rho - q_prim_vf(momxb + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i) + q_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i)*rho + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = patch_ib(patch_id)%vel(i) end do end if end do @@ -226,22 +226,22 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = 1, num_fluids q_prim_vf(q)%sf(j, k, l) = alpha_rho_IP(q) - q_prim_vf(advxb + q - 1)%sf(j, k, l) = alpha_IP(q) + q_prim_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l) = alpha_IP(q) end do if (surface_tension) then - q_prim_vf(c_idx)%sf(j, k, l) = c_IP + q_prim_vf(eqn_idx%c)%sf(j, k, l) = c_IP end if ! set the pressure if (patch_ib(patch_id)%moving_ibm <= 1) then - q_prim_vf(E_idx)%sf(j, k, l) = pres_IP + q_prim_vf(eqn_idx%E)%sf(j, k, l) = pres_IP else - q_prim_vf(E_idx)%sf(j, k, l) = 0._wp + q_prim_vf(eqn_idx%E)%sf(j, k, l) = 0._wp $:GPU_LOOP(parallelism='[seq]') do q = 1, num_fluids ! Pressure correction for moving IB: accounts for acceleration of IB surface - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, & + q_prim_vf(eqn_idx%E)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, & & l) + pres_IP/(1._wp - 2._wp*abs(gp%levelset*alpha_rho_IP(q)/pres_IP) & & *dot_product(patch_ib(patch_id) %force/patch_ib(patch_id)%mass, gp%levelset_norm)) end do @@ -296,41 +296,41 @@ contains ! Set momentum $:GPU_LOOP(parallelism='[seq]') - do q = momxb, momxe - q_cons_vf(q)%sf(j, k, l) = rho*vel_g(q - momxb + 1) - dyn_pres = dyn_pres + q_cons_vf(q)%sf(j, k, l)*vel_g(q - momxb + 1)/2._wp + do q = eqn_idx%mom%beg, eqn_idx%mom%end + q_cons_vf(q)%sf(j, k, l) = rho*vel_g(q - eqn_idx%mom%beg + 1) + dyn_pres = dyn_pres + q_cons_vf(q)%sf(j, k, l)*vel_g(q - eqn_idx%mom%beg + 1)/2._wp end do ! Set continuity and adv vars $:GPU_LOOP(parallelism='[seq]') do q = 1, num_fluids q_cons_vf(q)%sf(j, k, l) = alpha_rho_IP(q) - q_cons_vf(advxb + q - 1)%sf(j, k, l) = alpha_IP(q) + q_cons_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l) = alpha_IP(q) end do ! Set color function if (surface_tension) then - q_cons_vf(c_idx)%sf(j, k, l) = c_IP + q_cons_vf(eqn_idx%c)%sf(j, k, l) = c_IP end if ! Set Energy if (bubbles_euler) then - q_cons_vf(E_idx)%sf(j, k, l) = (1 - alpha_IP(1))*(gamma*pres_IP + pi_inf + dyn_pres) + q_cons_vf(eqn_idx%E)%sf(j, k, l) = (1 - alpha_IP(1))*(gamma*pres_IP + pi_inf + dyn_pres) else - q_cons_vf(E_idx)%sf(j, k, l) = gamma*pres_IP + pi_inf + dyn_pres + q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*pres_IP + pi_inf + dyn_pres end if ! Set bubble vars if (bubbles_euler .and. .not. qbmm) then call s_comp_n_from_prim(alpha_IP(1), r_IP, nbub, weight) $:GPU_LOOP(parallelism='[seq]') do q = 1, nb - q_cons_vf(bubxb + (q - 1)*2)%sf(j, k, l) = nbub*r_IP(q) - q_cons_vf(bubxb + (q - 1)*2 + 1)%sf(j, k, l) = nbub*v_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*2)%sf(j, k, l) = nbub*r_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*2 + 1)%sf(j, k, l) = nbub*v_IP(q) if (.not. polytropic) then - q_cons_vf(bubxb + (q - 1)*4)%sf(j, k, l) = nbub*r_IP(q) - q_cons_vf(bubxb + (q - 1)*4 + 1)%sf(j, k, l) = nbub*v_IP(q) - q_cons_vf(bubxb + (q - 1)*4 + 2)%sf(j, k, l) = nbub*pb_IP(q) - q_cons_vf(bubxb + (q - 1)*4 + 3)%sf(j, k, l) = nbub*mv_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*4)%sf(j, k, l) = nbub*r_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 1)%sf(j, k, l) = nbub*v_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 2)%sf(j, k, l) = nbub*pb_IP(q) + q_cons_vf(eqn_idx%bub%beg + (q - 1)*4 + 3)%sf(j, k, l) = nbub*mv_IP(q) end if end do end if @@ -339,12 +339,12 @@ contains nbub = nmom_IP(1) $:GPU_LOOP(parallelism='[seq]') do q = 1, nb*nmom - q_cons_vf(bubxb + q - 1)%sf(j, k, l) = nbub*nmom_IP(q) + q_cons_vf(eqn_idx%bub%beg + q - 1)%sf(j, k, l) = nbub*nmom_IP(q) end do $:GPU_LOOP(parallelism='[seq]') do q = 1, nb - q_cons_vf(bubxb + (q - 1)*nmom)%sf(j, k, l) = nbub + q_cons_vf(eqn_idx%bub%beg + (q - 1)*nmom)%sf(j, k, l) = nbub end do if (.not. polytropic) then @@ -361,8 +361,10 @@ contains if (model_eqns == 3) then $:GPU_LOOP(parallelism='[seq]') - do q = intxb, intxe - q_cons_vf(q)%sf(j, k, l) = alpha_IP(q - intxb + 1)*(gammas(q - intxb + 1)*pres_IP + pi_infs(q - intxb + 1)) + do q = eqn_idx%int_en%beg, eqn_idx%int_en%end + q_cons_vf(q)%sf(j, k, & + & l) = alpha_IP(q - eqn_idx%int_en%beg + 1)*(gammas(q - eqn_idx%int_en%beg + 1)*pres_IP & + & + pi_infs(q - eqn_idx%int_en%beg + 1)) end do end if end do @@ -779,41 +781,41 @@ contains do k = k1, k2 coeff = gp%interp_coeffs(i - i1 + 1, j - j1 + 1, k - k1 + 1) - pres_IP = pres_IP + coeff*q_prim_vf(E_idx)%sf(i, j, k) + pres_IP = pres_IP + coeff*q_prim_vf(eqn_idx%E)%sf(i, j, k) $:GPU_LOOP(parallelism='[seq]') - do q = momxb, momxe - vel_IP(q + 1 - momxb) = vel_IP(q + 1 - momxb) + coeff*q_prim_vf(q)%sf(i, j, k) + do q = eqn_idx%mom%beg, eqn_idx%mom%end + vel_IP(q + 1 - eqn_idx%mom%beg) = vel_IP(q + 1 - eqn_idx%mom%beg) + coeff*q_prim_vf(q)%sf(i, j, k) end do $:GPU_LOOP(parallelism='[seq]') - do l = contxb, contxe + do l = eqn_idx%cont%beg, eqn_idx%cont%end alpha_rho_IP(l) = alpha_rho_IP(l) + coeff*q_prim_vf(l)%sf(i, j, k) - alpha_IP(l) = alpha_IP(l) + coeff*q_prim_vf(advxb + l - 1)%sf(i, j, k) + alpha_IP(l) = alpha_IP(l) + coeff*q_prim_vf(eqn_idx%adv%beg + l - 1)%sf(i, j, k) end do if (surface_tension) then - c_IP = c_IP + coeff*q_prim_vf(c_idx)%sf(i, j, k) + c_IP = c_IP + coeff*q_prim_vf(eqn_idx%c)%sf(i, j, k) end if if (bubbles_euler .and. .not. qbmm) then $:GPU_LOOP(parallelism='[seq]') do l = 1, nb if (polytropic) then - r_IP(l) = r_IP(l) + coeff*q_prim_vf(bubxb + (l - 1)*2)%sf(i, j, k) - v_IP(l) = v_IP(l) + coeff*q_prim_vf(bubxb + 1 + (l - 1)*2)%sf(i, j, k) + r_IP(l) = r_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*2)%sf(i, j, k) + v_IP(l) = v_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*2)%sf(i, j, k) else - r_IP(l) = r_IP(l) + coeff*q_prim_vf(bubxb + (l - 1)*4)%sf(i, j, k) - v_IP(l) = v_IP(l) + coeff*q_prim_vf(bubxb + 1 + (l - 1)*4)%sf(i, j, k) - pb_IP(l) = pb_IP(l) + coeff*q_prim_vf(bubxb + 2 + (l - 1)*4)%sf(i, j, k) - mv_IP(l) = mv_IP(l) + coeff*q_prim_vf(bubxb + 3 + (l - 1)*4)%sf(i, j, k) + r_IP(l) = r_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + (l - 1)*4)%sf(i, j, k) + v_IP(l) = v_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 1 + (l - 1)*4)%sf(i, j, k) + pb_IP(l) = pb_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 2 + (l - 1)*4)%sf(i, j, k) + mv_IP(l) = mv_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg + 3 + (l - 1)*4)%sf(i, j, k) end if end do end if if (qbmm) then do l = 1, nb*nmom - nmom_IP(l) = nmom_IP(l) + coeff*q_prim_vf(bubxb - 1 + l)%sf(i, j, k) + nmom_IP(l) = nmom_IP(l) + coeff*q_prim_vf(eqn_idx%bub%beg - 1 + l)%sf(i, j, k) end do if (.not. polytropic) then do q = 1, nb @@ -936,17 +938,18 @@ contains do fluid_idx = 0, num_fluids - 1 ! Get the pressure contribution to force via a finite difference to compute the 2D components of the ! gradient of the pressure and cell volume - local_force_contribution(1) = local_force_contribution(1) - (q_prim_vf(E_idx + fluid_idx)%sf(i + 1, & - & j, k) - q_prim_vf(E_idx + fluid_idx)%sf(i - 1, j, & + local_force_contribution(1) = local_force_contribution(1) - (q_prim_vf(eqn_idx%E + fluid_idx)%sf(i & + & + 1, j, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i - 1, j, & & k))/(2._wp*dx) ! force is the negative pressure gradient - local_force_contribution(2) = local_force_contribution(2) - (q_prim_vf(E_idx + fluid_idx)%sf(i, & - & j + 1, k) - q_prim_vf(E_idx + fluid_idx)%sf(i, j - 1, k))/(2._wp*dy) + local_force_contribution(2) = local_force_contribution(2) - (q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, & + & j + 1, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j - 1, k))/(2._wp*dy) cell_volume = abs(dx*dy) ! add the 3D component of the pressure gradient, if we are working in 3 dimensions if (num_dims == 3) then dz = z_cc(k + 1) - z_cc(k) - local_force_contribution(3) = local_force_contribution(3) - (q_prim_vf(E_idx + fluid_idx)%sf(i, & - & j, k + 1) - q_prim_vf(E_idx + fluid_idx)%sf(i, j, k - 1))/(2._wp*dz) + local_force_contribution(3) = local_force_contribution(3) - (q_prim_vf(eqn_idx%E + fluid_idx) & + & %sf(i, j, k + 1) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j, & + & k - 1))/(2._wp*dz) cell_volume = abs(cell_volume*dz) end if end do @@ -957,7 +960,7 @@ contains dynamic_viscosity = 0._wp do fluid_idx = 1, num_fluids ! local dynamic viscosity is the dynamic viscosity of the fluid times alpha of the fluid - dynamic_viscosity = dynamic_viscosity + (q_prim_vf(fluid_idx + advxb - 1)%sf(i, j, & + dynamic_viscosity = dynamic_viscosity + (q_prim_vf(fluid_idx + eqn_idx%adv%beg - 1)%sf(i, j, & & k)*dynamic_viscosities(fluid_idx)) end do diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index 7d0f18cb26..9b9cf64133 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -82,6 +82,11 @@ module m_igr integer(kind=8) :: i, j, k, l, q, r + ! Scalar copies of eqn_idx fields used in GPU atomics. nvfortran OpenMP does not support derived-type member indexing on the LHS + ! of atomic updates; plain integers work. + integer :: igr_momxb, igr_E_idx, igr_advxb + $:GPU_DECLARE(create='[igr_momxb, igr_E_idx, igr_advxb]') + contains !> Initialize the IGR module @@ -159,6 +164,11 @@ contains end if $:GPU_UPDATE(device='[alf_igr]') + igr_momxb = eqn_idx%mom%beg + igr_E_idx = eqn_idx%E + igr_advxb = eqn_idx%adv%beg + $:GPU_UPDATE(device='[igr_momxb, igr_E_idx, igr_advxb]') + #:if not MFC_CASE_OPTIMIZATION if (igr_order == 3) then vidxb = -1; vidxe = 2 @@ -343,7 +353,7 @@ contains alpha_rho_L(i) = alpha_rho_L(i) + coeff_L(q)*q_cons_vf(i)%sf(j + q, k, l) end do - vel_L = vel_L + coeff_L(q)*q_cons_vf(momxb)%sf(j + q, k, l) + vel_L = vel_L + coeff_L(q)*q_cons_vf(igr_momxb)%sf(j + q, k, l) F_L = F_L + coeff_L(q)*jac(j + q, k, l) end do @@ -354,7 +364,7 @@ contains alpha_rho_R(i) = alpha_rho_R(i) + coeff_R(q)*q_cons_vf(i)%sf(j + q, k, l) end do - vel_R = vel_R + coeff_R(q)*q_cons_vf(momxb)%sf(j + q, k, l) + vel_R = vel_R + coeff_R(q)*q_cons_vf(igr_momxb)%sf(j + q, k, l) F_R = F_R + coeff_R(q)*jac(j + q, k, l) end do @@ -369,16 +379,17 @@ contains #:for LR in ['L', 'R'] $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) + real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) + real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, l) - real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j)), kind=stp) - $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, l) - real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j)), & & kind=stp) + $:GPU_ATOMIC(atomic='update') + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & + & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) #:endfor end do end do @@ -445,10 +456,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(1._wp*q_cons_vf(momxb)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - 1._wp*q_cons_vf(momxb)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 1)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dx(j)))*(1._wp*q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - 1._wp*q_cons_vf(igr_momxb)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -477,10 +489,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 1)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -527,7 +539,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(E_idx + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(igr_E_idx + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -535,7 +547,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(momxb + i - 1)%sf(j + q, k, l) + vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(igr_momxb + i - 1)%sf(j + q, k, l) end do end do @@ -549,7 +561,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(E_idx + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(igr_E_idx + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -557,7 +569,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(momxb + i - 1)%sf(j + q, k, l) + vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(igr_momxb + i - 1)%sf(j + q, k, l) end do end do @@ -602,59 +614,59 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j)), kind=stp) end if @@ -662,12 +674,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(E_idx)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(igr_E_idx)%sf(j + q, k, l) end do $:GPU_LOOP(parallelism='[seq]') do q = vidxb, vidxe - 1 - E_R = E_R + coeff_R(q)*q_cons_vf(E_idx)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(igr_E_idx)%sf(j + q, k, l) end do call s_get_derived_states(E_L, gamma_L, pi_inf_L, rho_L, vel_L, E_R, gamma_R, pi_inf_R, rho_R, & @@ -689,54 +701,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l)*vel_L(1)*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & & l)*vel_L(1)*(1._wp/dx(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j + 1)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dx(j))), kind=stp) @@ -757,54 +769,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l)*vel_R(1)*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & & l)*vel_R(1)*(1._wp/dx(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j + 1)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dx(j))), kind=stp) end do @@ -843,12 +855,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 1)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 2)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j - 1 + q, k, l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -879,12 +891,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 1)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) - if (q == 0) dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 2)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k - 1, l)/rho_sf_small(-1)) + if (q == 0) dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j + q, k - 1, l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims @@ -912,12 +924,13 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j + q, k, l - 1)/rho_sf_small(-1)) - if (q == 0) dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 1)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j + q, k, l - 1)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 2)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j + q, k, l - 1)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j + q, k, l - 1)/rho_sf_small(-1)) + if (q == 0) dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j + q, k, l - 1)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j + q, k, & + & l - 1)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims @@ -964,7 +977,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(E_idx + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(igr_E_idx + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -972,7 +985,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(momxb + i - 1)%sf(j + q, k, l) + vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(igr_momxb + i - 1)%sf(j + q, k, l) end do end do @@ -986,7 +999,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(E_idx + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(igr_E_idx + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -994,7 +1007,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(momxb + i - 1)%sf(j + q, k, l) + vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(igr_momxb + i - 1)%sf(j + q, k, l) end do end do @@ -1040,87 +1053,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j + 1, k, l) = rhs_vf(momxb + 2)%sf(j + 1, k, & + rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j + 1, k, l) = rhs_vf(momxb + 2)%sf(j + 1, k, & + rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(1)*(1._wp/dx(j)), kind=stp) end if @@ -1128,12 +1141,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(E_idx)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(igr_E_idx)%sf(j + q, k, l) end do $:GPU_LOOP(parallelism='[seq]') do q = vidxb, vidxe - 1 - E_R = E_R + coeff_R(q)*q_cons_vf(E_idx)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(igr_E_idx)%sf(j + q, k, l) end do call s_get_derived_states(E_L, gamma_L, pi_inf_L, rho_L, vel_L, E_R, gamma_R, pi_inf_R, rho_R, & @@ -1156,64 +1169,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & + & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l)*vel_L(1)*(1._wp/dx(j + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(1))*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_L(1)*(1._wp/dx(j)), & - & kind=stp) + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_L(1)*(1._wp/dx(j)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j + 1, k, l) = rhs_vf(momxb + 2)%sf(j + 1, k, & + rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dx(j + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j + 1)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real((0.5_wp*dt*(rho_L*(vel_L(1))**2.0 + pres_L)*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real((0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dx(j)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real((0.5_wp*dt*(vel_L(1)*(E_L + pres_L))*(1._wp/dx(j)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dx(j))), kind=stp) @@ -1234,64 +1247,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(advxb + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j + 1, k, & + rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j + 1, k, & & l)*vel_R(1)*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real((0.5_wp*dt*(alpha_R(i)*vel_R(1))*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & & l)*vel_R(1)*(1._wp/dx(j))), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(momxb)%sf(j + 1, k, & + rhs_vf(igr_momxb)%sf(j + 1, k, l) = rhs_vf(igr_momxb)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(momxb + 1)%sf(j + 1, k, & + rhs_vf(igr_momxb + 1)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 1)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j + 1, k, l) = rhs_vf(momxb + 2)%sf(j + 1, k, & + rhs_vf(igr_momxb + 2)%sf(j + 1, k, l) = rhs_vf(igr_momxb + 2)%sf(j + 1, k, & & l) + real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dx(j + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j + 1, k, l) = rhs_vf(E_idx)%sf(j + 1, k, & + rhs_vf(igr_E_idx)%sf(j + 1, k, l) = rhs_vf(igr_E_idx)%sf(j + 1, k, & & l) + real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j + 1)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real((0.5_wp*dt*(rho_R*(vel_R(1))**2.0 + pres_R)*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(2)*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real((0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dx(j)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real((0.5_wp*dt*(vel_R(1)*(E_R + pres_R))*(1._wp/dx(j)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dx(j))), kind=stp) end do @@ -1333,10 +1346,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 1)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j - 1, k + q, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1, k + q, & + & l)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(2)) @@ -1358,10 +1372,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 1)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(1)) @@ -1397,7 +1412,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(E_idx + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(igr_E_idx + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1405,7 +1420,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(momxb + i - 1)%sf(j, k + q, l) + vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k + q, l) end do end do @@ -1419,7 +1434,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(E_idx + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(igr_E_idx + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1427,7 +1442,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(momxb + i - 1)%sf(j, k + q, l) + vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k + q, l) end do end do @@ -1473,59 +1488,59 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k)), kind=stp) end if @@ -1534,13 +1549,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(E_idx)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(igr_E_idx)%sf(j, k + q, l) F_L = F_L + coeff_L(q)*jac(j, k + q, l) end do $:GPU_LOOP(parallelism='[seq]') do q = vidxb, vidxe - 1 - E_R = E_R + coeff_R(q)*q_cons_vf(E_idx)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(igr_E_idx)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -1564,54 +1579,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & + & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_L(2)*(1._wp/dy(k)), & - & kind=stp) + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_L(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dy(k)), kind=stp) @@ -1631,48 +1646,48 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & + & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_R(2)*(1._wp/dy(k)), & - & kind=stp) + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_R(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dy(k)), kind=stp) end do @@ -1712,10 +1727,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 1)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j - 1, k + q, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k + q, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 1)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j - 1, k + q, & + & l)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(2)) @@ -1737,12 +1753,14 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 1)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 2)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k - 1 + q, l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(1)) @@ -1766,11 +1784,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 1)%sf(j, k + q, & - & l + 1)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j, k + q, & + dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + q, & + & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k + q, & & l - 1)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 2)%sf(j, k + q, & - & l + 1)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j, k + q, & + dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + q, & + & l + 1)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k + q, & & l - 1)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(2) = vflux_L_arr(2) + coeff_L(q)*(dvel_small(2)) @@ -1806,7 +1824,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(E_idx + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(igr_E_idx + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1814,7 +1832,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(momxb + i - 1)%sf(j, k + q, l) + vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k + q, l) end do end do @@ -1828,7 +1846,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(E_idx + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(igr_E_idx + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1836,7 +1854,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(momxb + i - 1)%sf(j, k + q, l) + vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k + q, l) end do end do @@ -1882,87 +1900,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k + 1, l) = rhs_vf(momxb + 2)%sf(j, k + 1, & + rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k + 1, l) = rhs_vf(momxb + 2)%sf(j, k + 1, & + rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(2)*(1._wp/dy(k)), kind=stp) end if @@ -1971,13 +1989,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(E_idx)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(igr_E_idx)%sf(j, k + q, l) F_L = F_L + coeff_L(q)*jac(j, k + q, l) end do $:GPU_LOOP(parallelism='[seq]') do q = vidxb, vidxe - 1 - E_R = E_R + coeff_R(q)*q_cons_vf(E_idx)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(igr_E_idx)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -2001,64 +2019,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & + & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l)*vel_L(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(2))*(1._wp/dy(k)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_L(2)*(1._wp/dy(k)), & - & kind=stp) + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_L(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k + 1, l) = rhs_vf(momxb + 2)%sf(j, k + 1, & + rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k + 1)) & & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_L*(vel_L(2))**2.0 + pres_L + F_L)*(1._wp/dy(k)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real(0.5_wp*dt*rho_L*vel_L(3)*vel_L(2)*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(rho_L*vel_L(3) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_L(2)*(E_L + pres_L + F_L))*(1._wp/dy(k)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dy(k)), kind=stp) @@ -2079,64 +2097,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(advxb + i - 1)%sf(j, k + 1, & - & l) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k + 1, & + rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k + 1, & + & l) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k + 1, & & l)*vel_R(2)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(2))*(1._wp/dy(k)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_R(2)*(1._wp/dy(k)), & - & kind=stp) + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & + & l)*vel_R(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k + 1, l) = rhs_vf(momxb + 1)%sf(j, k + 1, & + rhs_vf(igr_momxb + 1)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 1)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(igr_momxb)%sf(j, k + 1, l) = rhs_vf(igr_momxb)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k + 1, l) = rhs_vf(momxb + 2)%sf(j, k + 1, & + rhs_vf(igr_momxb + 2)%sf(j, k + 1, l) = rhs_vf(igr_momxb + 2)%sf(j, k + 1, & & l) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k + 1, l) = rhs_vf(E_idx)%sf(j, k + 1, & + rhs_vf(igr_E_idx)%sf(j, k + 1, l) = rhs_vf(igr_E_idx)%sf(j, k + 1, & & l) + real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k + 1)) & & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_R*(vel_R(2))**2.0 + pres_R + F_R)*(1._wp/dy(k)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(1)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(rho_R*vel_R(3) & & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_R(2)*(E_R + pres_R + F_R))*(1._wp/dy(k)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dy(k)), kind=stp) end do @@ -2177,10 +2195,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb)%sf(j + 1, k, & - & l + q)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j - 1, k, l + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(momxb + 2)%sf(j + 1, k, & - & l + q)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j - 1, k, l + q)/rho_sf_small(-1)) + dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb)%sf(j + 1, k, & + & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j - 1, k, l + q)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(igr_momxb + 2)%sf(j + 1, k, & + & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j - 1, k, & + & l + q)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(3)) @@ -2202,10 +2221,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 1)%sf(j, k + 1, & - & l + q)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j, k - 1, l + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(momxb + 2)%sf(j, k + 1, & - & l + q)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j, k - 1, l + q)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 1)%sf(j, k + 1, & + & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k - 1, & + & l + q)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(igr_momxb + 2)%sf(j, k + 1, & + & l + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k - 1, & + & l + q)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(2) = vflux_L_arr(2) + coeff_L(q)*(dvel_small(3)) @@ -2226,13 +2247,14 @@ contains end do rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(momxb)%sf(j, k, l - 1 + q)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 1)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(momxb + 1)%sf(j, k, & + dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb)%sf(j, k, & + & l - 1 + q)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 1)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 1)%sf(j, k, & & l - 1 + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(momxb + 2)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(momxb + 2)%sf(j, k, & + dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(igr_momxb + 2)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(igr_momxb + 2)%sf(j, k, & & l - 1 + q)/rho_sf_small(-1)) if (q > vidxb) then vflux_L_arr(1) = vflux_L_arr(1) + coeff_L(q)*(dvel_small(1)) @@ -2271,7 +2293,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(E_idx + i)%sf(j, k, l + q) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(igr_E_idx + i)%sf(j, k, l + q) end do else alpha_L(1) = 1._wp @@ -2279,7 +2301,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(momxb + i - 1)%sf(j, k, l + q) + vel_L(i) = vel_L(i) + coeff_L(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k, l + q) end do end do @@ -2293,7 +2315,7 @@ contains if (num_fluids > 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 - alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(E_idx + i)%sf(j, k, l + q) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(igr_E_idx + i)%sf(j, k, l + q) end do else alpha_R(1) = 1._wp @@ -2301,7 +2323,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(momxb + i - 1)%sf(j, k, l + q) + vel_R(i) = vel_R(i) + coeff_R(q)*q_cons_vf(igr_momxb + i - 1)%sf(j, k, l + q) end do end do @@ -2347,87 +2369,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*vel_L(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*vel_R(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l + 1) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*vel_L(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l + 1) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*vel_R(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l + 1) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*vel_L(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l + 1) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) - real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*vel_R(3)*(1._wp/dz(l)), kind=stp) end if @@ -2436,13 +2458,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(E_idx)%sf(j, k, l + q) + E_L = E_L + coeff_L(q)*q_cons_vf(igr_E_idx)%sf(j, k, l + q) F_L = F_L + coeff_L(q)*jac(j, k, l + q) end do $:GPU_LOOP(parallelism='[seq]') do q = vidxb, vidxe - 1 - E_R = E_R + coeff_R(q)*q_cons_vf(E_idx)%sf(j, k, l + q) + E_R = E_R + coeff_R(q)*q_cons_vf(igr_E_idx)%sf(j, k, l + q) F_R = F_R + coeff_R(q)*jac(j, k, l + q) end do @@ -2466,64 +2488,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/dz(l + 1)) & & - 0.5_wp*dt*cfl*(alpha_L(i))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l + 1) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1)*vel_L(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_L(i)*vel_L(3))*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(alpha_L(i)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_L(3)*(1._wp/dz(l)), & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, l)*vel_L(3)*(1._wp/dz(l)), & & kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l + 1) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/dz(l + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & & l + 1) + real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dz(l + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l + 1) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l + 1) + real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/dz(l + 1)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/dz(l + 1)) & & - 0.5_wp*dt*cfl*(E_L)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_L*(vel_L(3))**2.0 + pres_L + F_L)*(1._wp/dz(l)) & & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_L*vel_L(1)*vel_L(3)*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(rho_L*vel_L(1)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*rho_L*vel_L(2)*vel_L(3)*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(rho_L*vel_L(2)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_L(3)*(E_L + pres_L + F_L))*(1._wp/dz(l)) - 0.5_wp*dt*cfl*(E_L) & & *(1._wp/dz(l)), kind=stp) @@ -2544,64 +2566,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/dz(l + 1)) & & + 0.5_wp*dt*cfl*(alpha_R(i))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l + 1) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l + 1) - real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, & & l + 1)*vel_R(3)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & & l) - real(0.5_wp*dt*(alpha_R(i)*vel_R(3))*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(alpha_R(i)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(advxb + i - 1)%sf(j, k, l) = rhs_vf(advxb + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(advxb + i - 1)%sf(j, k, l)*vel_R(3)*(1._wp/dz(l)), & + rhs_vf(igr_advxb + i - 1)%sf(j, k, l) = rhs_vf(igr_advxb + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(igr_advxb + i - 1)%sf(j, k, l)*vel_R(3)*(1._wp/dz(l)), & & kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l + 1) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/dz(l + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l + 1) = rhs_vf(igr_momxb)%sf(j, k, & & l + 1) + real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dz(l + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(1))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l + 1) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l + 1) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l + 1) + real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dz(l + 1)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l + 1) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l + 1) = rhs_vf(igr_E_idx)%sf(j, k, & & l + 1) + real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/dz(l + 1)) & & + 0.5_wp*dt*cfl*(E_R)*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 2)%sf(j, k, l) = rhs_vf(momxb + 2)%sf(j, k, & + rhs_vf(igr_momxb + 2)%sf(j, k, l) = rhs_vf(igr_momxb + 2)%sf(j, k, & & l) - real(0.5_wp*dt*(rho_R*(vel_R(3))**2.0 + pres_R + F_R)*(1._wp/dz(l)) & & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(igr_momxb)%sf(j, k, l) = rhs_vf(igr_momxb)%sf(j, k, & & l) - real(0.5_wp*dt*rho_R*vel_R(1)*vel_R(3)*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(rho_R*vel_R(1)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, & + rhs_vf(igr_momxb + 1)%sf(j, k, l) = rhs_vf(igr_momxb + 1)%sf(j, k, & & l) - real(0.5_wp*dt*rho_R*vel_R(2)*vel_R(3)*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(rho_R*vel_R(2)) & & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & + rhs_vf(igr_E_idx)%sf(j, k, l) = rhs_vf(igr_E_idx)%sf(j, k, & & l) - real(0.5_wp*dt*(vel_R(3)*(E_R + pres_R + F_R))*(1._wp/dz(l)) + 0.5_wp*dt*cfl*(E_R) & & *(1._wp/dz(l)), kind=stp) end do diff --git a/src/simulation/m_muscl.fpp b/src/simulation/m_muscl.fpp index 5c9e844ec6..0152ec56c0 100644 --- a/src/simulation/m_muscl.fpp +++ b/src/simulation/m_muscl.fpp @@ -235,9 +235,9 @@ contains do l = is3_muscl%beg, is3_muscl%end do k = is2_muscl%beg, is2_muscl%end do j = is1_muscl%beg, is1_muscl%end - aCL = v_rs_ws_${XYZ}$_muscl(j - 1, k, l, advxb) - aC = v_rs_ws_${XYZ}$_muscl(j, k, l, advxb) - aCR = v_rs_ws_${XYZ}$_muscl(j + 1, k, l, advxb) + aCL = v_rs_ws_${XYZ}$_muscl(j - 1, k, l, eqn_idx%adv%beg) + aC = v_rs_ws_${XYZ}$_muscl(j, k, l, eqn_idx%adv%beg) + aCR = v_rs_ws_${XYZ}$_muscl(j + 1, k, l, eqn_idx%adv%beg) moncon = (aCR - aC)*(aC - aCL) @@ -260,23 +260,25 @@ contains aTHINC = qmin + 5e-1_wp*qmax*(1._wp + sign*A) if (aTHINC < ic_eps) aTHINC = ic_eps if (aTHINC > 1 - ic_eps) aTHINC = 1 - ic_eps - vL_rs_vf_${XYZ}$ (j, k, l, contxb) = vL_rs_vf_${XYZ}$ (j, k, l, contxb)/vL_rs_vf_${XYZ}$ (j, k, & - & l, advxb)*aTHINC - vL_rs_vf_${XYZ}$ (j, k, l, contxe) = vL_rs_vf_${XYZ}$ (j, k, l, & - & contxe)/(1._wp - vL_rs_vf_${XYZ}$ (j, k, l, advxb))*(1._wp - aTHINC) - vL_rs_vf_${XYZ}$ (j, k, l, advxb) = aTHINC - vL_rs_vf_${XYZ}$ (j, k, l, advxe) = 1 - aTHINC + vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%cont%beg) = vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%cont%beg)/vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%beg)*aTHINC + vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%cont%end) = vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%cont%end)/(1._wp - vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%adv%beg))*(1._wp - aTHINC) + vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%beg) = aTHINC + vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%end) = 1 - aTHINC ! Right reconstruction aTHINC = qmin + 5e-1_wp*qmax*(1._wp + sign*(tanh(ic_beta) + A)/(1._wp + A*tanh(ic_beta))) if (aTHINC < ic_eps) aTHINC = ic_eps if (aTHINC > 1 - ic_eps) aTHINC = 1 - ic_eps - vR_rs_vf_${XYZ}$ (j, k, l, contxb) = vL_rs_vf_${XYZ}$ (j, k, l, contxb)/vL_rs_vf_${XYZ}$ (j, k, & - & l, advxb)*aTHINC - vR_rs_vf_${XYZ}$ (j, k, l, contxe) = vL_rs_vf_${XYZ}$ (j, k, l, & - & contxe)/(1._wp - vL_rs_vf_${XYZ}$ (j, k, l, advxb))*(1._wp - aTHINC) - vR_rs_vf_${XYZ}$ (j, k, l, advxb) = aTHINC - vR_rs_vf_${XYZ}$ (j, k, l, advxe) = 1 - aTHINC + vR_rs_vf_${XYZ}$ (j, k, l, eqn_idx%cont%beg) = vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%cont%beg)/vL_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%beg)*aTHINC + vR_rs_vf_${XYZ}$ (j, k, l, eqn_idx%cont%end) = vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%cont%end)/(1._wp - vL_rs_vf_${XYZ}$ (j, k, l, & + & eqn_idx%adv%beg))*(1._wp - aTHINC) + vR_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%beg) = aTHINC + vR_rs_vf_${XYZ}$ (j, k, l, eqn_idx%adv%end) = 1 - aTHINC end if end do end do diff --git a/src/simulation/m_pressure_relaxation.fpp b/src/simulation/m_pressure_relaxation.fpp index 7786ce4afe..14bd82befb 100644 --- a/src/simulation/m_pressure_relaxation.fpp +++ b/src/simulation/m_pressure_relaxation.fpp @@ -99,7 +99,7 @@ contains s_needs_pressure_relaxation = .true. $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > (1._wp - sgm_eps)) then + if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > (1._wp - sgm_eps)) then s_needs_pressure_relaxation = .false. end if end do @@ -119,18 +119,19 @@ contains sum_alpha = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - if ((q_cons_vf(i + contxb - 1)%sf(j, k, l) < 0._wp) .or. (q_cons_vf(i + advxb - 1)%sf(j, k, l) < 0._wp)) then - q_cons_vf(i + contxb - 1)%sf(j, k, l) = 0._wp - q_cons_vf(i + advxb - 1)%sf(j, k, l) = 0._wp - q_cons_vf(i + intxb - 1)%sf(j, k, l) = 0._wp + if ((q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l) < 0._wp) .or. (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l) < 0._wp)) then + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l) = 0._wp + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = 0._wp + q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = 0._wp end if - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > 1._wp) q_cons_vf(i + advxb - 1)%sf(j, k, l) = 1._wp - sum_alpha = sum_alpha + q_cons_vf(i + advxb - 1)%sf(j, k, l) + if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > 1._wp) q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = 1._wp + sum_alpha = sum_alpha + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - q_cons_vf(i + advxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, l)/sum_alpha + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)/sum_alpha end do end subroutine s_correct_volume_fractions @@ -157,14 +158,15 @@ contains pres_relax = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then - pres_K_init(i) = (q_cons_vf(i + intxb - 1)%sf(j, k, l)/q_cons_vf(i + advxb - 1)%sf(j, k, l) - pi_infs(i))/gammas(i) + if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) then + pres_K_init(i) = (q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l)/q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l) - pi_infs(i))/gammas(i) if (pres_K_init(i) <= -(1._wp - 1.e-8_wp)*ps_inf(i) + 1.e-8_wp) pres_K_init(i) = -(1._wp - 1.e-8_wp)*ps_inf(i) & & + 1.e-8_wp else pres_K_init(i) = 0._wp end if - pres_relax = pres_relax + q_cons_vf(i + advxb - 1)%sf(j, k, l)*pres_K_init(i) + pres_relax = pres_relax + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)*pres_K_init(i) end do ! Newton-Raphson iteration @@ -186,12 +188,13 @@ contains df_pres = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then + if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) then ! Isentropic relation: rho = rho0 * (p/p0)^(1/gamma), Saurel et al. JFM (2009) - rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/max(q_cons_vf(i + advxb - 1)%sf(j, k, l), & - & sgm_eps)*((pres_relax + ps_inf(i))/(pres_K_init(i) + ps_inf(i)))**(1._wp/gs_min(i)) - f_pres = f_pres + q_cons_vf(i + contxb - 1)%sf(j, k, l)/rho_K_s(i) - df_pres = df_pres - q_cons_vf(i + contxb - 1)%sf(j, k, l)/(gs_min(i)*rho_K_s(i)*(pres_relax + ps_inf(i))) + rho_K_s(i) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/max(q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, & + & k, l), sgm_eps)*((pres_relax + ps_inf(i))/(pres_K_init(i) + ps_inf(i)))**(1._wp/gs_min(i)) + f_pres = f_pres + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rho_K_s(i) + df_pres = df_pres - q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, & + & l)/(gs_min(i)*rho_K_s(i)*(pres_relax + ps_inf(i))) end if end do end if @@ -200,8 +203,8 @@ contains ! Update volume fractions $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) q_cons_vf(i + advxb - 1)%sf(j, k, & - & l) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/rho_K_s(i) + if (q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l) > sgm_eps) q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l) = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)/rho_K_s(i) end do end subroutine s_equilibrate_pressure @@ -225,7 +228,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids alpha_rho(i) = q_cons_vf(i)%sf(j, k, l) - alpha(i) = q_cons_vf(E_idx + i)%sf(j, k, l) + alpha(i) = q_cons_vf(eqn_idx%E + i)%sf(j, k, l) end do ! Compute mixture properties (combined bubble and standard logic) @@ -289,15 +292,16 @@ contains ! Compute dynamic pressure and update internal energies dyn_pres = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end dyn_pres = dyn_pres + 5.e-1_wp*q_cons_vf(i)%sf(j, k, l)*q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps) end do - pres_relax = (q_cons_vf(E_idx)%sf(j, k, l) - dyn_pres - pi_inf)/gamma + pres_relax = (q_cons_vf(eqn_idx%E)%sf(j, k, l) - dyn_pres - pi_inf)/gamma $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - q_cons_vf(i + intxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, l)*(gammas(i)*pres_relax + pi_infs(i)) + q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l)*(gammas(i)*pres_relax + pi_infs(i)) end do end subroutine s_correct_internal_energies diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 9ee945ba6d..9f0fceecdf 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -386,7 +386,7 @@ contains do j = 1, nmom do i = 1, nb - bubmoms(i, j) = bub_idx%moms(i, j) + bubmoms(i, j) = qbmm_idx%moms(i, j) end do end do $:GPU_UPDATE(device='[bubmoms]') @@ -425,11 +425,11 @@ contains do l = 0, p do k = 0, n do j = 0, m - nb_q = q_cons_vf(bubxb + (i - 1)*nmom)%sf(j, k, l) - nR = q_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) - nR2 = q_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) - R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) + nb_q = q_cons_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) + nR = q_cons_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) + nR2 = q_cons_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) + R = q_prim_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) + R2 = q_prim_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) var = max(R2 - R**2._wp, sgm_eps) if (q <= 2) then AX = R - sqrt(var) @@ -439,41 +439,44 @@ contains select case (idir) case (1) - 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) - nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j - 1, k, & - & l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) - nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j - 1, k, & - & l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) + nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j - 1, k, & + & l) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) + nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j - 1, k, & + & l) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) + nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j - 1, k, & + & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & & i) - 3._wp*gam/(dx(j)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) case (2) - 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) - nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k - 1, & - & l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) - nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k - 1, & - & l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) + nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k - 1, & + & l) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) + nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k - 1, & + & l) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) + nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k - 1, & + & l) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & & i) - 3._wp*gam/(dy(k)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) case (3) if (is_axisym) then - 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)) - nR_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, & - & k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)) - nR2_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, & - & k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)) + nb_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & + & l)*(flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l)) + nR_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & + & l)*(flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)) + nR2_dot = q_prim_vf(eqn_idx%cont%end + idir)%sf(j, k, & + & l)*(flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)) 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)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, & & q, i)) else - 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) - nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, & - & l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) - nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, & - & l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) + nb_dot = flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + (i - 1)*nmom)%sf(j, k, l) + nR_dot = flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l) + nR2_dot = flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, & + & l - 1) - flux_n_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l) rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, & & i) - 3._wp*gam/(dz(l)*AX*nb_q**2)*(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) end if @@ -559,8 +562,8 @@ contains do l = 0, p do q = 0, n do i = 0, m - rhs_vf(alf_idx)%sf(i, q, l) = rhs_vf(alf_idx)%sf(i, q, l) + mom_sp(2)%sf(i, q, l) - j = bubxb + rhs_vf(eqn_idx%alf)%sf(i, q, l) = rhs_vf(eqn_idx%alf)%sf(i, q, l) + mom_sp(2)%sf(i, q, l) + j = eqn_idx%bub%beg $:GPU_LOOP(parallelism='[seq]') do k = 1, nb rhs_vf(j)%sf(i, q, l) = rhs_vf(j)%sf(i, q, l) + mom_3d(0, 0, k)%sf(i, q, l) @@ -764,9 +767,9 @@ contains do id3 = is3_qbmm%beg, is3_qbmm%end do id2 = is2_qbmm%beg, is2_qbmm%end do id1 = is1_qbmm%beg, is1_qbmm%end - alf = q_prim_vf(alf_idx)%sf(id1, id2, id3) - pres = q_prim_vf(E_idx)%sf(id1, id2, id3) - rho = q_prim_vf(contxb)%sf(id1, id2, id3) + alf = q_prim_vf(eqn_idx%alf)%sf(id1, id2, id3) + pres = q_prim_vf(eqn_idx%E)%sf(id1, id2, id3) + rho = q_prim_vf(eqn_idx%cont%beg)%sf(id1, id2, id3) if (bubble_model == 2) then n_tait = 1._wp/gammas(1) + 1._wp @@ -778,7 +781,7 @@ contains call s_coeff_selector(pres, rho, c, coeff, polytropic) if (alf > small_alf) then - nbub = q_cons_vf(bubxb)%sf(id1, id2, id3) + nbub = q_cons_vf(eqn_idx%bub%beg)%sf(id1, id2, id3) $:GPU_LOOP(parallelism='[seq]') do q = 1, nb ! Gather moments for this bubble bin diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 72471f4892..00ed29e7f9 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -127,21 +127,19 @@ contains @:ALLOCATE(q_cons_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do end if if (surface_tension) then - ! This assumes that the color function advection equation is the last equation. If this changes then this logic will - ! need updated - do l = adv_idx%end + 1, sys_size - 1 + do l = eqn_idx%adv%end + 1, eqn_idx%c - 1 @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do else - do l = adv_idx%end + 1, sys_size + do l = eqn_idx%adv%end + 1, sys_size @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do @@ -150,7 +148,7 @@ contains if (.not. igr) then @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - do l = 1, cont_idx%end + do l = 1, eqn_idx%cont%end if (relativity) then ! Cons and Prim densities are different for relativity @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & @@ -162,7 +160,7 @@ contains end if end do - do l = adv_idx%beg, adv_idx%end + do l = eqn_idx%adv%beg, eqn_idx%adv%end q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(l)%sf]') $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(l)%sf]') @@ -170,15 +168,15 @@ contains end if if (surface_tension) then - q_prim_qp%vf(c_idx)%sf => q_cons_qp%vf(c_idx)%sf - $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(c_idx)%sf]') - $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(c_idx)%sf]') + q_prim_qp%vf(eqn_idx%c)%sf => q_cons_qp%vf(eqn_idx%c)%sf + $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(eqn_idx%c)%sf]') + $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(eqn_idx%c)%sf]') end if if (hyper_cleaning) then - q_prim_qp%vf(psi_idx)%sf => q_cons_qp%vf(psi_idx)%sf - $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(psi_idx)%sf]') - $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(psi_idx)%sf]') + q_prim_qp%vf(eqn_idx%psi)%sf => q_cons_qp%vf(eqn_idx%psi)%sf + $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(eqn_idx%psi)%sf]') + $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(eqn_idx%psi)%sf]') end if if (.not. igr) then @@ -200,30 +198,30 @@ contains end do if (viscous .or. surface_tension) then - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:ALLOCATE(flux_src_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do end if - @:ALLOCATE(flux_src_n(i)%vf(adv_idx%beg)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(flux_src_n(i)%vf(eqn_idx%adv%beg)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) if (riemann_solver == 1 .or. riemann_solver == 4) then - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end @:ALLOCATE(flux_src_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do end if if (chemistry) then - do l = chemxb, chemxe + do l = eqn_idx%species%beg, eqn_idx%species%end @:ALLOCATE(flux_src_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do if (chem_params%diffusion .and. .not. viscous) then - @:ALLOCATE(flux_src_n(i)%vf(E_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end)) + @:ALLOCATE(flux_src_n(i)%vf(eqn_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + & idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end)) end if end if else @@ -238,8 +236,8 @@ contains if (i == 1) then if (riemann_solver /= 1) then - do l = adv_idx%beg + 1, adv_idx%end - flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end + flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(eqn_idx%adv%beg)%sf $:GPU_ENTER_DATA(attach='[flux_src_n(i)%vf(l)%sf]') end do end if @@ -272,7 +270,7 @@ contains do i = 1, num_dims @:ALLOCATE(qL_prim(i)%vf(1:sys_size)) @:ALLOCATE(qR_prim(i)%vf(1:sys_size)) - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(qL_prim(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ALLOCATE(qR_prim(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & @@ -319,7 +317,7 @@ contains @:ALLOCATE(dqR_prim_dy_n(i)%vf(1:sys_size)) @:ALLOCATE(dqR_prim_dz_n(i)%vf(1:sys_size)) - do l = momxb, momxe + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf(1:1, 1:1, 1:1)) @:ALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf(1:1, 1:1, 1:1)) @:ALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf(1:1, 1:1, 1:1)) @@ -335,19 +333,19 @@ contains if (viscous) then @:ALLOCATE(tau_Re_vf(1:sys_size)) do i = 1, num_dims - @:ALLOCATE(tau_Re_vf(cont_idx%end + i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(tau_Re_vf(eqn_idx%cont%end + i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(tau_Re_vf(cont_idx%end + i)) + @:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%cont%end + i)) end do - @:ALLOCATE(tau_Re_vf(E_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(tau_Re_vf(eqn_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(tau_Re_vf(E_idx)) + @:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%E)) @:ALLOCATE(dq_prim_dx_qp(1)%vf(1:sys_size)) @:ALLOCATE(dq_prim_dy_qp(1)%vf(1:sys_size)) @:ALLOCATE(dq_prim_dz_qp(1)%vf(1:sys_size)) - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do @@ -355,7 +353,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dx_qp(1)) if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do @@ -363,7 +361,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dy_qp(1)) if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) end do @@ -381,7 +379,7 @@ contains end do do i = 1, num_dims - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ALLOCATE(dqR_prim_dx_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & @@ -389,7 +387,7 @@ contains end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ALLOCATE(dqR_prim_dy_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & @@ -398,7 +396,7 @@ contains end if if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & @@ -412,32 +410,32 @@ contains if (weno_Re_flux) then @:ALLOCATE(dqL_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) if (n > 0) then @:ALLOCATE(dqL_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) else @:ALLOCATE(dqL_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) end if if (p > 0) then @:ALLOCATE(dqL_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(1)%beg:idwbuff(1)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(1)%beg:idwbuff(1)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(1)%beg:idwbuff(1)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(1)%beg:idwbuff(1)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) else @:ALLOCATE(dqL_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & - & idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + & idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) end if end if ! end allocation for weno_Re_flux else @@ -445,7 +443,7 @@ contains @:ALLOCATE(dq_prim_dy_qp(1)%vf(1:sys_size)) @:ALLOCATE(dq_prim_dz_qp(1)%vf(1:sys_size)) - do l = momxb, momxe + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf(0, 0, 0)) @:ACC_SETUP_VFs(dq_prim_dx_qp(1)) if (n > 0) then @@ -559,13 +557,13 @@ contains do j = idwbuff(1)%beg, idwbuff(1)%end alf_sum%sf(j, k, l) = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf(j, k, l) = alf_sum%sf(j, k, l) + q_cons_qp%vf(i)%sf(j, k, l) end do $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe - 1 - q_cons_qp%vf(i)%sf(j, k, l) = q_cons_qp%vf(i)%sf(j, k, l)*(1._wp - q_cons_qp%vf(alf_idx)%sf(j, k, & - & l))/alf_sum%sf(j, k, l) + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_cons_qp%vf(i)%sf(j, k, l) = q_cons_qp%vf(i)%sf(j, k, & + & l)*(1._wp - q_cons_qp%vf(eqn_idx%alf)%sf(j, k, l))/alf_sum%sf(j, k, l) end do end do end do @@ -659,37 +657,37 @@ contains call s_reconstruct_cell_boundary_values(q_prim_qp%vf(1:sys_size), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) else - iv%beg = 1; iv%end = contxe + iv%beg = 1; iv%end = eqn_idx%cont%end call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = E_idx; iv%end = sys_size + iv%beg = eqn_idx%E; iv%end = sys_size call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) end if else if (all(Re_size == 0)) then - iv%beg = 1; iv%end = E_idx - 1 + iv%beg = 1; iv%end = eqn_idx%E - 1 call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = E_idx; iv%end = E_idx - call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(E_idx), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & - & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) + iv%beg = eqn_idx%E; iv%end = eqn_idx%E + call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(eqn_idx%E), qL_rsx_vf, qL_rsy_vf, & + & qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = E_idx + 1; iv%end = sys_size + iv%beg = eqn_idx%E + 1; iv%end = sys_size call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) else - iv%beg = 1; iv%end = contxe + iv%beg = 1; iv%end = eqn_idx%cont%end call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = E_idx; iv%end = E_idx - call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(E_idx), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & - & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) + iv%beg = eqn_idx%E; iv%end = eqn_idx%E + call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(eqn_idx%E), qL_rsx_vf, qL_rsy_vf, & + & qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = E_idx + 1; iv%end = sys_size + iv%beg = eqn_idx%E + 1; iv%end = sys_size call s_reconstruct_cell_boundary_values(q_prim_qp%vf(iv%beg:iv%end), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & & qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) end if @@ -697,7 +695,7 @@ contains ! Reconstruct viscous derivatives for viscosity if (weno_Re_flux) then - iv%beg = momxb; iv%end = momxe + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end call s_reconstruct_cell_boundary_values_visc_deriv(dq_prim_dx_qp(1)%vf(iv%beg:iv%end), dqL_rsx_vf, & & dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf, id, dqL_prim_dx_n(id)%vf(iv%beg:iv%end), & & dqR_prim_dx_n(id)%vf(iv%beg:iv%end), idwbuff(1), idwbuff(2), idwbuff(3)) @@ -779,8 +777,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(psi_idx)%sf(j, k, l) = rhs_vf(psi_idx)%sf(j, k, l) - q_prim_vf(psi_idx)%sf(j, k, & - & l)/hyper_cleaning_tau + rhs_vf(eqn_idx%psi)%sf(j, k, l) = rhs_vf(eqn_idx%psi)%sf(j, k, l) - q_prim_vf(eqn_idx%psi)%sf(j, & + & k, l)/hyper_cleaning_tau end do end do end do @@ -892,16 +890,16 @@ contains do q_loop = 0, p do l_loop = 0, n do k_loop = 0, m - blkmod1(k_loop, l_loop, q_loop) = ((gammas(1) + 1._wp)*q_prim_vf%vf(E_idx)%sf(k_loop, l_loop, & + blkmod1(k_loop, l_loop, q_loop) = ((gammas(1) + 1._wp)*q_prim_vf%vf(eqn_idx%E)%sf(k_loop, l_loop, & & q_loop) + pi_infs(1))/gammas(1) - blkmod2(k_loop, l_loop, q_loop) = ((gammas(2) + 1._wp)*q_prim_vf%vf(E_idx)%sf(k_loop, l_loop, & + blkmod2(k_loop, l_loop, q_loop) = ((gammas(2) + 1._wp)*q_prim_vf%vf(eqn_idx%E)%sf(k_loop, l_loop, & & q_loop) + pi_infs(2))/gammas(2) - alpha1(k_loop, l_loop, q_loop) = q_cons_vf%vf(advxb)%sf(k_loop, l_loop, q_loop) + alpha1(k_loop, l_loop, q_loop) = q_cons_vf%vf(eqn_idx%adv%beg)%sf(k_loop, l_loop, q_loop) if (bubbles_euler) then - alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(alf_idx - 1)%sf(k_loop, l_loop, q_loop) + alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(eqn_idx%alf - 1)%sf(k_loop, l_loop, q_loop) else - alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(advxe)%sf(k_loop, l_loop, q_loop) + alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(eqn_idx%adv%end)%sf(k_loop, l_loop, q_loop) end if Kterm(k_loop, l_loop, q_loop) = alpha1(k_loop, l_loop, q_loop)*alpha2(k_loop, l_loop, & @@ -946,12 +944,12 @@ contains do k_loop = 0, m do i_fluid_loop = 1, num_fluids inv_ds = 1._wp/dx(k_loop) - advected_qty_val = q_cons_vf%vf(i_fluid_loop + advxb - 1)%sf(k_loop, l_loop, q_loop) - pressure_val = q_prim_vf%vf(E_idx)%sf(k_loop, l_loop, q_loop) - flux_face1 = flux_src_n_vf%vf(advxb)%sf(k_loop, l_loop, q_loop) - flux_face2 = flux_src_n_vf%vf(advxb)%sf(k_loop - 1, l_loop, q_loop) - rhs_vf(i_fluid_loop + intxb - 1)%sf(k_loop, l_loop, & - & q_loop) = rhs_vf(i_fluid_loop + intxb - 1)%sf(k_loop, l_loop, & + advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(k_loop, l_loop, q_loop) + pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(k_loop, l_loop, q_loop) + flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(k_loop, l_loop, q_loop) + flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(k_loop - 1, l_loop, q_loop) + rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(k_loop, l_loop, & + & q_loop) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(k_loop, l_loop, & & q_loop) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2) end do end do @@ -992,14 +990,16 @@ contains do q = 0, m do i_fluid_loop = 1, num_fluids inv_ds = 1._wp/dy(k) - advected_qty_val = q_cons_vf%vf(i_fluid_loop + advxb - 1)%sf(q, k, l) - pressure_val = q_prim_vf%vf(E_idx)%sf(q, k, l) - flux_face1 = flux_src_n_vf%vf(advxb)%sf(q, k, l) - flux_face2 = flux_src_n_vf%vf(advxb)%sf(q, k - 1, l) - rhs_vf(i_fluid_loop + intxb - 1)%sf(q, k, l) = rhs_vf(i_fluid_loop + intxb - 1)%sf(q, k, & + advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(q, k, l) + pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(q, k, l) + flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(q, k, l) + flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(q, k - 1, l) + rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & + & l) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & & l) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2) if (cyl_coord) then - rhs_vf(i_fluid_loop + intxb - 1)%sf(q, k, l) = rhs_vf(i_fluid_loop + intxb - 1)%sf(q, k, & + rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & + & l) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(q, k, & & l) - 5.e-1_wp/y_cc(k)*advected_qty_val*pressure_val*(flux_face1 + flux_face2) end if end do @@ -1041,7 +1041,7 @@ contains do q = 0, n do l = 0, m inv_ds = 1._wp/(dz(k)*y_cc(q)) - velocity_val = q_prim_vf%vf(contxe + idir)%sf(l, q, k) + velocity_val = q_prim_vf%vf(eqn_idx%cont%end + idir)%sf(l, q, k) flux_face1 = flux_n(3)%vf(j)%sf(l, q, k - 1) flux_face2 = flux_n(3)%vf(j)%sf(l, q, k) rhs_vf(j)%sf(l, q, k) = rhs_vf(j)%sf(l, q, k) + inv_ds*velocity_val*(flux_face1 - flux_face2) @@ -1088,11 +1088,12 @@ contains do l = 0, m do i_fluid_loop = 1, num_fluids inv_ds = 1._wp/dz(k) - advected_qty_val = q_cons_vf%vf(i_fluid_loop + advxb - 1)%sf(l, q, k) - pressure_val = q_prim_vf%vf(E_idx)%sf(l, q, k) - flux_face1 = flux_src_n_vf%vf(advxb)%sf(l, q, k) - flux_face2 = flux_src_n_vf%vf(advxb)%sf(l, q, k - 1) - rhs_vf(i_fluid_loop + intxb - 1)%sf(l, q, k) = rhs_vf(i_fluid_loop + intxb - 1)%sf(l, q, & + advected_qty_val = q_cons_vf%vf(i_fluid_loop + eqn_idx%adv%beg - 1)%sf(l, q, k) + pressure_val = q_prim_vf%vf(eqn_idx%E)%sf(l, q, k) + flux_face1 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(l, q, k) + flux_face2 = flux_src_n_vf%vf(eqn_idx%adv%beg)%sf(l, q, k - 1) + rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(l, q, & + & k) = rhs_vf(i_fluid_loop + eqn_idx%int_en%beg - 1)%sf(l, q, & & k) - inv_ds*advected_qty_val*pressure_val*(flux_face1 - flux_face2) end do end do @@ -1128,12 +1129,12 @@ contains if (use_standard_riemann) then $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do q_idx = 0, p ! z_extent do l_idx = 0, n ! y_extent do k_idx = 0, m ! x_extent local_inv_ds = 1._wp/dx(k_idx) - local_term_coeff = q_prim_vf_arg%vf(contxe + current_idir)%sf(k_idx, l_idx, q_idx) + local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(k_idx, l_idx, q_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx - 1, l_idx, q_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx) rhs_vf_arg(j_adv)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(j_adv)%sf(k_idx, l_idx, & @@ -1150,13 +1151,13 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m local_inv_ds = 1._wp/dx(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxe)%sf(k_idx, l_idx, q_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(k_idx, l_idx, q_idx) local_k_term_val = Kterm_arg(k_idx, l_idx, q_idx) ! Access is safe due to outer alt_soundspeed check local_term_coeff = local_q_cons_val - local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxe)%sf(k_idx, l_idx, q_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxe)%sf(k_idx - 1, l_idx, q_idx) - rhs_vf_arg(advxe)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(advxe)%sf(k_idx, l_idx, & - & q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(k_idx, l_idx, q_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(k_idx - 1, l_idx, q_idx) + rhs_vf_arg(eqn_idx%adv%end)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(k_idx, & + & l_idx, q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1164,20 +1165,20 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m local_inv_ds = 1._wp/dx(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxb)%sf(k_idx, l_idx, q_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx) local_k_term_val = Kterm_arg(k_idx, l_idx, q_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxb)%sf(k_idx, l_idx, q_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxb)%sf(k_idx - 1, l_idx, q_idx) - rhs_vf_arg(advxb)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(advxb)%sf(k_idx, l_idx, & - & q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(k_idx - 1, l_idx, q_idx) + rhs_vf_arg(eqn_idx%adv%beg)%sf(k_idx, l_idx, q_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(k_idx, & + & l_idx, q_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) end do; end do; end do $:END_GPU_PARALLEL_LOOP() end if else ! NOT alt_soundspeed $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do q_idx = 0, p; do l_idx = 0, n; do k_idx = 0, m local_inv_ds = 1._wp/dx(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(k_idx, l_idx, q_idx) @@ -1196,12 +1197,12 @@ contains if (use_standard_riemann) then $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do l_idx = 0, p ! z_extent do k_idx = 0, n ! y_extent do q_idx = 0, m ! x_extent local_inv_ds = 1._wp/dy(k_idx) - local_term_coeff = q_prim_vf_arg%vf(contxe + current_idir)%sf(q_idx, k_idx, l_idx) + local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(q_idx, k_idx, l_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx - 1, l_idx) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx) rhs_vf_arg(j_adv)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(j_adv)%sf(q_idx, k_idx, & @@ -1218,16 +1219,16 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m local_inv_ds = 1._wp/dy(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxe)%sf(q_idx, k_idx, l_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx) ! Access is safe local_term_coeff = local_q_cons_val - local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxe)%sf(q_idx, k_idx, l_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxe)%sf(q_idx, k_idx - 1, l_idx) - rhs_vf_arg(advxe)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(advxe)%sf(q_idx, k_idx, & - & l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(q_idx, k_idx - 1, l_idx) + rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, & + & k_idx, l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) if (cyl_coord) then - rhs_vf_arg(advxe)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(advxe)%sf(q_idx, k_idx, & - & l_idx) - (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) + rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(q_idx, & + & k_idx, l_idx) - (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) end if end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1236,16 +1237,16 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m local_inv_ds = 1._wp/dy(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxb)%sf(q_idx, k_idx, l_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) local_k_term_val = Kterm_arg(q_idx, k_idx, l_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxb)%sf(q_idx, k_idx, l_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxb)%sf(q_idx, k_idx - 1, l_idx) - rhs_vf_arg(advxb)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(advxb)%sf(q_idx, k_idx, & - & l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(q_idx, k_idx - 1, l_idx) + rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, & + & k_idx, l_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) if (cyl_coord) then - rhs_vf_arg(advxb)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(advxb)%sf(q_idx, k_idx, & - & l_idx) + (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) + rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, k_idx, l_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(q_idx, & + & k_idx, l_idx) + (local_k_term_val/(2._wp*y_cc(k_idx)))*(local_flux1 + local_flux2) end if end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1253,7 +1254,7 @@ contains else ! NOT alt_soundspeed $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do l_idx = 0, p; do k_idx = 0, n; do q_idx = 0, m local_inv_ds = 1._wp/dy(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(q_idx, k_idx, l_idx) @@ -1277,12 +1278,12 @@ contains if (use_standard_riemann) then $:GPU_PARALLEL_LOOP(collapse=4,private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do k_idx = 0, p ! z_extent do q_idx = 0, n ! y_extent do l_idx = 0, m ! x_extent local_inv_ds = 1._wp/dz(k_idx) - local_term_coeff = q_prim_vf_arg%vf(contxe + current_idir)%sf(l_idx, q_idx, k_idx) + local_term_coeff = q_prim_vf_arg%vf(eqn_idx%cont%end + current_idir)%sf(l_idx, q_idx, k_idx) local_flux1 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx - 1) local_flux2 = flux_src_n_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx) rhs_vf_arg(j_adv)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(j_adv)%sf(l_idx, q_idx, & @@ -1299,13 +1300,13 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m local_inv_ds = 1._wp/dz(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxe)%sf(l_idx, q_idx, k_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx) ! Access is safe local_term_coeff = local_q_cons_val - local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxe)%sf(l_idx, q_idx, k_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxe)%sf(l_idx, q_idx, k_idx - 1) - rhs_vf_arg(advxe)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(advxe)%sf(l_idx, q_idx, & - & k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx - 1) + rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%end)%sf(l_idx, & + & q_idx, k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) end do; end do; end do $:END_GPU_PARALLEL_LOOP() @@ -1313,20 +1314,20 @@ contains & local_k_term_val, local_term_coeff, local_flux1, local_flux2]') do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m local_inv_ds = 1._wp/dz(k_idx) - local_q_cons_val = q_cons_vf_arg%vf(advxb)%sf(l_idx, q_idx, k_idx) + local_q_cons_val = q_cons_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) local_k_term_val = Kterm_arg(l_idx, q_idx, k_idx) ! Access is safe local_term_coeff = local_q_cons_val + local_k_term_val - local_flux1 = flux_src_n_vf_arg%vf(advxb)%sf(l_idx, q_idx, k_idx) - local_flux2 = flux_src_n_vf_arg%vf(advxb)%sf(l_idx, q_idx, k_idx - 1) - rhs_vf_arg(advxb)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(advxb)%sf(l_idx, q_idx, & - & k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) + local_flux1 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) + local_flux2 = flux_src_n_vf_arg%vf(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx - 1) + rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, q_idx, k_idx) = rhs_vf_arg(eqn_idx%adv%beg)%sf(l_idx, & + & q_idx, k_idx) + local_inv_ds*local_term_coeff*(local_flux1 - local_flux2) end do; end do; end do $:END_GPU_PARALLEL_LOOP() end if else ! NOT alt_soundspeed $:GPU_PARALLEL_LOOP(collapse=4, private='[j_adv, k_idx, l_idx, q_idx, local_inv_ds, local_term_coeff, & & local_flux1, local_flux2]') - do j_adv = advxb, advxe + do j_adv = eqn_idx%adv%beg, eqn_idx%adv%end do k_idx = 0, p; do q_idx = 0, n; do l_idx = 0, m local_inv_ds = 1._wp/dz(k_idx) local_term_coeff = q_cons_vf_arg%vf(j_adv)%sf(l_idx, q_idx, k_idx) @@ -1362,8 +1363,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(c_idx)%sf(j, k, l) = rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dx(j)*q_prim_vf(c_idx)%sf(j, k, & - & l)*(flux_src_n_in(advxb)%sf(j, k, l) - flux_src_n_in(advxb)%sf(j - 1, k, l)) + rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & + & l) + 1._wp/dx(j)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & + & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j - 1, k, l)) end do end do end do @@ -1377,7 +1379,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, & & l) - flux_src_n_in(i)%sf(j, k, l)) end do @@ -1385,15 +1387,15 @@ contains if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)*(flux_src_n_in(i)%sf(j - 1, k, & & l) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & - & l) + 1._wp/dx(j)*(flux_src_n_in(E_idx)%sf(j - 1, k, l) - flux_src_n_in(E_idx)%sf(j, & - & k, l)) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + & l) + 1._wp/dx(j)*(flux_src_n_in(eqn_idx%E)%sf(j - 1, k, & + & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if end do @@ -1407,8 +1409,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(c_idx)%sf(j, k, l) = rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dy(k)*q_prim_vf(c_idx)%sf(j, k, & - & l)*(flux_src_n_in(advxb)%sf(j, k, l) - flux_src_n_in(advxb)%sf(j, k - 1, l)) + rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & + & l) + 1._wp/dy(k)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & + & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k - 1, l)) end do end do end do @@ -1418,20 +1421,20 @@ contains if (cyl_coord .and. ((bc_y%beg == -2) .or. (bc_y%beg == -14))) then if (viscous .or. dummy) then if (p > 0) then - call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, dq_prim_dx_vf(mom_idx%beg:mom_idx%end), & - & dq_prim_dy_vf(mom_idx%beg:mom_idx%end), dq_prim_dz_vf(mom_idx%beg:mom_idx%end), tau_Re_vf, & - & idwbuff(1), idwbuff(2), idwbuff(3)) + call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, & + & dq_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), dq_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dq_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), tau_Re_vf, idwbuff(1), idwbuff(2), idwbuff(3)) else - call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, dq_prim_dx_vf(mom_idx%beg:mom_idx%end), & - & dq_prim_dy_vf(mom_idx%beg:mom_idx%end), dq_prim_dz_vf(mom_idx%beg:mom_idx%end), tau_Re_vf, & - & idwbuff(1), idwbuff(2), idwbuff(3)) + call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, & + & dq_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), dq_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dq_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), tau_Re_vf, idwbuff(1), idwbuff(2), idwbuff(3)) end if $:GPU_PARALLEL_LOOP(private='[i, j, l]', collapse=2) do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) + 1._wp/(y_cc(1) - y_cc(-1))*(tau_Re_vf(i)%sf(j, & & -1, l) - tau_Re_vf(i)%sf(j, 1, l)) end do @@ -1445,7 +1448,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, k - 1, & & l) - flux_src_n_in(i)%sf(j, k, l)) end do @@ -1461,7 +1464,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) end do @@ -1469,14 +1472,14 @@ contains if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & - & l) + 1._wp/dy(k)*(flux_src_n_in(E_idx)%sf(j, k - 1, & - & l) - flux_src_n_in(E_idx)%sf(j, k, l)) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + & l) + 1._wp/dy(k)*(flux_src_n_in(eqn_idx%E)%sf(j, k - 1, & + & l) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if end do @@ -1494,7 +1497,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) + flux_src_n_in(i)%sf(j, k, l)) end do @@ -1508,7 +1511,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, 0, l) = rhs_vf(i)%sf(j, 0, l) - 1._wp/y_cc(0)*tau_Re_vf(i)%sf(j, 0, l) end do end do @@ -1521,7 +1524,7 @@ contains do k = 0, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) - 5.e-1_wp/y_cc(k)*(flux_src_n_in(i)%sf(j, & & k - 1, l) + flux_src_n_in(i)%sf(j, k, l)) end do @@ -1537,8 +1540,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(c_idx)%sf(j, k, l) = rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dz(l)*q_prim_vf(c_idx)%sf(j, k, & - & l)*(flux_src_n_in(advxb)%sf(j, k, l) - flux_src_n_in(advxb)%sf(j, k, l - 1)) + rhs_vf(eqn_idx%c)%sf(j, k, l) = rhs_vf(eqn_idx%c)%sf(j, k, & + & l) + 1._wp/dz(l)*q_prim_vf(eqn_idx%c)%sf(j, k, l)*(flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, & + & l) - flux_src_n_in(eqn_idx%adv%beg)%sf(j, k, l - 1)) end do end do end do @@ -1552,7 +1556,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, & & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do @@ -1560,14 +1564,14 @@ contains if (chem_params%diffusion) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end rhs_vf(i)%sf(j, k, l) = rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)*(flux_src_n_in(i)%sf(j, k, & & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - rhs_vf(E_idx)%sf(j, k, l) = rhs_vf(E_idx)%sf(j, k, & - & l) + 1._wp/dz(l)*(flux_src_n_in(E_idx)%sf(j, k, l - 1) - flux_src_n_in(E_idx)%sf(j, & - & k, l)) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + & l) + 1._wp/dz(l)*(flux_src_n_in(eqn_idx%E)%sf(j, k, & + & l - 1) - flux_src_n_in(eqn_idx%E)%sf(j, k, l)) end if end if end do @@ -1581,11 +1585,13 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + 5.e-1_wp*(flux_src_n_in(momxe)%sf(j, & - & k, l - 1) + flux_src_n_in(momxe)%sf(j, k, l)) + rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k, & + & l) + 5.e-1_wp*(flux_src_n_in(eqn_idx%mom%end)%sf(j, k, & + & l - 1) + flux_src_n_in(eqn_idx%mom%end)%sf(j, k, l)) - rhs_vf(momxe)%sf(j, k, l) = rhs_vf(momxe)%sf(j, k, l) - 5.e-1_wp*(flux_src_n_in(momxb + 1)%sf(j, k, & - & l - 1) + flux_src_n_in(momxb + 1)%sf(j, k, l)) + rhs_vf(eqn_idx%mom%end)%sf(j, k, l) = rhs_vf(eqn_idx%mom%end)%sf(j, k, & + & l) - 5.e-1_wp*(flux_src_n_in(eqn_idx%mom%beg + 1)%sf(j, k, & + & l - 1) + flux_src_n_in(eqn_idx%mom%beg + 1)%sf(j, k, l)) end do end do end do @@ -1723,7 +1729,7 @@ contains call s_finalize_pressure_relaxation_module if (.not. igr) then - do j = cont_idx%beg, cont_idx%end + do j = eqn_idx%cont%beg, eqn_idx%cont%end if (relativity) then ! Cons and Prim densities are different for relativity @:DEALLOCATE(q_cons_qp%vf(j)%sf) @@ -1733,11 +1739,11 @@ contains end if end do - do j = adv_idx%beg, adv_idx%end + do j = eqn_idx%adv%beg, eqn_idx%adv%end nullify (q_prim_qp%vf(j)%sf) end do - do j = mom_idx%beg, E_idx + do j = eqn_idx%mom%beg, eqn_idx%E @:DEALLOCATE(q_cons_qp%vf(j)%sf) @:DEALLOCATE(q_prim_qp%vf(j)%sf) end do @@ -1757,17 +1763,17 @@ contains end if if (viscous) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf) end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf) end do if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf) end do end if @@ -1778,20 +1784,20 @@ contains @:DEALLOCATE(dq_prim_dz_qp(1)%vf) do i = num_dims, 1, -1 - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dx_n(i)%vf(l)%sf) end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dy_n(i)%vf(l)%sf) end do end if if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf) end do @@ -1819,9 +1825,9 @@ contains if (cyl_coord) then do i = 1, num_dims - @:DEALLOCATE(tau_re_vf(cont_idx%end + i)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%cont%end + i)%sf) end do - @:DEALLOCATE(tau_re_vf(e_idx)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%E)%sf) @:DEALLOCATE(tau_re_vf) end if end if @@ -1849,26 +1855,26 @@ contains end do if (viscous) then - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:DEALLOCATE(flux_src_n(i)%vf(l)%sf) end do end if if (chem_params%diffusion .and. .not. viscous) then - @:DEALLOCATE(flux_src_n(i)%vf(E_idx)%sf) + @:DEALLOCATE(flux_src_n(i)%vf(eqn_idx%E)%sf) end if if (riemann_solver == 1 .or. riemann_solver == 4) then - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end @:DEALLOCATE(flux_src_n(i)%vf(l)%sf) end do else - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end nullify (flux_src_n(i)%vf(l)%sf) end do end if - @:DEALLOCATE(flux_src_n(i)%vf(adv_idx%beg)%sf) + @:DEALLOCATE(flux_src_n(i)%vf(eqn_idx%adv%beg)%sf) end if @:DEALLOCATE(flux_n(i)%vf, flux_src_n(i)%vf, flux_gsrc_n(i)%vf) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index e43187e3f9..33661b54d7 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -233,7 +233,7 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, i) alpha_rho_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do @@ -242,36 +242,36 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) if (mhd) then if (n == 0) then ! 1D: constant Bx; By, Bz as variables B%L(1) = Bx0 B%R(1) = Bx0 - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz as variables - B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 2) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 2) + B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 2) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 2) end if end if @@ -341,9 +341,9 @@ contains if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys_L(i - chemxb + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) - Ys_R(i - chemxb + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys_L(i - eqn_idx%species%beg + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) + Ys_R(i - eqn_idx%species%beg + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do call get_mixture_molecular_weight(Ys_L, MW_L) @@ -446,20 +446,20 @@ contains end do if (cont_damage) then - G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, damage_idx)), 0._wp) - G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, damage_idx)), 0._wp) + G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%damage)), 0._wp) + G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%damage)), 0._wp) end if $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) ! Elastic contribution to energy if G large enough TODO take out if statement if stable without if ((G_L > 1000) .and. (G_R > 1000)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) ! Double for shear stresses - if (any(strxb - 1 + i == shear_indices)) then + if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) end if @@ -567,14 +567,14 @@ contains ! Mass if (.not. relativity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, & & i) = (s_M*alpha_rho_R(i)*vel_R(norm_dir) - s_P*alpha_rho_L(i) & & *vel_L(norm_dir) + s_M*s_P*(alpha_rho_L(i) - alpha_rho_R(i)))/(s_M - s_P) end do else if (relativity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, & & i) = (s_M*Ga%R*alpha_rho_R(i)*vel_R(norm_dir) - s_P*Ga%L*alpha_rho_L(i) & & *vel_L(norm_dir) + s_M*s_P*(Ga%L*alpha_rho_L(i) - Ga%R*alpha_rho_R(i))) & @@ -589,10 +589,10 @@ contains ! Flux of rho*v_i in the ${XYZ}$ direction = rho * v_i * v_${XYZ}$ - B_i * B_${XYZ}$ + ! delta_(${XYZ}$,i) * p_tot flux_rs${XYZ}$_vf(j, k, l, & - & contxe + i) = (s_M*(rho_R*vel_R(i)*vel_R(norm_dir) - B%R(i)*B%R(norm_dir) & - & + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(rho_L*vel_L(i)*vel_L(norm_dir) & - & - B%L(i)*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L)) & - & + s_M*s_P*(rho_L*vel_L(i) - rho_R*vel_R(i)))/(s_M - s_P) + & eqn_idx%cont%end + i) = (s_M*(rho_R*vel_R(i)*vel_R(norm_dir) - B%R(i) & + & *B%R(norm_dir) + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(rho_L*vel_L(i) & + & *vel_L(norm_dir) - B%L(i)*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L) & + & ) + s_M*s_P*(rho_L*vel_L(i) - rho_R*vel_R(i)))/(s_M - s_P) end do else if (mhd .and. relativity) then $:GPU_LOOP(parallelism='[seq]') @@ -600,27 +600,28 @@ contains ! Flux of m_i in the ${XYZ}$ direction = m_i * v_${XYZ}$ - b_i/Gamma * B_${XYZ}$ + ! delta_(${XYZ}$,i) * p_tot flux_rs${XYZ}$_vf(j, k, l, & - & contxe + i) = (s_M*(cm%R(i)*vel_R(norm_dir) - b4%R(i)/Ga%R*B%R(norm_dir) & - & + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(cm%L(i)*vel_L(norm_dir) & - & - b4%L(i)/Ga%L*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L)) & - & + s_M*s_P*(cm%L(i) - cm%R(i)))/(s_M - s_P) + & eqn_idx%cont%end + i) = (s_M*(cm%R(i)*vel_R(norm_dir) - b4%R(i) & + & /Ga%R*B%R(norm_dir) + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(cm%L(i) & + & *vel_L(norm_dir) - b4%L(i)/Ga%L*B%L(norm_dir) + dir_flg(i)*(pres_L & + & + pres_mag%L)) + s_M*s_P*(cm%L(i) - cm%R(i)))/(s_M - s_P) end do else if (bubbles_euler) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*(pres_R - ptilde_R)) - s_P*(rho_L*vel_L(dir_idx(1)) & - & *vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_L - ptilde_L)) & - & + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) & - & + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_R - ptilde_R)) & + & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & + & *(pres_L - ptilde_L)) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & + & - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & + & *pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) end do else if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*pres_R - tau_e_R(dir_idx_tau(i))) & + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R - tau_e_R(dir_idx_tau(i))) & & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & & *pres_L - tau_e_L(dir_idx_tau(i))) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & & - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) @@ -629,11 +630,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*pres_R) - s_P*(rho_L*vel_L(dir_idx(1)) & - & *vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L) & - & + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) & - & + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R) & + & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & + & *pres_L) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i)))) & + & /(s_M - s_P) + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) & + & - vel_L(dir_idx(i))) end do end if @@ -642,8 +644,8 @@ contains ! energy flux = (E + p + p_mag) * v_${XYZ}$ - B_${XYZ}$ * (v_x*B_x + v_y*B_y + v_z*B_z) #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) - B%R(norm_dir) & - & *(vel_R(1)*B%R(1) + vel_R(2)*B%R(2) + vel_R(3)*B%R(3))) & + & eqn_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & - B%R(norm_dir)*(vel_R(1)*B%R(1) + vel_R(2)*B%R(2) + vel_R(3)*B%R(3))) & & - s_P*(vel_L(norm_dir)*(E_L + pres_L + pres_mag%L) - B%L(norm_dir) & & *(vel_L(1)*B%L(1) + vel_L(2)*B%L(2) + vel_L(3)*B%L(3))) + s_M*s_P*(E_L & & - E_R))/(s_M - s_P) @@ -651,12 +653,12 @@ contains else if (mhd .and. relativity) then ! energy flux = m_${XYZ}$ - mass flux Hard-coded for single-component for now flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & + & eqn_idx%E) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & & - s_P*(cm%L(norm_dir) - Ga%L*alpha_rho_L(1)*vel_L(norm_dir)) + s_M*s_P*(E_L & & - E_R))/(s_M - s_P) else if (bubbles_euler) then flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & + & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & & - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + s_M*s_P*(E_L - E_R))/(s_M & & - s_P) + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R_rms - vel_L_rms)/2._wp else if (hypoelasticity) then @@ -667,21 +669,21 @@ contains flux_tau_R = flux_tau_R + tau_e_R(dir_idx_tau(i))*vel_R(dir_idx(i)) end do flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & + & eqn_idx%E) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & & - s_P*(vel_L(dir_idx(1))*(E_L + pres_L) - flux_tau_L) + s_M*s_P*(E_L - E_R)) & & /(s_M - s_P) else flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1))*(E_L & - & + pres_L) + s_M*s_P*(E_L - E_R))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & + & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & *(E_L + pres_L) + s_M*s_P*(E_L - E_R))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & & *pcorr*(vel_R_rms - vel_L_rms)/2._wp end if ! Elastic Stresses if (hypoelasticity) then - do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow flux_rs${XYZ}$_vf(j, k, l, & - & strxb - 1 + i) = (s_M*(rho_R*vel_R(dir_idx(1))*tau_e_R(i)) & + & eqn_idx%stress%beg - 1 + i) = (s_M*(rho_R*vel_R(dir_idx(1))*tau_e_R(i)) & & - s_P*(rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + s_M*s_P*(rho_L*tau_e_L(i) & & - rho_R*tau_e_R(i)))/(s_M - s_P) end do @@ -689,7 +691,7 @@ contains ! Advection flux and source: interface velocity for volume fraction transport $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = (qL_prim_rs${XYZ}$_vf(j, k, l, i) - qR_prim_rs${XYZ}$_vf(j + 1, & & k, l, i))*s_M*s_P/(s_M - s_P) flux_src_rs${XYZ}$_vf(j, k, l, i) = (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & @@ -699,13 +701,13 @@ contains if (bubbles_euler) then ! From HLLC: Kills mass transport @ bubble gas density if (num_fluids > 1) then - flux_rs${XYZ}$_vf(j, k, l, contxe) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end) = 0._wp end if end if if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end Y_L = qL_prim_rs${XYZ}$_vf(j, k, l, i) Y_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) @@ -723,7 +725,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 flux_rsx_vf(j, k, l, & - & B_idx%beg + i) = (s_M*(vel_R(1)*B%R(2 + i) - vel_R(2 + i)*Bx0) & + & eqn_idx%B%beg + i) = (s_M*(vel_R(1)*B%R(2 + i) - vel_R(2 + i)*Bx0) & & - s_P*(vel_L(1)*B%L(2 + i) - vel_L(2 + i)*Bx0) + s_M*s_P*(B%L(2 + i) & & - B%R(2 + i)))/(s_M - s_P) end do @@ -734,54 +736,56 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 2 flux_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + i) = (s_M*(vel_R(dir_idx(1))*B%R(i + 1) - vel_R(i + 1) & + & eqn_idx%B%beg + i) = (s_M*(vel_R(dir_idx(1))*B%R(i + 1) - vel_R(i + 1) & & *B%R(norm_dir)) - s_P*(vel_L(dir_idx(1))*B%L(i + 1) - vel_L(i + 1) & & *B%L(norm_dir)) + s_M*s_P*(B%L(i + 1) - B%R(i + 1)))/(s_M - s_P) end do if (hyper_cleaning) then ! propagate magnetic field divergence as a wave - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + norm_dir - 1) = flux_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + norm_dir - 1) + (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & psi_idx) - s_P*qL_prim_rs${XYZ}$_vf(j, k, l, psi_idx))/(s_M - s_P) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%B%beg + norm_dir - 1) + (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, eqn_idx%psi) - s_P*qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%psi))/(s_M - s_P) flux_rs${XYZ}$_vf(j, k, l, & - & psi_idx) = (hyper_cleaning_speed**2*(s_M*B%R(norm_dir) & + & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_M*B%R(norm_dir) & & - s_P*B%L(norm_dir)) + s_M*s_P*(qL_prim_rs${XYZ}$_vf(j, k, l, & - & psi_idx) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, psi_idx)))/(s_M - s_P) + & eqn_idx%psi) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & eqn_idx%psi)))/(s_M - s_P) else flux_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + norm_dir - 1) & + & eqn_idx%B%beg + norm_dir - 1) & & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero end if end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = 0._wp + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = 0._wp end if #:if (NORM_DIR == 2) if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + 2) = flux_rs${XYZ}$_vf(j, k, l, & - & contxe + 2) - (s_M*pres_R - s_P*pres_L)/(s_M - s_P) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + 2) - (s_M*pres_R - s_P*pres_L)/(s_M - s_P) ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do end if if (cyl_coord .and. hypoelasticity) then ! += tau_sigmasigma using HLL - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + 2) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & contxe + 2) + (s_M*tau_e_R(4) - s_P*tau_e_L(4))/(s_M - s_P) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + 2) + (s_M*tau_e_R(4) - s_P*tau_e_L(4))/(s_M - s_P) $:GPU_LOOP(parallelism='[seq]') - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do end if @@ -795,17 +799,25 @@ contains if (viscous .or. dummy) then if (weno_Re_flux) then - call s_compute_viscous_source_flux(qL_prim_vf(momxb:momxe), dqL_prim_dx_vf(momxb:momxe), & - & dqL_prim_dy_vf(momxb:momxe), dqL_prim_dz_vf(momxb:momxe), & - & qR_prim_vf(momxb:momxe), dqR_prim_dx_vf(momxb:momxe), & - & dqR_prim_dy_vf(momxb:momxe), dqR_prim_dz_vf(momxb:momxe), flux_src_vf, & - & norm_dir, ix, iy, iz) + call s_compute_viscous_source_flux(qL_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & qR_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, & + & iy, iz) else - call s_compute_viscous_source_flux(q_prim_vf(momxb:momxe), dqL_prim_dx_vf(momxb:momxe), & - & dqL_prim_dy_vf(momxb:momxe), dqL_prim_dz_vf(momxb:momxe), & - & q_prim_vf(momxb:momxe), dqR_prim_dx_vf(momxb:momxe), & - & dqR_prim_dy_vf(momxb:momxe), dqR_prim_dz_vf(momxb:momxe), flux_src_vf, & - & norm_dir, ix, iy, iz) + call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, & + & iy, iz) end if end if @@ -913,7 +925,7 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, i) alpha_rho_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do @@ -922,36 +934,36 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) if (mhd) then if (n == 0) then ! 1D: constant Bx; By, Bz as variables B%L(1) = Bx0 B%R(1) = Bx0 - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz as variables - B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 2) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 2) + B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 2) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 2) end if end if @@ -1021,9 +1033,9 @@ contains if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys_L(i - chemxb + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) - Ys_R(i - chemxb + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys_L(i - eqn_idx%species%beg + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) + Ys_R(i - eqn_idx%species%beg + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do call get_mixture_molecular_weight(Ys_L, MW_L) @@ -1124,19 +1136,19 @@ contains end do if (cont_damage) then - G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, damage_idx)), 0._wp) - G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, damage_idx)), 0._wp) + G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%damage)), 0._wp) + G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%damage)), 0._wp) end if - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) ! Elastic contribution to energy if G large enough TODO take out if statement if stable without if ((G_L > 1000) .and. (G_R > 1000)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) ! Double for shear stresses - if (any(strxb - 1 + i == shear_indices)) then + if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) end if @@ -1182,14 +1194,14 @@ contains ! Mass if (.not. relativity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, & & i) = (s_M*alpha_rho_R(i)*vel_R(norm_dir) - s_P*alpha_rho_L(i) & & *vel_L(norm_dir) + s_M*s_P*(alpha_rho_L(i) - alpha_rho_R(i)))/(s_M - s_P) end do else if (relativity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, & & i) = (s_M*Ga%R*alpha_rho_R(i)*vel_R(norm_dir) - s_P*Ga%L*alpha_rho_L(i) & & *vel_L(norm_dir) + s_M*s_P*(Ga%L*alpha_rho_L(i) - Ga%R*alpha_rho_R(i))) & @@ -1204,10 +1216,10 @@ contains ! Flux of rho*v_i in the ${XYZ}$ direction = rho * v_i * v_${XYZ}$ - B_i * B_${XYZ}$ + ! delta_(${XYZ}$,i) * p_tot flux_rs${XYZ}$_vf(j, k, l, & - & contxe + i) = (s_M*(rho_R*vel_R(i)*vel_R(norm_dir) - B%R(i)*B%R(norm_dir) & - & + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(rho_L*vel_L(i)*vel_L(norm_dir) & - & - B%L(i)*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L)) & - & + s_M*s_P*(rho_L*vel_L(i) - rho_R*vel_R(i)))/(s_M - s_P) + & eqn_idx%cont%end + i) = (s_M*(rho_R*vel_R(i)*vel_R(norm_dir) - B%R(i) & + & *B%R(norm_dir) + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(rho_L*vel_L(i) & + & *vel_L(norm_dir) - B%L(i)*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L) & + & ) + s_M*s_P*(rho_L*vel_L(i) - rho_R*vel_R(i)))/(s_M - s_P) end do else if (mhd .and. relativity) then $:GPU_LOOP(parallelism='[seq]') @@ -1215,27 +1227,28 @@ contains ! Flux of m_i in the ${XYZ}$ direction = m_i * v_${XYZ}$ - b_i/Gamma * B_${XYZ}$ + ! delta_(${XYZ}$,i) * p_tot flux_rs${XYZ}$_vf(j, k, l, & - & contxe + i) = (s_M*(cm%R(i)*vel_R(norm_dir) - b4%R(i)/Ga%R*B%R(norm_dir) & - & + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(cm%L(i)*vel_L(norm_dir) & - & - b4%L(i)/Ga%L*B%L(norm_dir) + dir_flg(i)*(pres_L + pres_mag%L)) & - & + s_M*s_P*(cm%L(i) - cm%R(i)))/(s_M - s_P) + & eqn_idx%cont%end + i) = (s_M*(cm%R(i)*vel_R(norm_dir) - b4%R(i) & + & /Ga%R*B%R(norm_dir) + dir_flg(i)*(pres_R + pres_mag%R)) - s_P*(cm%L(i) & + & *vel_L(norm_dir) - b4%L(i)/Ga%L*B%L(norm_dir) + dir_flg(i)*(pres_L & + & + pres_mag%L)) + s_M*s_P*(cm%L(i) - cm%R(i)))/(s_M - s_P) end do else if (bubbles_euler) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*(pres_R - ptilde_R)) - s_P*(rho_L*vel_L(dir_idx(1)) & - & *vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_L - ptilde_L)) & - & + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) & - & + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_R - ptilde_R)) & + & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & + & *(pres_L - ptilde_L)) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & + & - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & + & *pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) end do else if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*pres_R - tau_e_R(dir_idx_tau(i))) & + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R - tau_e_R(dir_idx_tau(i))) & & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & & *pres_L - tau_e_L(dir_idx_tau(i))) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & & - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) @@ -1244,11 +1257,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + dir_flg(dir_idx(i))*pres_R) - s_P*(rho_L*vel_L(dir_idx(1)) & - & *vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L) & - & + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i))))/(s_M - s_P) & - & + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + & eqn_idx%cont%end + dir_idx(i)) = (s_M*(rho_R*vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R) & + & - s_P*(rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i)) & + & *pres_L) + s_M*s_P*(rho_L*vel_L(dir_idx(i)) - rho_R*vel_R(dir_idx(i)))) & + & /(s_M - s_P) + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) & + & - vel_L(dir_idx(i))) end do end if @@ -1257,8 +1271,8 @@ contains ! energy flux = (E + p + p_mag) * v_${XYZ}$ - B_${XYZ}$ * (v_x*B_x + v_y*B_y + v_z*B_z) #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) - B%R(norm_dir) & - & *(vel_R(1)*B%R(1) + vel_R(2)*B%R(2) + vel_R(3)*B%R(3))) & + & eqn_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & - B%R(norm_dir)*(vel_R(1)*B%R(1) + vel_R(2)*B%R(2) + vel_R(3)*B%R(3))) & & - s_P*(vel_L(norm_dir)*(E_L + pres_L + pres_mag%L) - B%L(norm_dir) & & *(vel_L(1)*B%L(1) + vel_L(2)*B%L(2) + vel_L(3)*B%L(3))) + s_M*s_P*(E_L & & - E_R))/(s_M - s_P) @@ -1266,12 +1280,12 @@ contains else if (mhd .and. relativity) then ! energy flux = m_${XYZ}$ - mass flux Hard-coded for single-component for now flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & + & eqn_idx%E) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & & - s_P*(cm%L(norm_dir) - Ga%L*alpha_rho_L(1)*vel_L(norm_dir)) + s_M*s_P*(E_L & & - E_R))/(s_M - s_P) else if (bubbles_euler) then flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & + & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & & - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + s_M*s_P*(E_L - E_R))/(s_M & & - s_P) + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R_rms - vel_L_rms)/2._wp else if (hypoelasticity) then @@ -1282,21 +1296,21 @@ contains flux_tau_R = flux_tau_R + tau_e_R(dir_idx_tau(i))*vel_R(dir_idx(i)) end do flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & + & eqn_idx%E) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & & - s_P*(vel_L(dir_idx(1))*(E_L + pres_L) - flux_tau_L) + s_M*s_P*(E_L - E_R)) & & /(s_M - s_P) else flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1))*(E_L & - & + pres_L) + s_M*s_P*(E_L - E_R))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & + & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & *(E_L + pres_L) + s_M*s_P*(E_L - E_R))/(s_M - s_P) + (s_M/s_L)*(s_P/s_R) & & *pcorr*(vel_R_rms - vel_L_rms)/2._wp end if ! Elastic Stresses if (hypoelasticity) then - do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow flux_rs${XYZ}$_vf(j, k, l, & - & strxb - 1 + i) = (s_M*(rho_R*vel_R(dir_idx(1))*tau_e_R(i)) & + & eqn_idx%stress%beg - 1 + i) = (s_M*(rho_R*vel_R(dir_idx(1))*tau_e_R(i)) & & - s_P*(rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + s_M*s_P*(rho_L*tau_e_L(i) & & - rho_R*tau_e_R(i)))/(s_M - s_P) end do @@ -1304,7 +1318,7 @@ contains ! Advection flux and source: interface velocity for volume fraction transport $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = (qL_prim_rs${XYZ}$_vf(j, k, l, i) - qR_prim_rs${XYZ}$_vf(j + 1, & & k, l, i))*s_M*s_P/(s_M - s_P) flux_src_rs${XYZ}$_vf(j, k, l, i) = (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & @@ -1314,13 +1328,13 @@ contains if (bubbles_euler) then ! From HLLC: Kills mass transport @ bubble gas density if (num_fluids > 1) then - flux_rs${XYZ}$_vf(j, k, l, contxe) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end) = 0._wp end if end if if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end Y_L = qL_prim_rs${XYZ}$_vf(j, k, l, i) Y_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) @@ -1338,7 +1352,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 flux_rsx_vf(j, k, l, & - & B_idx%beg + i) = (s_M*(vel_R(1)*B%R(2 + i) - vel_R(2 + i)*Bx0) & + & eqn_idx%B%beg + i) = (s_M*(vel_R(1)*B%R(2 + i) - vel_R(2 + i)*Bx0) & & - s_P*(vel_L(1)*B%L(2 + i) - vel_L(2 + i)*Bx0) + s_M*s_P*(B%L(2 + i) & & - B%R(2 + i)))/(s_M - s_P) end do @@ -1349,39 +1363,39 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 2 flux_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + i) = (1 - dir_flg(i + 1))*(s_M*(vel_R(dir_idx(1))*B%R(i & - & + 1) - vel_R(i + 1)*B%R(norm_dir)) - s_P*(vel_L(dir_idx(1))*B%L(i + 1) & - & - vel_L(i + 1)*B%L(norm_dir)) + s_M*s_P*(B%L(i + 1) - B%R(i + 1))) & - & /(s_M - s_P) + & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_M*(vel_R(dir_idx(1)) & + & *B%R(i + 1) - vel_R(i + 1)*B%R(norm_dir)) - s_P*(vel_L(dir_idx(1)) & + & *B%L(i + 1) - vel_L(i + 1)*B%L(norm_dir)) + s_M*s_P*(B%L(i + 1) & + & - B%R(i + 1)))/(s_M - s_P) end do end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = 0._wp + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = 0._wp end if #:if (NORM_DIR == 2) if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + 2) = flux_rs${XYZ}$_vf(j, k, l, & - & contxe + 2) - (s_M*pres_R - s_P*pres_L)/(s_M - s_P) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + 2) - (s_M*pres_R - s_P*pres_L)/(s_M - s_P) ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do end if if (cyl_coord .and. hypoelasticity) then ! += tau_sigmasigma using HLL - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + 2) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & contxe + 2) + (s_M*tau_e_R(4) - s_P*tau_e_L(4))/(s_M - s_P) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + 2) + (s_M*tau_e_R(4) - s_P*tau_e_L(4))/(s_M - s_P) $:GPU_LOOP(parallelism='[seq]') - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do end if @@ -1407,37 +1421,37 @@ contains if (norm_dir == 1) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rsx_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rsx_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rsx_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rsx_vf(j, k, l, momxb + i - 1) - vel_R(i) = qR_prim_rsx_vf(j + 1, k, l, momxb + i - 1) + vel_L(i) = qL_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1) + vel_R(i) = qR_prim_rsx_vf(j + 1, k, l, eqn_idx%mom%beg + i - 1) end do else if (norm_dir == 2) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rsy_vf(k, j, l, E_idx + i) - alpha_R(i) = qR_prim_rsy_vf(k + 1, j, l, E_idx + i) + alpha_L(i) = qL_prim_rsy_vf(k, j, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rsy_vf(k + 1, j, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rsy_vf(k, j, l, momxb + i - 1) - vel_R(i) = qR_prim_rsy_vf(k + 1, j, l, momxb + i - 1) + vel_L(i) = qL_prim_rsy_vf(k, j, l, eqn_idx%mom%beg + i - 1) + vel_R(i) = qR_prim_rsy_vf(k + 1, j, l, eqn_idx%mom%beg + i - 1) end do else $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rsz_vf(l, k, j, E_idx + i) - alpha_R(i) = qR_prim_rsz_vf(l + 1, k, j, E_idx + i) + alpha_L(i) = qL_prim_rsz_vf(l, k, j, eqn_idx%E + i) + alpha_R(i) = qR_prim_rsz_vf(l + 1, k, j, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rsz_vf(l, k, j, momxb + i - 1) - vel_R(i) = qR_prim_rsz_vf(l + 1, k, j, momxb + i - 1) + vel_L(i) = qL_prim_rsz_vf(l, k, j, eqn_idx%mom%beg + i - 1) + vel_R(i) = qR_prim_rsz_vf(l + 1, k, j, eqn_idx%mom%beg + i - 1) end do end if @@ -1462,19 +1476,19 @@ contains if (shear_stress) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_grad_L(i, 1) = (dqL_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/Re_L(1)) - vel_grad_R(i, 1) = (dqR_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), & - & idx_right_phys(3))/Re_R(1)) + vel_grad_L(i, 1) = (dqL_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(1)) + vel_grad_R(i, 1) = (dqR_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & + & idx_right_phys(2), idx_right_phys(3))/Re_R(1)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 if (num_dims > 1) then - vel_grad_L(i, 2) = (dqL_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/Re_L(1)) - vel_grad_R(i, 2) = (dqR_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), & + vel_grad_L(i, 2) = (dqL_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(1)) + vel_grad_R(i, 2) = (dqR_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & & idx_right_phys(2), idx_right_phys(3))/Re_R(1)) end if #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - vel_grad_L(i, 3) = (dqL_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/Re_L(1)) - vel_grad_R(i, 3) = (dqR_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), & + vel_grad_L(i, 3) = (dqL_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(1)) + vel_grad_R(i, 3) = (dqR_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & & idx_right_phys(2), idx_right_phys(3))/Re_R(1)) end if #:endif @@ -1482,36 +1496,37 @@ contains end do if (norm_dir == 1) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(1) + vel_grad_R(1, 1)*vel_R(1)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 if (num_dims > 1) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(1) + vel_grad_R(2, & & 2)*vel_R(1)) - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, 2)) - 0.5_wp*(vel_grad_L(2, & & 1) + vel_grad_R(2, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 2)*vel_L(2) + vel_grad_R(1, 2)*vel_R(2)) - 0.5_wp*(vel_grad_L(2, & - & 1)*vel_L(2) + vel_grad_R(2, 1)*vel_R(2)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(2) + vel_grad_R(1, & + & 2)*vel_R(2)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(2) + vel_grad_R(2, 1)*vel_R(2)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, & & 3)*vel_L(1) + vel_grad_R(3, 3)*vel_R(1)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & + & l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, & & 3)) - 0.5_wp*(vel_grad_L(3, 1) + vel_grad_R(3, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(3) + vel_grad_R(1, & & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, 1)*vel_L(3) + vel_grad_R(3, & & 1)*vel_R(3)) @@ -1521,33 +1536,34 @@ contains #:endif else if (norm_dir == 2) then #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2)) - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2)) - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 2) + vel_grad_R(1, 2)) - 0.5_wp*(vel_grad_L(2, 1) + vel_grad_R(2, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 2)*vel_L(1) + vel_grad_R(1, 2)*vel_R(1)) - 0.5_wp*(vel_grad_L(2, & - & 1)*vel_L(1) + vel_grad_R(2, 1)*vel_R(1)) + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 2) + vel_grad_R(1, 2)) - 0.5_wp*(vel_grad_L(2, & + & 1) + vel_grad_R(2, 1)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 2)*vel_L(1) + vel_grad_R(1, & + & 2)*vel_R(1)) - 0.5_wp*(vel_grad_L(2, 1)*vel_L(1) + vel_grad_R(2, 1)*vel_R(1)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & - & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, & + & k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3)*vel_L(2) + vel_grad_R(3, & & 3)*vel_R(2)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & - & l) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, & + & k, l) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, & & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(3) + vel_grad_R(2, & & 3)*vel_R(3)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(3) + vel_grad_R(3, & & 2)*vel_R(3)) @@ -1556,33 +1572,34 @@ contains #:endif else #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3)) - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 3) + vel_grad_R(1, 3)) - 0.5_wp*(vel_grad_L(3, 1) + vel_grad_R(3, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 3)*vel_L(1) + vel_grad_R(1, 3)*vel_R(1)) - 0.5_wp*(vel_grad_L(3, & - & 1)*vel_L(1) + vel_grad_R(3, 1)*vel_R(1)) + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 3) + vel_grad_R(1, 3)) - 0.5_wp*(vel_grad_L(3, & + & 1) + vel_grad_R(3, 1)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 3)*vel_L(1) + vel_grad_R(1, & + & 3)*vel_R(1)) - 0.5_wp*(vel_grad_L(3, 1)*vel_L(1) + vel_grad_R(3, 1)*vel_R(1)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3)) - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(2, 3) + vel_grad_R(2, 3)) - 0.5_wp*(vel_grad_L(3, & & 2) + vel_grad_R(3, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(2, & - & 3)*vel_L(2) + vel_grad_R(2, 3)*vel_R(2)) - 0.5_wp*(vel_grad_L(3, & - & 2)*vel_L(2) + vel_grad_R(3, 2)*vel_R(2)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(2, 3)*vel_L(2) + vel_grad_R(2, & + & 3)*vel_R(2)) - 0.5_wp*(vel_grad_L(3, 2)*vel_L(2) + vel_grad_R(3, 2)*vel_R(2)) #:endif end if end if @@ -1590,42 +1607,42 @@ contains if (bulk_stress) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_grad_L(i, 1) = (dqL_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/Re_L(2)) - vel_grad_R(i, 1) = (dqR_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), & - & idx_right_phys(3))/Re_R(2)) + vel_grad_L(i, 1) = (dqL_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(2)) + vel_grad_R(i, 1) = (dqR_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & + & idx_right_phys(2), idx_right_phys(3))/Re_R(2)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 if (num_dims > 1) then - vel_grad_L(i, 2) = (dqL_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/Re_L(2)) - vel_grad_R(i, 2) = (dqR_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), & + vel_grad_L(i, 2) = (dqL_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(2)) + vel_grad_R(i, 2) = (dqR_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & & idx_right_phys(2), idx_right_phys(3))/Re_R(2)) end if #:endif #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - vel_grad_L(i, 3) = (dqL_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/Re_L(2)) - vel_grad_R(i, 3) = (dqR_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), & + vel_grad_L(i, 3) = (dqL_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/Re_L(2)) + vel_grad_R(i, 3) = (dqR_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), & & idx_right_phys(2), idx_right_phys(3))/Re_R(2)) end if #:endif end do if (norm_dir == 1) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & & 1)*vel_L(1) + vel_grad_R(1, 1)*vel_R(1)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 if (num_dims > 1) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_L(2, & - & 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(2, & - & 2)*vel_L(1) + vel_grad_R(2, 2)*vel_R(1)) + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(1) + vel_grad_R(2, 2)*vel_R(1)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(1) + vel_grad_R(3, 3)*vel_R(1)) end if #:endif @@ -1633,41 +1650,41 @@ contains #:endif else if (norm_dir == 2) then #:if not MFC_CASE_OPTIMIZATION or num_dims > 1 - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(2) + vel_grad_R(1, 1)*vel_R(2)) - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(2, & - & 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(2) + vel_grad_R(2, 2)*vel_R(2)) #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 if (num_dims > 2) then - flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, & - & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, & + & k, l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(2) + vel_grad_R(3, 3)*vel_R(2)) end if #:endif #:endif else #:if not MFC_CASE_OPTIMIZATION or num_dims > 2 - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & - & 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(1, 1)*vel_L(3) + vel_grad_R(1, 1)*vel_R(3)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(2, & - & 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(2, 2)*vel_L(3) + vel_grad_R(2, 2)*vel_R(3)) - flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, & & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_L(3, & - & 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3)) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - 0.5_wp*(vel_grad_L(3, 3)*vel_L(3) + vel_grad_R(3, 3)*vel_R(3)) #:endif end if end if @@ -1810,14 +1827,14 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) rho_L = 0._wp gamma_L = 0._wp @@ -1836,42 +1853,42 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, i)) - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, & - & E_idx + i)), 1._wp) - alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & + & l, eqn_idx%E + i)), 1._wp) + alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, & - & k, l, E_idx + i)), 1._wp) - alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp) + alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & - & E_idx + i)/max(alpha_L_sum, sgm_eps) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & E_idx + i)/max(alpha_R_sum, sgm_eps) + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%E + i)/max(alpha_L_sum, sgm_eps) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & eqn_idx%E + i)/max(alpha_R_sum, sgm_eps) end do end if $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids rho_L = rho_L + qL_prim_rs${XYZ}$_vf(j, k, l, i) - gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*pi_infs(i) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*pi_infs(i) qv_L = qv_L + qL_prim_rs${XYZ}$_vf(j, k, l, i)*qvs(i) rho_R = rho_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) - gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*pi_infs(i) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i) qv_R = qv_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*qvs(i) - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, advxb + i - 1) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, advxb + i - 1) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg + i - 1) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1) end do if (viscous) then @@ -1883,8 +1900,9 @@ contains if (Re_size(i) > 0) Re_R(i) = 0._wp $:GPU_LOOP(parallelism='[seq]') do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res_gs(i, q) + Re_L(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res_gs(i, q) + Re_R(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + Re_idx(i, q))/Res_gs(i, q) + Re_L(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + Re_idx(i, q))/Res_gs(i, & + & q) + Re_R(i) end do Re_L(i) = 1._wp/max(Re_L(i), sgm_eps) Re_R(i) = 1._wp/max(Re_R(i), sgm_eps) @@ -1897,9 +1915,9 @@ contains ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) end do G_L = 0._wp; G_R = 0._wp $:GPU_LOOP(parallelism='[seq]') @@ -1908,7 +1926,7 @@ contains G_R = G_R + alpha_R(i)*Gs_rs(i) end do $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! Elastic contribution to energy if G large enough if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) @@ -1926,8 +1944,8 @@ contains if (hyperelasticity) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%xi%beg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i) end do G_L = 0._wp; G_R = 0._wp $:GPU_LOOP(parallelism='[seq]') @@ -1938,13 +1956,13 @@ contains end do ! Elastic contribution to energy if G large enough if (G_L > verysmall .and. G_R > verysmall) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%xi%end + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%xi%end + 1) end if $:GPU_LOOP(parallelism='[seq]') do i = 1, b_size - 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) end do end if @@ -2053,7 +2071,7 @@ contains ! COMPUTING FLUXES MASS FLUX. $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -2063,14 +2081,14 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = rho_Star*vel_K_Star*(dir_flg(dir_idx(i)) & + & eqn_idx%cont%end + dir_idx(i)) = rho_Star*vel_K_Star*(dir_flg(dir_idx(i)) & & *vel_K_Star + (1._wp - dir_flg(dir_idx(i)))*(xi_M*vel_L(dir_idx(i)) & & + xi_P*vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star + (s_M/s_L) & & *(s_P/s_R)*dir_flg(dir_idx(i))*pcorr end do ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_star + p_Star)*vel_K_Star + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = (E_star + p_Star)*vel_K_Star + (s_M/s_L)*(s_P/s_R)*pcorr*s_S ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then @@ -2078,8 +2096,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) - xi_M*tau_e_L(dir_idx_tau(i)) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + dir_idx(i)) - xi_M*tau_e_L(dir_idx_tau(i)) & & - xi_P*tau_e_R(dir_idx_tau(i)) ! ENERGY ELASTIC FLUX. flux_ene_e = flux_ene_e - xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) & @@ -2088,12 +2106,12 @@ contains & *tau_e_R(dir_idx_tau(i)) + s_P*(xi_R*((s_S - vel_R(i)) & & *(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + flux_ene_e end if ! VOLUME FRACTION FLUX. $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*s_S + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S end do @@ -2118,26 +2136,28 @@ contains & *xi_R**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_R) & & + pres_R) - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = ((xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & i + advxb - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & i + advxb - 1))*(gammas(i)*p_K_Star + pi_infs(i)) & + flux_rs${XYZ}$_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & + & i + eqn_idx%adv%beg - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_K_Star + pi_infs(i)) & & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & i + contxb - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & i + contxb - 1))*qvs(i))*vel_K_Star + (s_M/s_L)*(s_P/s_R) & + & i + eqn_idx%cont%beg - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_K_Star + (s_M/s_L)*(s_P/s_R) & & *pcorr*s_S*(xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & i + advxb - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)) + & i + eqn_idx%adv%beg - 1) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & i + eqn_idx%adv%beg - 1)) end do - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 flux_rs${XYZ}$_vf(j, k, l, & - & strxb - 1 + i) = xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) & - & - rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + xi_P*(s_S/(s_R - s_S)) & - & *(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(dir_idx(1))*tau_e_R(i)) + & eqn_idx%stress%beg - 1 + i) = xi_M*(s_S/(s_L - s_S)) & + & *(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(dir_idx(1))*tau_e_L(i)) & + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) & + & - rho_R*vel_R(dir_idx(1))*tau_e_R(i)) end do end if @@ -2146,16 +2166,17 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & xibeg - 1 + i) = xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & - & - rho_L*vel_L(dir_idx(1))*xi_field_L(i)) + xi_P*(s_S/(s_R - s_S)) & - & *(s_R*rho_R*xi_field_R(i) - rho_R*vel_R(dir_idx(1))*xi_field_R(i)) + & eqn_idx%xi%beg - 1 + i) = xi_M*(s_S/(s_L - s_S)) & + & *(s_L*rho_L*xi_field_L(i) - rho_L*vel_L(dir_idx(1))*xi_field_L(i)) & + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + & - rho_R*vel_R(dir_idx(1))*xi_field_R(i)) end do end if ! COLOR FUNCTION FLUX if (surface_tension) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & c_idx) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%c) = (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%c) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%c))*s_S end if ! Geometrical source flux for cylindrical coordinates @@ -2163,19 +2184,20 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') - do i = intxb, intxe + do i = eqn_idx%int_en%beg, eqn_idx%int_en%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & momxb - 1 + dir_idx(1)) - p_Star + flux_gsrc_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rs${XYZ}$_vf(j, k, & + & l, eqn_idx%mom%beg - 1 + dir_idx(1)) - p_Star ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if @@ -2186,10 +2208,12 @@ contains do i = 1, sys_size flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & momxb - 1 + dir_idx(1)) - p_Star + flux_gsrc_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rs${XYZ}$_vf(j, k, & + & l, eqn_idx%mom%beg - 1 + dir_idx(1)) - p_Star - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%mom%end) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg + 1) end if #:endif end do @@ -2217,28 +2241,28 @@ contains qv_L = 0._wp; qv_R = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, i) alpha_rho_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') @@ -2254,8 +2278,8 @@ contains qv_R = qv_R + alpha_rho_R(i)*qvs(i) end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) E_L = gamma_L*pres_L + pi_inf_L + 5.e-1_wp*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5.e-1_wp*rho_R*vel_R_rms + qv_R @@ -2315,7 +2339,7 @@ contains xi_P = (5.e-1_wp - sign(5.e-1_wp, s_S)) $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, & & i) = xi_M*alpha_rho_L(i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*alpha_rho_R(i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -2325,28 +2349,29 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(i)) & - & + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_L) & - & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_R) + & eqn_idx%cont%end + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*pres_L) + xi_P*(rho_R*(vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*pres_R) end do if (bubbles_euler) then ! Put p_tilde in $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) + xi_M*(dir_flg(dir_idx(i))*(-1._wp*ptilde_L)) & - & + xi_P*(dir_flg(dir_idx(i))*(-1._wp*ptilde_R)) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + dir_idx(i)) + xi_M*(dir_flg(dir_idx(i)) & + & *(-1._wp*ptilde_L)) + xi_P*(dir_flg(dir_idx(i))*(-1._wp*ptilde_R)) end do end if - flux_rs${XYZ}$_vf(j, k, l, E_idx) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = alf_idx, alf_idx ! only advect the void fraction + do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -2359,12 +2384,12 @@ contains ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp end do - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) ! Add advection flux for bubble variables if (bubbles_euler) then $:GPU_LOOP(parallelism='[seq]') - do i = bubxb, bubxe + do i = eqn_idx%bub%beg, eqn_idx%bub%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*nbub_L*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & @@ -2378,12 +2403,12 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & eqn_idx%cont%end + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & @@ -2391,7 +2416,7 @@ contains & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if @@ -2403,13 +2428,14 @@ contains flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & momxb + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(1)) & - & + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & + & eqn_idx%mom%beg + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & - xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & & + s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%mom%end) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg + 1) end if #:endif end do @@ -2437,16 +2463,16 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do vel_L_rms = 0._wp; vel_R_rms = 0._wp $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do @@ -2456,24 +2482,24 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids rho_L = rho_L + qL_prim_rs${XYZ}$_vf(j, k, l, i) - gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*pi_infs(i) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*pi_infs(i) qv_L = qv_L + qL_prim_rs${XYZ}$_vf(j, k, l, i)*qvs(i) rho_R = rho_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) - gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*pi_infs(i) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i) qv_R = qv_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*qvs(i) end do else if (num_fluids > 2) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 rho_L = rho_L + qL_prim_rs${XYZ}$_vf(j, k, l, i) - gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*pi_infs(i) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*pi_infs(i) qv_L = qv_L + qL_prim_rs${XYZ}$_vf(j, k, l, i)*qvs(i) rho_R = rho_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) - gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*pi_infs(i) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i) qv_R = qv_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*qvs(i) end do else @@ -2499,9 +2525,9 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = 1, Re_size(i) - Re_L(i) = (1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q)))/Res_gs(i, & - & q) + Re_L(i) - Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, & + Re_L(i) = (1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + Re_idx(i, & + & q)))/Res_gs(i, q) + Re_L(i) + Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + Re_idx(i, & & q)))/Res_gs(i, q) + Re_R(i) end do @@ -2511,8 +2537,8 @@ contains end if end if - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) E_L = gamma_L*pres_L + pi_inf_L + 5.e-1_wp*rho_L*vel_L_rms E_R = gamma_R*pres_R + pi_inf_R + 5.e-1_wp*rho_R*vel_R_rms @@ -2536,8 +2562,8 @@ contains if (.not. qbmm) then if (adv_n) then - nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, n_idx) - nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, n_idx) + nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%n) + nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%n) else nbub_L = 0._wp nbub_R = 0._wp @@ -2547,13 +2573,14 @@ contains nbub_R = nbub_R + (R0_R(i)**3._wp)*weight(i) end do - nbub_L = (3._wp/(4._wp*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids)/nbub_L - nbub_R = (3._wp/(4._wp*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)/nbub_R + nbub_L = (3._wp/(4._wp*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_L + nbub_R = (3._wp/(4._wp*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & eqn_idx%E + num_fluids)/nbub_R end if else ! nb stored in 0th moment of first R0 bin in variable conversion module - nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, bubxb) - nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, bubxb) + nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%bub%beg) + nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%bub%beg) end if $:GPU_LOOP(parallelism='[seq]') @@ -2676,7 +2703,7 @@ contains end if $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -2684,7 +2711,7 @@ contains if (bubbles_euler .and. (num_fluids > 1)) then ! Kill mass transport @ gas density - flux_rs${XYZ}$_vf(j, k, l, contxe) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end) = 0._wp end if ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) @@ -2708,18 +2735,19 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(i)) & - & + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) & - & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & - & + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + & eqn_idx%cont%end + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*(pres_L)) + xi_P*(rho_R*(vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*(pres_R)) + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i)) & + & *pcorr end do ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & + & eqn_idx%E) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & & - vel_L(dir_idx(1)))*(rho_L*s_S + (pres_L)/(s_L - vel_L(dir_idx(1))))) - E_L)) & & + xi_P*(vel_R(dir_idx(1))*(E_R + pres_R) + s_P*(xi_R*(E_R + (s_S & & - vel_R(dir_idx(1)))*(rho_R*s_S + (pres_R)/(s_R - vel_R(dir_idx(1))))) - E_R)) & @@ -2727,7 +2755,7 @@ contains ! Volume fraction flux $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -2744,11 +2772,11 @@ contains ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp end do - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) ! Add advection flux for bubble variables $:GPU_LOOP(parallelism='[seq]') - do i = bubxb, bubxe + do i = eqn_idx%bub%beg, eqn_idx%bub%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*nbub_L*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & @@ -2757,13 +2785,13 @@ contains if (qbmm) then flux_rs${XYZ}$_vf(j, k, l, & - & bubxb) = xi_M*nbub_L*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + & eqn_idx%bub%beg) = xi_M*nbub_L*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*nbub_R*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if if (adv_n) then flux_rs${XYZ}$_vf(j, k, l, & - & n_idx) = xi_M*nbub_L*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + & eqn_idx%n) = xi_M*nbub_L*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*nbub_R*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if @@ -2772,12 +2800,12 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & eqn_idx%cont%end + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & @@ -2785,7 +2813,7 @@ contains & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if @@ -2798,13 +2826,14 @@ contains end do flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & momxb + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(1)) & - & + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & + & eqn_idx%mom%beg + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & - xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & & + s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%mom%end) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg + 1) end if #:endif end do @@ -2833,54 +2862,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) - vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) + vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + i) + vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + i) vel_L_rms = vel_L_rms + vel_L(i)**2._wp vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) ! Change this by splitting it into the cases present in the bubbles_euler if (mpp_lim) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, i)) - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, & - & E_idx + i)), 1._wp) + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & + & l, eqn_idx%E + i)), 1._wp) qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, & - & k, l, E_idx + i)), 1._wp) - alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp) + alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & - & E_idx + i)/max(alpha_L_sum, sgm_eps) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & E_idx + i)/max(alpha_R_sum, sgm_eps) + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%E + i)/max(alpha_L_sum, sgm_eps) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & eqn_idx%E + i)/max(alpha_R_sum, sgm_eps) end do end if $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids rho_L = rho_L + qL_prim_rs${XYZ}$_vf(j, k, l, i) - gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)*pi_infs(i) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i)*pi_infs(i) qv_L = qv_L + qL_prim_rs${XYZ}$_vf(j, k, l, i)*qvs(i) rho_R = rho_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) - gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)*pi_infs(i) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i) qv_R = qv_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*qvs(i) end do @@ -2908,9 +2937,9 @@ contains if (chemistry) then c_sum_Yi_Phi = 0.0_wp $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe - Ys_L(i - chemxb + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) - Ys_R(i - chemxb + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) + do i = eqn_idx%species%beg, eqn_idx%species%end + Ys_L(i - eqn_idx%species%beg + 1) = qL_prim_rs${XYZ}$_vf(j, k, l, i) + Ys_R(i - eqn_idx%species%beg + 1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do call get_mixture_molecular_weight(Ys_L, MW_L) @@ -2969,9 +2998,9 @@ contains ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) end do G_L = 0._wp G_R = 0._wp @@ -2981,7 +3010,7 @@ contains G_R = G_R + alpha_R(i)*Gs_rs(i) end do $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! Elastic contribution to energy if G large enough if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) @@ -2999,8 +3028,8 @@ contains if (hyperelasticity) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%xi%beg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i) end do G_L = 0._wp G_R = 0._wp @@ -3012,13 +3041,13 @@ contains end do ! Elastic contribution to energy if G large enough if (G_L > verysmall .and. G_R > verysmall) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%xi%end + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%xi%end + 1) end if $:GPU_LOOP(parallelism='[seq]') do i = 1, b_size - 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%stress%beg - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i) end do end if @@ -3114,7 +3143,7 @@ contains ! COMPUTING THE HLLC FLUXES MASS FLUX. $:GPU_LOOP(parallelism='[seq]') - do i = 1, contxe + do i = 1, eqn_idx%cont%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -3124,18 +3153,19 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(i)) & - & + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) & - & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(i)) & - & + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp - dir_flg(dir_idx(i))) & - & *vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & - & + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + & eqn_idx%cont%end + dir_idx(i)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*(pres_L)) + xi_P*(rho_R*(vel_R(dir_idx(1)) & + & *vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + (1._wp & + & - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) & + & + dir_flg(dir_idx(i))*(pres_R)) + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i)) & + & *pcorr end do ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, & - & E_idx) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & + & eqn_idx%E) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & & - vel_L(dir_idx(1)))*(rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) - E_L)) & & + xi_P*(vel_R(dir_idx(1))*(E_R + pres_R) + s_P*(xi_R*(E_R + (s_S & & - vel_R(dir_idx(1)))*(rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) - E_R)) & @@ -3147,8 +3177,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(i)) - xi_M*tau_e_L(dir_idx_tau(i)) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%cont%end + dir_idx(i)) - xi_M*tau_e_L(dir_idx_tau(i)) & & - xi_P*tau_e_R(dir_idx_tau(i)) ! ENERGY ELASTIC FLUX. flux_ene_e = flux_ene_e - xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) & @@ -3157,23 +3187,24 @@ contains & *tau_e_R(dir_idx_tau(i)) + s_P*(xi_R*((s_S - vel_R(i)) & & *(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + flux_ene_e end if ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then $:GPU_LOOP(parallelism='[seq]') - do i = 1, strxe - strxb + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 flux_rs${XYZ}$_vf(j, k, l, & - & strxb - 1 + i) = xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) & - & - rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + xi_P*(s_S/(s_R - s_S)) & - & *(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(dir_idx(1))*tau_e_R(i)) + & eqn_idx%stress%beg - 1 + i) = xi_M*(s_S/(s_L - s_S)) & + & *(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(dir_idx(1))*tau_e_L(i)) & + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) & + & - rho_R*vel_R(dir_idx(1))*tau_e_R(i)) end do end if ! VOLUME FRACTION FLUX. $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & & i)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) + xi_P*qR_prim_rs${XYZ}$_vf(j & & + 1, k, l, i)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) @@ -3190,10 +3221,10 @@ contains ! COLOR FUNCTION FLUX if (surface_tension) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & c_idx)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%c) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%c)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & c_idx)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + & eqn_idx%c)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if ! Hyperelastic reference map flux for material deformation tracking @@ -3201,17 +3232,18 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, & - & xibeg - 1 + i) = xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & - & - rho_L*vel_L(dir_idx(1))*xi_field_L(i)) + xi_P*(s_S/(s_R - s_S)) & - & *(s_R*rho_R*xi_field_R(i) - rho_R*vel_R(dir_idx(1))*xi_field_R(i)) + & eqn_idx%xi%beg - 1 + i) = xi_M*(s_S/(s_L - s_S)) & + & *(s_L*rho_L*xi_field_L(i) - rho_L*vel_L(dir_idx(1))*xi_field_L(i)) & + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + & - rho_R*vel_R(dir_idx(1))*xi_field_R(i)) end do end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) if (chemistry) then $:GPU_LOOP(parallelism='[seq]') - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end Y_L = qL_prim_rs${XYZ}$_vf(j, k, l, i) Y_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) @@ -3227,12 +3259,12 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & contxe + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & + & eqn_idx%cont%end + dir_idx(1)) = xi_M*(rho_L*(vel_L(dir_idx(1)) & & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & + xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & @@ -3240,7 +3272,7 @@ contains & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) ! Geometrical source of the void fraction(s) is zero $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if @@ -3253,13 +3285,14 @@ contains end do flux_gsrc_rs${XYZ}$_vf(j, k, l, & - & momxb + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1))*vel_L(dir_idx(1)) & - & + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & + & eqn_idx%mom%beg + 1) = -xi_M*(rho_L*(vel_L(dir_idx(1)) & + & *vel_L(dir_idx(1)) + s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & & - xi_P*(rho_R*(vel_R(dir_idx(1))*vel_R(dir_idx(1)) & & + s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + (1._wp & & - dir_flg(dir_idx(1)))*vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + flux_gsrc_rs${XYZ}$_vf(j, k, l, eqn_idx%mom%end) = flux_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%mom%beg + 1) end if #:endif end do @@ -3273,17 +3306,25 @@ contains if (viscous .or. dummy) then if (weno_Re_flux) then - call s_compute_viscous_source_flux(qL_prim_vf(momxb:momxe), dqL_prim_dx_vf(momxb:momxe), & - & dqL_prim_dy_vf(momxb:momxe), dqL_prim_dz_vf(momxb:momxe), & - & qR_prim_vf(momxb:momxe), dqR_prim_dx_vf(momxb:momxe), & - & dqR_prim_dy_vf(momxb:momxe), dqR_prim_dz_vf(momxb:momxe), flux_src_vf, & - & norm_dir, ix, iy, iz) + call s_compute_viscous_source_flux(qL_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & qR_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, & + & iy, iz) else - call s_compute_viscous_source_flux(q_prim_vf(momxb:momxe), dqL_prim_dx_vf(momxb:momxe), & - & dqL_prim_dy_vf(momxb:momxe), dqL_prim_dz_vf(momxb:momxe), & - & q_prim_vf(momxb:momxe), dqR_prim_dx_vf(momxb:momxe), & - & dqR_prim_dy_vf(momxb:momxe), dqR_prim_dz_vf(momxb:momxe), flux_src_vf, & - & norm_dir, ix, iy, iz) + call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqL_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & + & dqR_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, & + & iy, iz) end if end if @@ -3361,42 +3402,43 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end ! (1) Extract the left/right primitive states - do i = 1, contxe + do i = 1, eqn_idx%cont%end alpha_rho_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, i) alpha_rho_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) end do ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic do i = 1, num_vels - vel%L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) - vel%R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + dir_idx(i)) + vel%L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) + vel%R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i)) end do vel_rms%L = sum(vel%L**2._wp) vel_rms%R = sum(vel%R**2._wp) do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do - pres%L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres%L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic if (mhd) then if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated - B%L = [Bx0, qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg), qL_prim_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + 1)] - B%R = [Bx0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg), qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & B_idx%beg + 1)] + B%L = [Bx0, qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg), qL_prim_rs${XYZ}$_vf(j, k, l, & + & eqn_idx%B%beg + 1)] + B%R = [Bx0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg), qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, eqn_idx%B%beg + 1)] else ! 2D/3D: Bx, By, Bz as variables - B%L = [qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(1) - 1), qL_prim_rs${XYZ}$_vf(j, k, & - & l, B_idx%beg + dir_idx(2) - 1), qL_prim_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + dir_idx(3) - 1)] - B%R = [qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(1) - 1), & - & qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(2) - 1), & - & qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(3) - 1)] + B%L = [qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), qL_prim_rs${XYZ}$_vf(j, & + & k, l, eqn_idx%B%beg + dir_idx(2) - 1), qL_prim_rs${XYZ}$_vf(j, & + & k, l, eqn_idx%B%beg + dir_idx(3) - 1)] + B%R = [qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & eqn_idx%B%beg + dir_idx(2) - 1), qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, eqn_idx%B%beg + dir_idx(3) - 1)] end if end if @@ -3517,26 +3559,26 @@ contains ! (12) Write HLLD flux to output arrays flux_rs${XYZ}$_vf(j, k, l, 1) = F_hlld(1) ! TODO multi-component ! Momentum - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(1)) = F_hlld(2) - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(2)) = F_hlld(3) - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(3)) = F_hlld(4) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = F_hlld(2) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = F_hlld(3) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = F_hlld(4) ! Magnetic field if (n == 0) then - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) = F_hlld(6) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) = F_hlld(6) else - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2) - 1) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3) - 1) = F_hlld(6) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = F_hlld(6) end if ! Energy - flux_rs${XYZ}$_vf(j, k, l, E_idx) = F_hlld(7) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = F_hlld(7) ! Volume fractions $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + do i = eqn_idx%adv%beg, eqn_idx%adv%end flux_rs${XYZ}$_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now) end do - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = 0._wp + flux_src_rs${XYZ}$_vf(j, k, l, eqn_idx%adv%beg) = 0._wp end do end do end do @@ -3582,7 +3624,7 @@ contains @:ALLOCATE(flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) @:ALLOCATE(flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) - @:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size)) + @:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size)) @:ALLOCATE(vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels)) if (qbmm) then @:ALLOCATE(mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4)) @@ -3599,7 +3641,7 @@ contains @:ALLOCATE(flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) @:ALLOCATE(flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) - @:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size)) + @:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size)) @:ALLOCATE(vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels)) if (qbmm) then @@ -3617,7 +3659,7 @@ contains @:ALLOCATE(flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) @:ALLOCATE(flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size)) - @:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size)) + @:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size)) @:ALLOCATE(vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels)) if (qbmm) then @@ -3690,7 +3732,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqL_prim_dx_vf(i)%sf(-1, k, l) = dqR_prim_dx_vf(i)%sf(0, k, l) @@ -3701,7 +3743,7 @@ contains if (n > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqL_prim_dy_vf(i)%sf(-1, k, l) = dqR_prim_dy_vf(i)%sf(0, k, l) @@ -3712,7 +3754,7 @@ contains if (p > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqL_prim_dz_vf(i)%sf(-1, k, l) = dqR_prim_dz_vf(i)%sf(0, k, l) @@ -3739,7 +3781,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqR_prim_dx_vf(i)%sf(m + 1, k, l) = dqL_prim_dx_vf(i)%sf(m, k, l) @@ -3750,7 +3792,7 @@ contains if (n > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqR_prim_dy_vf(i)%sf(m + 1, k, l) = dqL_prim_dy_vf(i)%sf(m, k, l) @@ -3761,7 +3803,7 @@ contains if (p > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do k = isy%beg, isy%end dqR_prim_dz_vf(i)%sf(m + 1, k, l) = dqL_prim_dz_vf(i)%sf(m, k, l) @@ -3790,7 +3832,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqL_prim_dx_vf(i)%sf(j, -1, l) = dqR_prim_dx_vf(i)%sf(j, 0, l) @@ -3800,7 +3842,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqL_prim_dy_vf(i)%sf(j, -1, l) = dqR_prim_dy_vf(i)%sf(j, 0, l) @@ -3811,7 +3853,7 @@ contains if (p > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqL_prim_dz_vf(i)%sf(j, -1, l) = dqR_prim_dz_vf(i)%sf(j, 0, l) @@ -3837,7 +3879,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqR_prim_dx_vf(i)%sf(j, n + 1, l) = dqL_prim_dx_vf(i)%sf(j, n, l) @@ -3847,7 +3889,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqR_prim_dy_vf(i)%sf(j, n + 1, l) = dqL_prim_dy_vf(i)%sf(j, n, l) @@ -3858,7 +3900,7 @@ contains if (p > 0) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do l = isz%beg, isz%end do j = isx%beg, isx%end dqR_prim_dz_vf(i)%sf(j, n + 1, l) = dqL_prim_dz_vf(i)%sf(j, n, l) @@ -3886,7 +3928,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqL_prim_dx_vf(i)%sf(j, k, -1) = dqR_prim_dx_vf(i)%sf(j, k, 0) @@ -3895,7 +3937,7 @@ contains end do $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqL_prim_dy_vf(i)%sf(j, k, -1) = dqR_prim_dy_vf(i)%sf(j, k, 0) @@ -3904,7 +3946,7 @@ contains end do $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqL_prim_dz_vf(i)%sf(j, k, -1) = dqR_prim_dz_vf(i)%sf(j, k, 0) @@ -3929,7 +3971,7 @@ contains if (viscous .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqR_prim_dx_vf(i)%sf(j, k, p + 1) = dqL_prim_dx_vf(i)%sf(j, k, p) @@ -3939,7 +3981,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqR_prim_dy_vf(i)%sf(j, k, p + 1) = dqL_prim_dy_vf(i)%sf(j, k, p) @@ -3949,7 +3991,7 @@ contains $:END_GPU_PARALLEL_LOOP() $:GPU_PARALLEL_LOOP(collapse=3) - do i = momxb, momxe + do i = eqn_idx%mom%beg, eqn_idx%mom%end do k = isy%beg, isy%end do j = isx%beg, isx%end dqR_prim_dz_vf(i)%sf(j, k, p + 1) = dqL_prim_dz_vf(i)%sf(j, k, p) @@ -3976,7 +4018,7 @@ contains if (norm_dir == 1) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -3990,11 +4032,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, eqn_idx%species%end do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - if (i == E_idx .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then flux_src_vf(i)%sf(j, k, l) = 0._wp end if end do @@ -4022,7 +4064,7 @@ contains else if (norm_dir == 2) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4036,11 +4078,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, eqn_idx%species%end do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end - if (i == E_idx .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then flux_src_vf(i)%sf(k, j, l) = 0._wp end if end do @@ -4068,7 +4110,7 @@ contains else if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4082,11 +4124,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, eqn_idx%species%end do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end - if (i == E_idx .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then flux_src_vf(i)%sf(l, k, j) = 0._wp end if end do @@ -4263,9 +4305,9 @@ contains $:GPU_LOOP(parallelism='[seq]') do i_vel = 1, num_dims - flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) = flux_src_vf(momxb + i_vel - 1)%sf(j, k, & - & l) - stress_vector_shear(i_vel) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, & + & k, l) - stress_vector_shear(i_vel) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel) end do end if @@ -4273,9 +4315,10 @@ contains if (bulk_stress) then stress_normal_bulk = divergence_cyl/Re_b - flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) = flux_src_vf(momxb + norm_dir - 1)%sf(j, k, & - & l) - stress_normal_bulk - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - vel_src_int(norm_dir)*stress_normal_bulk + flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, & + & l) = flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) - vel_src_int(norm_dir)*stress_normal_bulk end if end do end do @@ -4381,10 +4424,11 @@ contains call s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, current_tau_shear) do i_dim = 1, num_dims - flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = flux_src_vf(momxb + i_dim - 1)%sf(j_loop, & - & k_loop, l_loop) - current_tau_shear(norm_dir, i_dim) + flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, & + & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, & + & l_loop) - current_tau_shear(norm_dir, i_dim) - flux_src_vf(E_idx)%sf(j_loop, k_loop, l_loop) = flux_src_vf(E_idx)%sf(j_loop, k_loop, & + flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, & & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim) end do end if @@ -4394,10 +4438,11 @@ contains call s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, current_tau_bulk) do i_dim = 1, num_dims - flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = flux_src_vf(momxb + i_dim - 1)%sf(j_loop, & - & k_loop, l_loop) - current_tau_bulk(norm_dir, i_dim) + flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, & + & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, & + & l_loop) - current_tau_bulk(norm_dir, i_dim) - flux_src_vf(E_idx)%sf(j_loop, k_loop, l_loop) = flux_src_vf(E_idx)%sf(j_loop, k_loop, & + flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, & & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim) end do end if @@ -4503,7 +4548,7 @@ contains do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end - flux_src_vf(advxb)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, advxb) + flux_src_vf(eqn_idx%adv%beg)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) end do end do end do @@ -4511,7 +4556,7 @@ contains if (riemann_solver == 1 .or. riemann_solver == 4) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = advxb + 1, advxe + do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4553,7 +4598,7 @@ contains do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end - flux_src_vf(advxb)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, advxb) + flux_src_vf(eqn_idx%adv%beg)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) end do end do end do @@ -4561,7 +4606,7 @@ contains if (riemann_solver == 1 .or. riemann_solver == 4) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = advxb + 1, advxe + do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4589,7 +4634,7 @@ contains do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - flux_src_vf(advxb)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, advxb) + flux_src_vf(eqn_idx%adv%beg)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) end do end do end do @@ -4597,7 +4642,7 @@ contains if (riemann_solver == 1 .or. riemann_solver == 4) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = advxb + 1, advxe + do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index e20ec982fe..4a0978919e 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -105,12 +105,12 @@ contains if (igr) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - vel(i) = q_prim_vf(contxe + i)%sf(j, k, l)/rho + vel(i) = q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l)/rho end do else $:GPU_LOOP(parallelism='[seq]') do i = 1, num_vels - vel(i) = q_prim_vf(contxe + i)%sf(j, k, l) + vel(i) = q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) end do end if @@ -121,16 +121,16 @@ contains end do if (igr) then - E = q_prim_vf(E_idx)%sf(j, k, l) + E = q_prim_vf(eqn_idx%E)%sf(j, k, l) pres = (E - pi_inf - qv - 5.e-1_wp*rho*vel_sum)/gamma else - pres = q_prim_vf(E_idx)%sf(j, k, l) + pres = q_prim_vf(eqn_idx%E)%sf(j, k, l) E = gamma*pres + pi_inf + 5.e-1_wp*rho*vel_sum + qv end if ! Adjust energy for hyperelasticity if (hyperelasticity) then - E = E + G_local*q_prim_vf(xiend + 1)%sf(j, k, l) + E = E + G_local*q_prim_vf(eqn_idx%xi%end + 1)%sf(j, k, l) end if H = (E + pres)/rho diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 5ef12c9e42..49fea9653a 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -435,7 +435,7 @@ contains MOK = int(1._wp, MPI_OFFSET_KIND) if (bubbles_euler .or. elasticity) then - do i = 1, sys_size ! adv_idx%end + do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) @@ -497,7 +497,7 @@ contains MOK = int(1._wp, MPI_OFFSET_KIND) if (bubbles_euler .or. elasticity) then - do i = 1, sys_size ! adv_idx%end + do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -569,31 +569,31 @@ contains call s_convert_to_mixture_variables(v_vf, j, k, l, rho, gamma, pi_inf, qv, Re) dyn_pres = 0._wp - do i = mom_idx%beg, mom_idx%end + do i = eqn_idx%mom%beg, eqn_idx%mom%end dyn_pres = dyn_pres + 5.e-1_wp*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l)/max(rho, sgm_eps) end do if (chemistry) then do c = 1, num_species - rhoYks(c) = v_vf(chemxb + c - 1)%sf(j, k, l) + rhoYks(c) = v_vf(eqn_idx%species%beg + c - 1)%sf(j, k, l) end do end if if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + v_vf(B_idx%beg)%sf(j, k, l)**2 + v_vf(B_idx%beg + 1)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(Bx0**2 + v_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(v_vf(B_idx%beg)%sf(j, k, l)**2 + v_vf(B_idx%beg + 1)%sf(j, k, & - & l)**2 + v_vf(B_idx%beg + 2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(v_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg + 1)%sf(j, k, & + & l)**2 + v_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2) end if end if - call s_compute_pressure(v_vf(E_idx)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres, T, & - & pres_mag=pres_mag) + call s_compute_pressure(v_vf(eqn_idx%E)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres, & + & T, pres_mag=pres_mag) do i = 1, num_fluids - v_vf(i + intxb - 1)%sf(j, k, l) = v_vf(i + advxb - 1)%sf(j, k, & - & l)*(gammas(i)*pres + pi_infs(i)) + v_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) + v_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = v_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, & + & l)*(gammas(i)*pres + pi_infs(i)) + v_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) end do end do end do @@ -842,8 +842,8 @@ contains #:if USING_AMD #:for BC in {-5, -6, -7, -8, -9, -10, -11, -12, -13} @:PROHIBIT(any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, & - & bc_z%end/) == ${BC}$) .and. adv_idx%end > 20 .and. (.not. chemistry), & - & "CBC module with AMD compiler requires adv_idx%end <= 20 when case optimization is turned off") + & bc_z%end/) == ${BC}$) .and. eqn_idx%adv%end > 20 .and. (.not. chemistry), & + & "CBC module with AMD compiler requires eqn_idx%adv%end <= 20 when case optimization is turned off") @:PROHIBIT(any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, & & bc_z%end/) == ${BC}$) .and. sys_size > 20 .and. (chemistry), & & "CBC module with AMD compiler and chemistry requires sys_size <= 20 when case optimization is turned off") @@ -1035,7 +1035,7 @@ contains $:GPU_UPDATE(device='[R0ref, p0ref, rho0ref, ss, pv, vd, mu_l, mu_v, mu_g, gam_v, gam_g, M_v, M_g, R_v, R_g, Tw, cp_v, & & cp_g, k_vl, k_gl, gam, gam_m, Eu, Ca, Web, Re_inv, Pe_c, phi_vg, phi_gv, omegaN, bubbles_euler, & & polytropic, polydisperse, qbmm, ptil, bubble_model, thermal, poly_sigma, adv_n, adap_dt, adap_dt_tol, & - & adap_dt_max_iters, n_idx, pi_fac, low_Mach]') + & adap_dt_max_iters, eqn_idx%n, pi_fac, low_Mach]') if (bubbles_euler) then $:GPU_UPDATE(device='[weight, R0]') @@ -1046,12 +1046,13 @@ contains end if end if - $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, n_idx, pi_fac, low_Mach]') + $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, pi_fac, low_Mach]') $:GPU_UPDATE(device='[acoustic_source, num_source]') $:GPU_UPDATE(device='[sigma, surface_tension]') $:GPU_UPDATE(device='[dx, dy, dz, x_cb, x_cc, y_cb, y_cc, z_cb, z_cc]') + $:GPU_UPDATE(device='[bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end]') $:GPU_UPDATE(device='[bc_x%vb1, bc_x%vb2, bc_x%vb3, bc_x%ve1, bc_x%ve2, bc_x%ve3]') $:GPU_UPDATE(device='[bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3]') $:GPU_UPDATE(device='[bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3]') diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 4ceb4038ba..9a4d0c6425 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -113,15 +113,16 @@ contains @:compute_capillary_stress_tensor() do i = 1, num_dims - flux_src_vf(momxb + i - 1)%sf(j, k, l) = flux_src_vf(momxb + i - 1)%sf(j, k, l) + Omega(1, i) + flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, & + & l) + Omega(1, i) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) + Omega(1, i)*vSrc_rsx_vf(j, k, & - & l, i) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(1, & + & i)*vSrc_rsx_vf(j, k, l, i) end do ! Continuum surface force capillary stress, Schmidmayer et al. JCP (2017) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) + sigma*c_divs(num_dims + 1)%sf(j, k, & - & l)*vSrc_rsx_vf(j, k, l, 1) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsx_vf(j, k, l, 1) end if end do end do @@ -155,13 +156,14 @@ contains @:compute_capillary_stress_tensor() do i = 1, num_dims - flux_src_vf(momxb + i - 1)%sf(j, k, l) = flux_src_vf(momxb + i - 1)%sf(j, k, l) + Omega(2, i) + flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, & + & k, l) + Omega(2, i) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) + Omega(2, i)*vSrc_rsy_vf(k, & - & j, l, i) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(2, & + & i)*vSrc_rsy_vf(k, j, l, i) end do - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsy_vf(k, j, l, 2) end if end do @@ -197,13 +199,14 @@ contains @:compute_capillary_stress_tensor() do i = 1, num_dims - flux_src_vf(momxb + i - 1)%sf(j, k, l) = flux_src_vf(momxb + i - 1)%sf(j, k, l) + Omega(3, i) + flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i - 1)%sf(j, & + & k, l) + Omega(3, i) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) + Omega(3, i)*vSrc_rsz_vf(l, & - & k, j, i) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(3, & + & i)*vSrc_rsz_vf(l, k, j, i) end do - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, & + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & & l) + sigma*c_divs(num_dims + 1)%sf(j, k, l)*vSrc_rsz_vf(l, k, j, 3) end if end do @@ -234,8 +237,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(1)%sf(j, k, l) = 1._wp/(x_cc(j + 1) - x_cc(j - 1))*(q_prim_vf(c_idx)%sf(j + 1, k, & - & l) - q_prim_vf(c_idx)%sf(j - 1, k, l)) + c_divs(1)%sf(j, k, l) = 1._wp/(x_cc(j + 1) - x_cc(j - 1))*(q_prim_vf(eqn_idx%c)%sf(j + 1, k, & + & l) - q_prim_vf(eqn_idx%c)%sf(j - 1, k, l)) end do end do end do @@ -245,8 +248,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(2)%sf(j, k, l) = 1._wp/(y_cc(k + 1) - y_cc(k - 1))*(q_prim_vf(c_idx)%sf(j, k + 1, & - & l) - q_prim_vf(c_idx)%sf(j, k - 1, l)) + c_divs(2)%sf(j, k, l) = 1._wp/(y_cc(k + 1) - y_cc(k - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k + 1, & + & l) - q_prim_vf(eqn_idx%c)%sf(j, k - 1, l)) end do end do end do @@ -257,8 +260,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(3)%sf(j, k, l) = 1._wp/(z_cc(l + 1) - z_cc(l - 1))*(q_prim_vf(c_idx)%sf(j, k, & - & l + 1) - q_prim_vf(c_idx)%sf(j, k, l - 1)) + c_divs(3)%sf(j, k, l) = 1._wp/(z_cc(l + 1) - z_cc(l - 1))*(q_prim_vf(eqn_idx%c)%sf(j, k, & + & l + 1) - q_prim_vf(eqn_idx%c)%sf(j, k, l - 1)) end do end do end do @@ -281,7 +284,7 @@ contains end do $:END_GPU_PARALLEL_LOOP() - call s_populate_capillary_buffers(c_divs, bc_type) + call s_populate_capillary_buffers(c_divs, bc_type, bc_xyz_info(bc_x, bc_y, bc_z)) iv%beg = 1; iv%end = num_dims + 1 diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 1b39ce156c..e452c4a9fe 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -223,27 +223,27 @@ contains @:ALLOCATE(q_prim_vf(1:sys_size)) if (.not. igr) then - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) end do if (bubbles_euler) then - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) end do if (adv_n) then - @:ALLOCATE(q_prim_vf(n_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%n)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(n_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%n)) end if end if if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) @@ -251,7 +251,7 @@ contains end if if (elasticity) then - do i = stress_idx%beg, stress_idx%end + do i = eqn_idx%stress%beg, eqn_idx%stress%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) @@ -259,7 +259,7 @@ contains end if if (hyperelasticity) then - do i = xibeg, xiend + 1 + do i = eqn_idx%xi%beg, eqn_idx%xi%end + 1 @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) @@ -267,19 +267,19 @@ contains end if if (cont_damage) then - @:ALLOCATE(q_prim_vf(damage_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%damage)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(damage_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%damage)) end if if (hyper_cleaning) then - @:ALLOCATE(q_prim_vf(psi_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%psi)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(psi_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%psi)) end if if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end + do i = eqn_idx%int_en%beg, eqn_idx%int_en%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) @@ -287,13 +287,13 @@ contains end if if (surface_tension) then - @:ALLOCATE(q_prim_vf(c_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%c)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(c_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%c)) end if if (chemistry) then - do i = chemxb, chemxe + do i = eqn_idx%species%beg, eqn_idx%species%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) @@ -694,7 +694,7 @@ contains call s_compute_body_forces_rhs(q_prim_vf_in, q_cons_vf, rhs_vf_in) $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -915,44 +915,44 @@ contains if (.not. igr) then ! Deallocating the cell-average primitive variables - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end @:DEALLOCATE(q_prim_vf(i)%sf) end do if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (elasticity) then - do i = stress_idx%beg, stress_idx%end + do i = eqn_idx%stress%beg, eqn_idx%stress%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (hyperelasticity) then - do i = xibeg, xiend + 1 + do i = eqn_idx%xi%beg, eqn_idx%xi%end + 1 @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (cont_damage) then - @:DEALLOCATE(q_prim_vf(damage_idx)%sf) + @:DEALLOCATE(q_prim_vf(eqn_idx%damage)%sf) end if if (hyper_cleaning) then - @:DEALLOCATE(q_prim_vf(psi_idx)%sf) + @:DEALLOCATE(q_prim_vf(eqn_idx%psi)%sf) end if if (bubbles_euler) then - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end + do i = eqn_idx%int_en%beg, eqn_idx%int_en%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 5f7022714f..dfa32e5c98 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -72,7 +72,7 @@ contains do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = eqn_idx%mom%beg, eqn_idx%E tau_Re_vf(i)%sf(j, k, l) = 0._wp end do end do @@ -91,9 +91,9 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles_euler .and. num_fluids == 1) then - alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(eqn_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -166,14 +166,15 @@ contains tau_Re(2, 1) = (grad_y_vf(1)%sf(j, k, l) + grad_x_vf(2)%sf(j, k, l))/Re_visc(1) tau_Re(2, 2) = (4._wp*grad_y_vf(2)%sf(j, k, l) - 2._wp*grad_x_vf(1)%sf(j, k, & - & l) - 2._wp*q_prim_vf(momxb + 1)%sf(j, k, l)/y_cc(k))/(3._wp*Re_visc(1)) + & l) - 2._wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y_cc(k))/(3._wp*Re_visc(1)) ! Viscous flux contribution to momentum and energy equations $:GPU_LOOP(parallelism='[seq]') do i = 1, 2 - tau_Re_vf(contxe + i)%sf(j, k, l) = tau_Re_vf(contxe + i)%sf(j, k, l) - tau_Re(2, i) + tau_Re_vf(eqn_idx%cont%end + i)%sf(j, k, l) = tau_Re_vf(eqn_idx%cont%end + i)%sf(j, k, & + & l) - tau_Re(2, i) - tau_Re_vf(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, k, & - & l)*tau_Re(2, i) + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, & + & l) - q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l)*tau_Re(2, i) end do end do end do @@ -193,9 +194,9 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles_euler .and. num_fluids == 1) then - alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(eqn_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -264,13 +265,13 @@ contains end if end if - tau_Re(2, 2) = (grad_x_vf(1)%sf(j, k, l) + grad_y_vf(2)%sf(j, k, l) + q_prim_vf(momxb + 1)%sf(j, k, & - & l)/y_cc(k))/Re_visc(2) + tau_Re(2, 2) = (grad_x_vf(1)%sf(j, k, l) + grad_y_vf(2)%sf(j, k, & + & l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)/y_cc(k))/Re_visc(2) - tau_Re_vf(momxb + 1)%sf(j, k, l) = tau_Re_vf(momxb + 1)%sf(j, k, l) - tau_Re(2, 2) + tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) - tau_Re(2, 2) - tau_Re_vf(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & - & l)*tau_Re(2, 2) + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, & + & l) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)*tau_Re(2, 2) end do end do end do @@ -290,9 +291,9 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles_euler .and. num_fluids == 1) then - alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(eqn_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -363,15 +364,16 @@ contains tau_Re(2, 2) = -(2._wp/3._wp)*grad_z_vf(3)%sf(j, k, l)/y_cc(k)/Re_visc(1) - tau_Re(2, 3) = ((grad_z_vf(2)%sf(j, k, l) - q_prim_vf(momxe)%sf(j, k, & + tau_Re(2, 3) = ((grad_z_vf(2)%sf(j, k, l) - q_prim_vf(eqn_idx%mom%end)%sf(j, k, & & l))/y_cc(k) + grad_y_vf(3)%sf(j, k, l))/Re_visc(1) $:GPU_LOOP(parallelism='[seq]') do i = 2, 3 - tau_Re_vf(contxe + i)%sf(j, k, l) = tau_Re_vf(contxe + i)%sf(j, k, l) - tau_Re(2, i) + tau_Re_vf(eqn_idx%cont%end + i)%sf(j, k, l) = tau_Re_vf(eqn_idx%cont%end + i)%sf(j, k, & + & l) - tau_Re(2, i) - tau_Re_vf(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, k, & - & l)*tau_Re(2, i) + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, & + & l) - q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l)*tau_Re(2, i) end do end do end do @@ -389,9 +391,9 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles_euler .and. num_fluids == 1) then - alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(eqn_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -462,10 +464,10 @@ contains tau_Re(2, 2) = grad_z_vf(3)%sf(j, k, l)/y_cc(k)/Re_visc(2) - tau_Re_vf(momxb + 1)%sf(j, k, l) = tau_Re_vf(momxb + 1)%sf(j, k, l) - tau_Re(2, 2) + tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = tau_Re_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) - tau_Re(2, 2) - tau_Re_vf(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & - & l)*tau_Re(2, 2) + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, & + & l) - q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, l)*tau_Re(2, 2) end do end do end do @@ -494,7 +496,7 @@ contains integer :: i, j, k, l do i = 1, num_dims - iv%beg = mom_idx%beg; iv%end = mom_idx%end + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end $:GPU_UPDATE(device='[iv]') @@ -521,7 +523,7 @@ contains end if end do else ! Compute velocity gradients at cell centers using central finite differences - iv%beg = mom_idx%beg; iv%end = mom_idx%end + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end $:GPU_UPDATE(device='[iv]') is1_viscous = ix; is2_viscous = iy; is3_viscous = iz @@ -1316,13 +1318,13 @@ contains ! compute the velocity gradient tensor do l = 1, num_dims - velocity_gradient_tensor(l, 1) = (q_prim_vf(momxb + l - 1)%sf(i + 1, j, k) - q_prim_vf(momxb + l - 1)%sf(i - 1, j, & - & k))/(2._wp*dx(1)) - velocity_gradient_tensor(l, 2) = (q_prim_vf(momxb + l - 1)%sf(i, j + 1, k) - q_prim_vf(momxb + l - 1)%sf(i, j - 1, & - & k))/(2._wp*dx(2)) + velocity_gradient_tensor(l, 1) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i + 1, j, & + & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i - 1, j, k))/(2._wp*dx(1)) + velocity_gradient_tensor(l, 2) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j + 1, & + & k) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j - 1, k))/(2._wp*dx(2)) if (num_dims == 3) then - velocity_gradient_tensor(l, 3) = (q_prim_vf(momxb + l - 1)%sf(i, j, k + 1) - q_prim_vf(momxb + l - 1)%sf(i, j, & - & k - 1))/(2._wp*dx(3)) + velocity_gradient_tensor(l, 3) = (q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j, & + & k + 1) - q_prim_vf(eqn_idx%mom%beg + l - 1)%sf(i, j, k - 1))/(2._wp*dx(3)) end if end do diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 48de3fa5cb..65c49f8304 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -19,20 +19,20 @@ def _suggest_similar_params(unknown_key: str, valid_keys: list, n: int = 3) -> l QPVF_IDX_VARS = { - "alpha_rho": "contxb", - "vel": "momxb", - "pres": "E_idx", - "alpha": "advxb", - "tau_e": "stress_idx%beg", - "Y": "chemxb", - "cf_val": "c_idx", - "Bx": "B_idx%beg", - "By": "B_idx%end-1", - "Bz": "B_idx%end", + "alpha_rho": "eqn_idx%cont%beg", + "vel": "eqn_idx%mom%beg", + "pres": "eqn_idx%E", + "alpha": "eqn_idx%adv%beg", + "tau_e": "eqn_idx%stress%beg", + "Y": "eqn_idx%species%beg", + "cf_val": "eqn_idx%c", + "Bx": "eqn_idx%B%beg", + "By": "eqn_idx%B%end-1", + "Bz": "eqn_idx%B%end", } MIBM_ANALYTIC_VARS = ["vel(1)", "vel(2)", "vel(3)", "angular_vel(1)", "angular_vel(2)", "angular_vel(3)"] -# "B_idx%end - 1" not "B_idx%beg + 1" must be used because 1D does not have Bx +# "eqn_idx%B%end - 1" not "eqn_idx%B%beg + 1" must be used because 1D does not have Bx @dataclasses.dataclass(init=False)