From 10ca810e2d5297c397a8cca7bfce70cf9fcb9dde Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 18:09:41 -0400 Subject: [PATCH 01/17] refactor: replace implicit bc globals with bc_xyz_info derived type; remove dead bcxb/bcxe module vars - Add bc_xyz_info type to m_derived_types.fpp grouping bc x/y/z info - s_populate_capillary_buffers now takes explicit bc argument instead of implicitly depending on bc_x/bc_y/bc_z module globals - Access pattern is now bc%x%beg, bc%x%end etc. (was implicit global) - Remove unused bcxb/bcxe/bcyb/bcye/bczb/bcze scalars from m_cbc.fpp (declared and GPU-declared but never read) --- src/common/m_boundary_common.fpp | 15 ++++++++------- src/common/m_derived_types.fpp | 5 +++++ src/simulation/m_cbc.fpp | 25 +------------------------ src/simulation/m_surface_tension.fpp | 2 +- 4 files changed, 15 insertions(+), 32 deletions(-) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 2f4edc1ec4..f5c19f7ebd 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -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_derived_types.fpp b/src/common/m_derived_types.fpp index 0c00de90d7..3f22ea46eb 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -108,6 +108,11 @@ 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 + type bc_patch_parameters integer :: geometry integer :: type diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 0e36c48fbf..d5216ea5b9 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 @@ -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)) diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 4ceb4038ba..1c92b1d80a 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -281,7 +281,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 From db99a8aa04ab98ff344f393ec44cbf0b46d5e607 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 18:17:03 -0400 Subject: [PATCH 02/17] refactor: consolidate scalar equation indices into eqn_idx derived type - Add eqn_idx_info type to m_derived_types.fpp with members E, n, alf, gamma, pi_inf, c - Replace 6 standalone integer globals (E_idx, alf_idx, c_idx, n_idx, gamma_idx, pi_inf_idx) with type(eqn_idx_info) :: eqn_idx in all three targets' m_global_parameters.fpp - Update GPU_DECLARE and GPU_UPDATE in simulation to use eqn_idx struct - ~672 use-sites updated to eqn_idx%E, eqn_idx%alf, etc. --- src/common/include/1dHardcodedIC.fpp | 2 +- src/common/include/2dHardcodedIC.fpp | 46 ++-- src/common/include/3dHardcodedIC.fpp | 12 +- src/common/m_boundary_common.fpp | 8 +- src/common/m_chemistry.fpp | 18 +- src/common/m_derived_types.fpp | 10 + src/common/m_phase_change.fpp | 2 +- src/common/m_variables_conversion.fpp | 76 +++--- src/post_process/m_data_output.fpp | 32 +-- src/post_process/m_derived_variables.fpp | 12 +- src/post_process/m_global_parameters.fpp | 53 ++-- src/post_process/m_start_up.fpp | 26 +- src/pre_process/m_assign_variables.fpp | 56 ++-- src/pre_process/m_data_output.fpp | 14 +- src/pre_process/m_global_parameters.fpp | 51 ++-- src/pre_process/m_icpp_patches.fpp | 10 +- src/pre_process/m_perturbation.fpp | 6 +- src/simulation/m_acoustic_src.fpp | 4 +- src/simulation/m_body_forces.fpp | 8 +- src/simulation/m_bubbles_EE.fpp | 12 +- src/simulation/m_bubbles_EL.fpp | 42 +-- src/simulation/m_cbc.fpp | 36 +-- src/simulation/m_compute_cbc.fpp | 2 +- src/simulation/m_data_output.fpp | 43 +-- src/simulation/m_global_parameters.fpp | 68 +++-- src/simulation/m_hyperelastic.fpp | 4 +- src/simulation/m_ibm.fpp | 35 +-- src/simulation/m_igr.fpp | 190 ++++++------- src/simulation/m_pressure_relaxation.fpp | 4 +- src/simulation/m_qbmm.fpp | 6 +- src/simulation/m_rhs.fpp | 109 ++++---- src/simulation/m_riemann_solvers.fpp | 331 ++++++++++++----------- src/simulation/m_sim_helpers.fpp | 4 +- src/simulation/m_start_up.fpp | 8 +- src/simulation/m_surface_tension.fpp | 32 +-- src/simulation/m_time_steppers.fpp | 10 +- src/simulation/m_viscous.fpp | 30 +- 37 files changed, 708 insertions(+), 704 deletions(-) diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index 562005ac32..6cf6b67bf5 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -33,7 +33,7 @@ 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(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp index b2752228f0..2b8af33b15 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -25,7 +25,7 @@ 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%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 @@ -38,15 +38,15 @@ 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%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%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%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 @@ -59,18 +59,18 @@ 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%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%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%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(contxb)%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 @@ -93,14 +93,14 @@ 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%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 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 @@ -112,7 +112,7 @@ 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(eqn_idx%E)%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) end if @@ -126,7 +126,7 @@ 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(eqn_idx%E)%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) end if @@ -162,15 +162,15 @@ 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%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%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%E)%sf(i, j, 0) = 3.e-5_wp end if ! case 252 is for the 2D MHD Rotor problem @@ -213,7 +213,7 @@ 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) ! 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) @@ -234,8 +234,8 @@ 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(B_idx%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(B_idx%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) @@ -250,7 +250,7 @@ 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(eqn_idx%E)%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 else @@ -258,7 +258,7 @@ 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(eqn_idx%E)%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 end if @@ -270,7 +270,7 @@ ! 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, & @@ -287,7 +287,7 @@ ! 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, & & 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)) @@ -296,7 +296,7 @@ ! 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, & & 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)) diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp index ec63047d72..f96a130532 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -88,14 +88,14 @@ 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%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 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 @@ -105,7 +105,7 @@ 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(eqn_idx%E)%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) end if @@ -138,7 +138,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%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) @@ -164,7 +164,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%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,7 +173,7 @@ ! 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) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index f5c19f7ebd..6b58ca2c00 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -489,7 +489,7 @@ contains q_prim_vf(momxe)%sf(k, l, -j) = -q_prim_vf(momxe)%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 @@ -523,7 +523,7 @@ contains q_prim_vf(momxe)%sf(k, l, p + j) = -q_prim_vf(momxe)%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 @@ -695,7 +695,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%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 @@ -707,7 +707,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%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 diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index 66f1e97923..b1b3e1ee89 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -67,8 +67,8 @@ contains Ys(eqn - chemxb + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(contxb)%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) + ! e = E - 1/2*|u|^2 cons. eqn_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i + energy = q_cons_vf(eqn_idx%E)%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 end do @@ -100,7 +100,7 @@ contains 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 @@ -235,8 +235,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)) @@ -313,7 +313,7 @@ contains 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 @@ -361,8 +361,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)) @@ -405,7 +405,7 @@ contains 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 diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 3f22ea46eb..c514446119 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -113,6 +113,16 @@ module m_derived_types type(int_bounds_info) :: x, y, z end type bc_xyz_info + !> Scalar equation indices computed at startup from model_eqns and enabled features. + type eqn_idx_info + integer :: E !< Index of energy equation + integer :: n !< Index of number density + integer :: alf !< Index of void fraction + integer :: gamma !< Index of specific heat ratio func. eqn. + integer :: pi_inf !< Index of liquid stiffness func. eqn. + integer :: c !< Index of color function + end type eqn_idx_info + type bc_patch_parameters integer :: geometry integer :: type diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 21926411db..3fc9e0bd9c 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -133,7 +133,7 @@ contains ! 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 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e9055e51f0..d37d68c281 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -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 @@ -556,7 +556,7 @@ contains S = S + qK_cons_vf(momxb + 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]') @@ -590,7 +590,7 @@ 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]') @@ -669,10 +669,10 @@ contains 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,7 +685,7 @@ 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) @@ -702,8 +702,8 @@ contains #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 @@ -735,12 +735,12 @@ contains do i = strxb, strxe ! 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 @@ -761,7 +761,7 @@ contains 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) @@ -843,7 +843,7 @@ contains 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 @@ -864,10 +864,11 @@ contains 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) 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) + 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 @@ -899,10 +900,10 @@ contains 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 @@ -914,17 +915,18 @@ contains & l)**2 + q_prim_vf(B_idx%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 @@ -932,7 +934,7 @@ contains 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)*(gammas(i)*q_prim_vf(eqn_idx%E)%sf(j, k, & & l) + pi_infs(i)) + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) end do end if @@ -945,10 +947,10 @@ contains 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,7 +960,7 @@ 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 @@ -984,11 +986,11 @@ contains do i = strxb, strxe ! 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 @@ -1004,7 +1006,7 @@ contains 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) @@ -1077,7 +1079,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe - alpha_K(i - E_idx) = qK_prim_vf(j, k, l, i) + alpha_K(i - eqn_idx%E) = qK_prim_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') @@ -1091,7 +1093,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) @@ -1129,7 +1131,7 @@ contains 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 @@ -1143,13 +1145,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe 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) + FK_vf(j, k, l, i) = vel_K(dir_idx(1))*alpha_K(i - eqn_idx%E) end do $:GPU_LOOP(parallelism='[seq]') diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index bdec65ba74..dda9ecf7fb 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 - mom_idx%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 - mom_idx%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 - mom_idx%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, adv_idx%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..9eb8fa971b 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -108,11 +108,11 @@ 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) + 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(adv_idx%beg)%sf(i, j, & & k)/blkmod1 + (1._wp - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) end if @@ -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, adv_idx%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..05176403fa 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -114,19 +114,14 @@ module m_global_parameters !> @{ 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(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) 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 @@ -515,11 +510,11 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end + eqn_idx%gamma = adv_idx%beg + eqn_idx%pi_inf = adv_idx%end sys_size = adv_idx%end ! Volume Fraction Model (5-equation model) @@ -530,27 +525,27 @@ contains 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%E = mom_idx%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 + adv_idx%beg = eqn_idx%E + 1 ! Alpha for fluid 1 + adv_idx%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 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + num_fluids end if sys_size = adv_idx%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = adv_idx%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (qbmm) then @@ -571,8 +566,8 @@ contains sys_size = bub_idx%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = bub_idx%end + 1 + sys_size = eqn_idx%n end if allocate (bub_idx%rs(nb), bub_idx%vs(nb)) @@ -629,23 +624,23 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + 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%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 + eqn_idx%E = mom_idx%end + 1 ! one energy equation + adv_idx%beg = eqn_idx%E + 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%alf = adv_idx%end + sys_size = eqn_idx%alf ! adv_idx%end if (bubbles_euler) then bub_idx%beg = sys_size + 1 @@ -729,8 +724,8 @@ contains 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 diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index 3436634d14..7d3bd12782 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -276,7 +276,7 @@ contains varname(:) = ' ' end if - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - mom_idx%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) write (varname, '(A,I0)') 'mom', i @@ -286,7 +286,7 @@ contains end if end do - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - mom_idx%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) write (varname, '(A,I0)') 'vel', i @@ -316,7 +316,7 @@ contains end if end if - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - mom_idx%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) @@ -518,7 +518,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 +528,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,7 +543,7 @@ 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 @@ -596,11 +596,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, adv_idx%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,7 +675,7 @@ 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(:) = ' ' @@ -684,7 +684,7 @@ contains if (bubbles_euler) then do i = adv_idx%beg, adv_idx%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 @@ -726,7 +726,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..d07e7c35bf 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 - mom_idx%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 @@ -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) + & 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 @@ -173,19 +173,19 @@ contains 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 @@ -198,7 +198,7 @@ contains 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 @@ -251,7 +251,7 @@ contains 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 + 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 @@ -259,7 +259,7 @@ contains 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) + q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - eqn_idx%E) end do end if @@ -271,7 +271,7 @@ contains 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 + 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 @@ -292,7 +292,7 @@ contains 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) + q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - eqn_idx%E) end do end if @@ -304,7 +304,7 @@ contains 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 + 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 @@ -345,7 +345,7 @@ contains do i = 1, nb R3bar = R3bar + weight(i)*(q_prim_vf(bub_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,11 +353,11 @@ 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) + 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 @@ -409,7 +409,7 @@ contains 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 + 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 @@ -425,13 +425,13 @@ 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 + do i = 1, eqn_idx%E - 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)) end do @@ -468,7 +468,7 @@ contains ! 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) + q_prim_vf(i)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, l) end do end if @@ -510,7 +510,7 @@ contains do i = 1, nb R3bar = R3bar + weight(i)*(q_prim_vf(bub_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 @@ -522,7 +522,7 @@ contains 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 + 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 @@ -538,7 +538,7 @@ contains 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..0e224f0b6d 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -185,13 +185,13 @@ contains 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%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) end if - call s_compute_pressure(q_cons_vf(E_idx)%sf(j, 0, 0), q_cons_vf(alf_idx)%sf(j, 0, 0), & + 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(mom_idx%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 @@ -210,17 +210,17 @@ contains nbub = q_cons_vf(bubxb)%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) 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 write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) @@ -626,7 +626,7 @@ contains do i = momxb, momxe write (1, '(I3,A20,A20)') i, "\rho u_" // coord(i - momxb + 1), "u_" // coord(i - momxb + 1) end do - do i = E_idx, E_idx + do i = eqn_idx%E, eqn_idx%E write (1, '(I3,A20,A20)') i, "\rho U", "p" end do do i = advxb, advxe @@ -642,7 +642,7 @@ contains 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 (eqn_idx%E /= 0) write (1, '("[",I2,",",I2,"]",A)') eqn_idx%E, eqn_idx%E, " 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" diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 077262aece..01960ef0c1 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -84,18 +84,13 @@ module m_global_parameters ! 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(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) 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 @@ -567,11 +562,11 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end + eqn_idx%gamma = adv_idx%beg + eqn_idx%pi_inf = adv_idx%end sys_size = adv_idx%end ! Volume Fraction Model (5-equation model) @@ -582,27 +577,27 @@ contains 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%E = mom_idx%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 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%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 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + num_fluids end if sys_size = adv_idx%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = adv_idx%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then @@ -622,8 +617,8 @@ contains sys_size = bub_idx%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = bub_idx%end + 1 + sys_size = eqn_idx%n end if allocate (bub_idx%rs(nb), bub_idx%vs(nb)) @@ -682,9 +677,9 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + num_fluids internalEnergies_idx%beg = adv_idx%end + 1 internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end @@ -694,11 +689,11 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 ! one energy equation + adv_idx%beg = eqn_idx%E + 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%alf = adv_idx%end + sys_size = eqn_idx%alf ! adv_idx%end if (bubbles_euler) then bub_idx%beg = sys_size + 1 @@ -782,8 +777,8 @@ contains 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 diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 8d92745595..e58b2e582f 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 @@ -766,7 +766,7 @@ contains ! 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%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_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 516fc3a6ce..4bcd2f131d 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 @@ -75,7 +75,7 @@ contains 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) 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 diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 41c897cfd3..55136ec77f 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -250,7 +250,7 @@ contains end if small_gamma = 1._wp/small_gamma + 1._wp - c = 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) @@ -322,7 +322,7 @@ contains 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) 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..d649782326 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -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 = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -105,7 +105,7 @@ contains 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%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(momxb)%sf(j, k, l)*accel_bf(1) end do end do end do @@ -119,7 +119,7 @@ contains do k = 0, n do j = 0, m rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + 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%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(momxb + 1)%sf(j, k, l)*accel_bf(2) end do end do end do @@ -133,7 +133,7 @@ contains 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%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(momxe)%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..b1f408643a 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -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 @@ -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 @@ -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,7 +303,7 @@ 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) + 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(advxb)%sf(i, q, l) = rhs_vf(advxb)%sf(i, q, l) - bub_adv_src(i, q, l) $:GPU_LOOP(parallelism='[seq]') do k = 1, nb diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index ab7dcd6366..856d041c42 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -281,8 +281,8 @@ contains do i = 1, num_dims dynP = dynP + 0.5_wp*q_cons_vf(contxe + 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) @@ -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(contxe + 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 @@ -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 d5216ea5b9..80aa781122 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -620,11 +620,11 @@ 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, advxe - 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) @@ -680,7 +680,7 @@ contains dpres_ds = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx + do i = 1, advxe - eqn_idx%E dadv_ds(i) = 0._wp end do @@ -702,10 +702,10 @@ contains dvel_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, contxe + 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, advxe - 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 @@ -748,8 +748,8 @@ contains 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, advxe - 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, & @@ -820,12 +820,12 @@ contains ! 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 + do i = 1, advxe - eqn_idx%E dadv_dt(i) = -L(momxe + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) end do else $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - E_idx + do i = 1, advxe - eqn_idx%E dadv_dt(i) = -L(momxe + i) end do end if @@ -876,17 +876,17 @@ 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)) 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 @@ -901,12 +901,12 @@ contains 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) + 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]') diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 152589ca6d..713f20d2d8 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -100,7 +100,7 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = E_idx, advxe - 1 + do i = eqn_idx%E, advxe - 1 L(i) = lambda_factor*lambda2*dadv_ds(i - momxe) end do diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 01f0d95100..624ae9fc9d 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1073,12 +1073,12 @@ contains 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(stress_idx%beg)%sf(j - 2, & + & k, l), q_cons_vf(mom_idx%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 @@ -1088,9 +1088,9 @@ contains 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) @@ -1098,7 +1098,7 @@ contains 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 @@ -1176,13 +1176,13 @@ contains 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) 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 +1194,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) 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 @@ -1263,13 +1263,14 @@ contains 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, & + 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(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) 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 @@ -1392,8 +1393,8 @@ contains vel(s) = q_cons_vf(cont_idx%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(mom_idx%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 @@ -1455,8 +1456,8 @@ contains vel(s) = q_cons_vf(cont_idx%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(mom_idx%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_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 079d36ebc2..fdb15df790 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -252,27 +252,22 @@ module m_global_parameters 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(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) 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 !> @} - $: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, bub_idx]') + $:GPU_DECLARE(create='[B_idx, stress_idx, xi_idx, b_size]') + $:GPU_DECLARE(create='[tensor_size, species_idx]') ! 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) @@ -875,11 +870,11 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end + eqn_idx%gamma = adv_idx%beg + eqn_idx%pi_inf = adv_idx%end sys_size = adv_idx%end ! Volume Fraction Model @@ -891,25 +886,25 @@ contains 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%E = mom_idx%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 + adv_idx%beg = eqn_idx%E + 1 ! Alpha for fluid 1 + adv_idx%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 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + num_fluids end if sys_size = adv_idx%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = adv_idx%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then @@ -931,8 +926,8 @@ contains sys_size = bub_idx%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = bub_idx%end + 1 + sys_size = eqn_idx%n end if @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) @@ -982,10 +977,10 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 + adv_idx%beg = eqn_idx%E + 1 + adv_idx%end = eqn_idx%E + num_fluids + eqn_idx%alf = adv_idx%end internalEnergies_idx%beg = adv_idx%end + 1 internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end @@ -994,10 +989,10 @@ contains 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 + eqn_idx%E = mom_idx%end + 1 ! one energy equation + adv_idx%beg = eqn_idx%E + 1 adv_idx%end = adv_idx%beg ! one volume advection equation - alf_idx = adv_idx%end + eqn_idx%alf = adv_idx%end sys_size = adv_idx%end if (bubbles_euler) then @@ -1105,8 +1100,8 @@ contains 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 @@ -1217,18 +1212,17 @@ contains 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='[momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, & + & eqn_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') $:GPU_UPDATE(device='[b_size, xibeg, xiend, tensor_size]') $:GPU_UPDATE(device='[species_idx]') $: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, 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='[Bx0]') diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 22c2aace73..e8793517a9 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -173,8 +173,8 @@ 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(xiend + 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 diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 1323235887..9e942cff5b 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,13 +165,13 @@ 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]', copyin='[eqn_idx%E, momxb]', 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) @@ -230,18 +230,18 @@ contains 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 @@ -310,14 +310,14 @@ contains ! 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 @@ -779,7 +779,7 @@ 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 @@ -793,7 +793,7 @@ contains 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 @@ -936,17 +936,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 diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index 7d0f18cb26..130c98a0d6 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -372,13 +372,13 @@ contains rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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)), & - & kind=stp) + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) #:endfor end do end do @@ -527,7 +527,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(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -549,7 +549,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(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -605,56 +605,56 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +662,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(eqn_idx%E)%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(eqn_idx%E)%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, & @@ -721,7 +721,7 @@ contains & - 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -736,7 +736,7 @@ contains & - 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -789,7 +789,7 @@ contains & + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -804,7 +804,7 @@ contains & + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -964,7 +964,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(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -986,7 +986,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(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -1043,84 +1043,84 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1128,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(eqn_idx%E)%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(eqn_idx%E)%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, & @@ -1193,7 +1193,7 @@ contains & - 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1213,7 +1213,7 @@ contains & - 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1271,7 +1271,7 @@ contains & + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1291,7 +1291,7 @@ contains & + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1397,7 +1397,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(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1419,7 +1419,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(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1476,56 +1476,56 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1534,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(eqn_idx%E)%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(eqn_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -1596,7 +1596,7 @@ contains & - 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -1611,7 +1611,7 @@ contains & )*(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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1660,7 +1660,7 @@ contains & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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') @@ -1672,7 +1672,7 @@ contains & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1806,7 +1806,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(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1828,7 +1828,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(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1885,84 +1885,84 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1971,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(eqn_idx%E)%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(eqn_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -2038,7 +2038,7 @@ contains & - 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -2058,7 +2058,7 @@ contains & )*(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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2116,7 +2116,7 @@ contains & + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -2136,7 +2136,7 @@ contains & )*(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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -2271,7 +2271,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(eqn_idx%E + i)%sf(j, k, l + q) end do else alpha_L(1) = 1._wp @@ -2293,7 +2293,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(eqn_idx%E + i)%sf(j, k, l + q) end do else alpha_R(1) = 1._wp @@ -2350,84 +2350,84 @@ contains rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +2436,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(eqn_idx%E)%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(eqn_idx%E)%sf(j, k, l + q) F_R = F_R + coeff_R(q)*jac(j, k, l + q) end do @@ -2503,7 +2503,7 @@ contains & - 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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) @@ -2523,7 +2523,7 @@ contains & *(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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2581,7 +2581,7 @@ contains & + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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) @@ -2601,7 +2601,7 @@ contains & *(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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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_pressure_relaxation.fpp b/src/simulation/m_pressure_relaxation.fpp index 7786ce4afe..e30032717e 100644 --- a/src/simulation/m_pressure_relaxation.fpp +++ b/src/simulation/m_pressure_relaxation.fpp @@ -225,7 +225,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) @@ -293,7 +293,7 @@ contains 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 diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 9ee945ba6d..ce6094d1c3 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -559,7 +559,7 @@ 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) + 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 = bubxb $:GPU_LOOP(parallelism='[seq]') do k = 1, nb @@ -764,8 +764,8 @@ 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) + 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(contxb)%sf(id1, id2, id3) if (bubble_model == 2) then diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 72471f4892..a3814a0cac 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -127,7 +127,7 @@ 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 = mom_idx%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 @@ -170,9 +170,9 @@ 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 @@ -200,7 +200,7 @@ contains end do if (viscous .or. surface_tension) then - do l = mom_idx%beg, E_idx + do l = mom_idx%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 @@ -222,8 +222,8 @@ contains & 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 @@ -339,9 +339,9 @@ contains & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(tau_Re_vf(cont_idx%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)) @@ -564,8 +564,8 @@ contains 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) + 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 @@ -663,21 +663,21 @@ contains 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 @@ -685,11 +685,11 @@ contains 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 @@ -892,14 +892,14 @@ 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) 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) end if @@ -947,7 +947,7 @@ contains 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) + pressure_val = q_prim_vf%vf(eqn_idx%E)%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, & @@ -993,7 +993,7 @@ contains 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) + pressure_val = q_prim_vf%vf(eqn_idx%E)%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, & @@ -1089,7 +1089,7 @@ contains 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) + pressure_val = q_prim_vf%vf(eqn_idx%E)%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, & @@ -1362,8 +1362,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(advxb)%sf(j, k, & + & l) - flux_src_n_in(advxb)%sf(j - 1, k, l)) end do end do end do @@ -1377,7 +1378,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 @@ -1391,9 +1392,9 @@ contains 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 +1408,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(advxb)%sf(j, k, & + & l) - flux_src_n_in(advxb)%sf(j, k - 1, l)) end do end do end do @@ -1431,7 +1433,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 +1447,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 +1463,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 @@ -1474,9 +1476,9 @@ contains & 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 +1496,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 +1510,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 +1523,7 @@ contains do k = 0, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 +1539,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(advxb)%sf(j, k, & + & l) - flux_src_n_in(advxb)%sf(j, k, l - 1)) end do end do end do @@ -1552,7 +1555,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, E_idx + do i = momxb, 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 @@ -1565,9 +1568,9 @@ contains & 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 @@ -1737,7 +1740,7 @@ contains nullify (q_prim_qp%vf(j)%sf) end do - do j = mom_idx%beg, E_idx + do j = mom_idx%beg, eqn_idx%E @:DEALLOCATE(q_cons_qp%vf(j)%sf) @:DEALLOCATE(q_prim_qp%vf(j)%sf) end do @@ -1849,13 +1852,13 @@ contains end do if (viscous) then - do l = mom_idx%beg, E_idx + do l = mom_idx%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 diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index e43187e3f9..73821e2c2f 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -250,12 +250,12 @@ 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 - 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 @@ -642,8 +642,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 +651,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,13 +667,13 @@ 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 @@ -762,7 +762,7 @@ 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 @@ -930,12 +930,12 @@ 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 - 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 @@ -1257,8 +1257,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 +1266,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,13 +1282,13 @@ 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 @@ -1362,7 +1362,7 @@ 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 @@ -1407,8 +1407,8 @@ 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]') @@ -1419,8 +1419,8 @@ contains 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 @@ -1430,8 +1430,8 @@ contains 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]') @@ -1484,34 +1484,34 @@ contains if (norm_dir == 1) then flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%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, & & 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, & & 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, & & 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, & & 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)) @@ -1523,31 +1523,31 @@ contains #: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, & & 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, & & 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%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%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, & & 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)) @@ -1558,31 +1558,31 @@ contains #: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, & & 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, & & 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%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, & & 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, & & 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 @@ -1612,20 +1612,20 @@ contains 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%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%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, & & 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 @@ -1635,19 +1635,19 @@ contains #: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, & & 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, & & 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%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 @@ -1656,18 +1656,18 @@ contains #: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, & & 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, & & 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, & & 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 @@ -1816,8 +1816,8 @@ contains 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,38 +1836,38 @@ 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) @@ -1883,8 +1883,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) @@ -2070,7 +2071,7 @@ contains 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 @@ -2088,7 +2089,7 @@ 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. @@ -2154,8 +2155,8 @@ 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) + 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,7 +2164,7 @@ 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]') @@ -2232,13 +2233,13 @@ 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_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 +2255,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 @@ -2343,10 +2344,10 @@ contains 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)) @@ -2378,7 +2379,7 @@ 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 @@ -2437,8 +2438,8 @@ 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 @@ -2456,24 +2457,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 +2500,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 +2512,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 +2537,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,8 +2548,9 @@ 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 @@ -2719,7 +2721,7 @@ contains ! 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)) & @@ -2763,7 +2765,7 @@ contains 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,7 +2774,7 @@ 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 @@ -2833,8 +2835,8 @@ 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]') @@ -2845,42 +2847,42 @@ contains 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 @@ -3135,7 +3137,7 @@ contains ! 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)) & @@ -3157,7 +3159,7 @@ 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. @@ -3190,10 +3192,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 @@ -3227,7 +3229,7 @@ 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 @@ -3376,12 +3378,12 @@ contains 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 @@ -3529,7 +3531,7 @@ contains flux_rs${XYZ}$_vf(j, k, l, B_idx%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 @@ -3976,7 +3978,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 = momxb, eqn_idx%E do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -3990,11 +3992,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, chemxe 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 >= chemxb) then flux_src_vf(i)%sf(j, k, l) = 0._wp end if end do @@ -4022,7 +4024,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 = momxb, eqn_idx%E do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4036,11 +4038,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, chemxe 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 >= chemxb) then flux_src_vf(i)%sf(k, j, l) = 0._wp end if end do @@ -4068,7 +4070,7 @@ contains else if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, E_idx + do i = momxb, eqn_idx%E do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4082,11 +4084,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = E_idx, chemxe + do i = eqn_idx%E, chemxe 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 >= chemxb) then flux_src_vf(i)%sf(l, k, j) = 0._wp end if end do @@ -4265,7 +4267,7 @@ contains 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%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 @@ -4275,7 +4277,8 @@ contains 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%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 @@ -4384,7 +4387,7 @@ contains 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(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 @@ -4397,7 +4400,7 @@ contains 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(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 diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index e20ec982fe..e246238d4a 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -121,10 +121,10 @@ 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 diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 5ef12c9e42..cb957a72b7 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -588,8 +588,8 @@ contains 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, & @@ -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,7 +1046,7 @@ 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, eqn_idx%n, pi_fac, low_Mach]') $:GPU_UPDATE(device='[acoustic_source, num_source]') $:GPU_UPDATE(device='[sigma, surface_tension]') diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 1c92b1d80a..06bb5e06cf 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -115,13 +115,13 @@ contains 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(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 @@ -157,11 +157,11 @@ contains 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(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 @@ -199,11 +199,11 @@ contains 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(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 +234,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 +245,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 +257,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 diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 1b39ce156c..64410c6e6b 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -236,9 +236,9 @@ contains @: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 @@ -287,9 +287,9 @@ 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 @@ -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 = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 5f7022714f..a6375e8a3c 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 = momxb, 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 @@ -172,8 +172,8 @@ contains 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(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(contxe + i)%sf(j, & + & k, l)*tau_Re(2, i) end do end do end do @@ -193,9 +193,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 @@ -269,7 +269,7 @@ contains 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(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do @@ -290,9 +290,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 @@ -370,8 +370,8 @@ contains 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(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(contxe + i)%sf(j, & + & k, l)*tau_Re(2, i) end do end do end do @@ -389,9 +389,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 @@ -464,7 +464,7 @@ contains 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(E_idx)%sf(j, k, l) = tau_Re_vf(E_idx)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do From 28b88d088c241123b2b273fa11e6cf4b78d7b3e6 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 19:07:18 -0400 Subject: [PATCH 03/17] fix: replace Fypp bc${XYZ}$b/e templates with bc_${XYZ}$%beg/end; fix e_idx typo in m_rhs --- src/simulation/m_cbc.fpp | 32 ++++++++++++++++---------------- src/simulation/m_rhs.fpp | 2 +- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 80aa781122..999dbc1cd3 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -724,15 +724,15 @@ 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 @@ -755,8 +755,8 @@ contains L(advxe) = 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) @@ -769,19 +769,19 @@ contains & 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 diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index a3814a0cac..2f6adf73c5 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -1824,7 +1824,7 @@ contains do i = 1, num_dims @:DEALLOCATE(tau_re_vf(cont_idx%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 From 44592ab752102c96ab11958b9096e6cdda2f1864 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 20:07:07 -0400 Subject: [PATCH 04/17] refactor: consolidate all equation/range indices into sys_idx derived type --- claude-code-review.yml | 315 ++++++++++++++++++ src/common/include/1dHardcodedIC.fpp | 6 +- src/common/include/2dHardcodedIC.fpp | 68 ++-- src/common/include/3dHardcodedIC.fpp | 12 +- src/common/m_boundary_common.fpp | 8 +- src/common/m_chemistry.fpp | 18 +- src/common/m_derived_types.fpp | 54 ++-- src/common/m_phase_change.fpp | 2 +- src/common/m_variables_conversion.fpp | 138 ++++---- src/post_process/m_data_output.fpp | 32 +- src/post_process/m_derived_variables.fpp | 80 ++--- src/post_process/m_global_parameters.fpp | 243 +++++++------- src/post_process/m_start_up.fpp | 69 ++-- src/pre_process/m_assign_variables.fpp | 199 ++++++------ src/pre_process/m_data_output.fpp | 98 +++--- src/pre_process/m_global_parameters.fpp | 243 +++++++------- src/pre_process/m_icpp_patches.fpp | 14 +- src/pre_process/m_initial_condition.fpp | 8 +- src/pre_process/m_perturbation.fpp | 10 +- src/pre_process/m_start_up.fpp | 6 +- src/simulation/m_acoustic_src.fpp | 4 +- src/simulation/m_body_forces.fpp | 8 +- src/simulation/m_bubbles_EE.fpp | 20 +- src/simulation/m_bubbles_EL.fpp | 42 +-- src/simulation/m_cbc.fpp | 48 +-- src/simulation/m_compute_cbc.fpp | 2 +- src/simulation/m_data_output.fpp | 91 +++--- src/simulation/m_global_parameters.fpp | 246 +++++++------- src/simulation/m_hyperelastic.fpp | 2 +- src/simulation/m_hypoelastic.fpp | 27 +- src/simulation/m_ibm.fpp | 34 +- src/simulation/m_igr.fpp | 188 +++++------ src/simulation/m_pressure_relaxation.fpp | 4 +- src/simulation/m_qbmm.fpp | 8 +- src/simulation/m_rhs.fpp | 200 ++++++------ src/simulation/m_riemann_solvers.fpp | 395 ++++++++++++----------- src/simulation/m_sim_helpers.fpp | 4 +- src/simulation/m_start_up.fpp | 22 +- src/simulation/m_surface_tension.fpp | 24 +- src/simulation/m_time_steppers.fpp | 42 +-- src/simulation/m_viscous.fpp | 30 +- 41 files changed, 1682 insertions(+), 1382 deletions(-) create mode 100644 claude-code-review.yml diff --git a/claude-code-review.yml b/claude-code-review.yml new file mode 100644 index 0000000000..8493c7a77c --- /dev/null +++ b/claude-code-review.yml @@ -0,0 +1,315 @@ +name: Claude Code Review + +on: + pull_request_target: + types: [opened, ready_for_review, reopened, labeled] + issue_comment: + types: [created] + +jobs: + claude-review: + if: > + ( + github.event_name == 'pull_request_target' && + ( + github.event.action == 'opened' || + github.event.action == 'ready_for_review' || + github.event.action == 'reopened' || + ( + github.event.action == 'labeled' && + github.event.label.name == 'claude-full-review' + ) + ) + ) || + ( + github.event_name == 'issue_comment' && + github.event.issue.pull_request != null && + contains(github.event.comment.body, '@claude full review') + ) + runs-on: ubuntu-latest + permissions: + contents: read + pull-requests: write + issues: write + actions: read + + steps: + - name: Install dependencies + shell: bash + run: | + set -euo pipefail + sudo apt-get update + sudo apt-get install -y unzip jq + + - name: Determine PR number + id: mode + shell: bash + run: | + set -euo pipefail + + if [[ "${{ github.event_name }}" == "pull_request_target" ]]; then + PR_NUMBER="${{ github.event.pull_request.number }}" + elif [[ "${{ github.event_name }}" == "issue_comment" ]]; then + PR_NUMBER="${{ github.event.issue.number }}" + else + echo "Unsupported event" + exit 1 + fi + + echo "pr_number=$PR_NUMBER" >> "$GITHUB_OUTPUT" + + - name: Checkout base repo + uses: actions/checkout@v4 + with: + fetch-depth: 0 + + - name: Resolve review state + id: state + shell: bash + env: + GH_TOKEN: ${{ github.token }} + run: | + set -euo pipefail + + PR_NUMBER="${{ steps.mode.outputs.pr_number }}" + REPO="${{ github.repository }}" + + mkdir -p .claude-review/context + + CURRENT_HEAD_SHA="$(gh pr view "$PR_NUMBER" --repo "$REPO" --json headRefOid --jq .headRefOid)" + echo "current_head_sha=$CURRENT_HEAD_SHA" >> "$GITHUB_OUTPUT" + + LAST_COMMENT_B64="$( + gh api --paginate "repos/$REPO/issues/$PR_NUMBER/comments?per_page=100" \ + --jq '.[] | select(.body | contains(" + + - Always include the hidden marker exactly once at the end of the file. + - If there are no findings, write nothing. + + - name: Publish review comment + shell: bash + env: + GH_TOKEN: ${{ github.token }} + run: | + set -euo pipefail + + PR_NUMBER="${{ steps.mode.outputs.pr_number }}" + REPO="${{ github.repository }}" + COMMENT_ID="${{ steps.state.outputs.existing_comment_id }}" + OUTPUT_FILE=".claude-review/output.md" + + if [[ ! -f "$OUTPUT_FILE" ]]; then + echo "No output file; nothing to publish." + exit 0 + fi + + if [[ ! -s "$OUTPUT_FILE" ]] || [[ -z "$(tr -d '[:space:]' < "$OUTPUT_FILE")" ]]; then + echo "Review output is empty; not posting a comment." + exit 0 + fi + + BODY_JSON="$(jq -Rs '{body: .}' < "$OUTPUT_FILE")" + + if [[ -n "${COMMENT_ID:-}" ]]; then + gh api \ + --method PATCH \ + "repos/$REPO/issues/comments/$COMMENT_ID" \ + --input - <<< "$BODY_JSON" >/dev/null + echo "Updated existing primary review comment: $COMMENT_ID" + else + gh api \ + --method POST \ + "repos/$REPO/issues/$PR_NUMBER/comments" \ + --input - <<< "$BODY_JSON" >/dev/null + echo "Created new primary review comment." + fi + + - name: Fallback job summary on failure + if: failure() + shell: bash + run: | + set -euo pipefail + if [[ -f .claude-review/output.md ]] && [[ -s .claude-review/output.md ]]; then + { + echo "## Claude Code Review" + echo + cat .claude-review/output.md + } >> "$GITHUB_STEP_SUMMARY" + fi diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index 6cf6b67bf5..daec4129c1 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -11,8 +11,8 @@ q_prim_vf(momxb + 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(sys_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) + q_prim_vf(sys_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) @@ -33,7 +33,7 @@ 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(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 + q_prim_vf(sys_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp index 2b8af33b15..5e60512a7c 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -25,7 +25,7 @@ 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(eqn_idx%E)%sf(i, j, 0) = 1000._wp + q_prim_vf(sys_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 @@ -38,15 +38,15 @@ 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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp)) + q_prim_vf(sys_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 @@ -59,18 +59,18 @@ 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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax))) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp)) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam) + q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(sys_idx%E)%sf(i, j, 0)**(1._wp/gam) case (204) ! Rayleigh-Taylor instability rhoH = 3._wp rhoL = 1._wp @@ -93,14 +93,14 @@ 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%E)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(sys_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 pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(sys_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 @@ -112,7 +112,7 @@ 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(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(sys_idx%E)%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) end if @@ -126,7 +126,7 @@ 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(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(sys_idx%E)%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) end if @@ -157,20 +157,20 @@ 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(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(sys_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = 1.0 + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor) + q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp + q_prim_vf(sys_idx%E)%sf(i, j, 0) = 3.e-5_wp end if ! case 252 is for the 2D MHD Rotor problem @@ -209,11 +209,11 @@ 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)) ! 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(sys_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(sys_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(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_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(sys_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(eqn_idx%E)%sf(i,j,0) - ! = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp + q_prim_vf(sys_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp) + ! q_prim_vf(sys_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(sys_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) + ! q_prim_vf(sys_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(sys_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) @@ -250,17 +250,17 @@ 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(eqn_idx%E)%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(sys_idx%E)%sf(i, j, 0) = 20._wp + q_prim_vf(sys_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA + q_prim_vf(sys_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(eqn_idx%E)%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(sys_idx%E)%sf(i, j, 0) = 1._wp + q_prim_vf(sys_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA + q_prim_vf(sys_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,7 +270,7 @@ ! 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(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_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, & @@ -287,7 +287,7 @@ ! 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(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_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, & & 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)) @@ -296,7 +296,7 @@ ! 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(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_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, & & 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)) diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp index f96a130532..e6d7497588 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -88,14 +88,14 @@ 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%E)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + q_prim_vf(sys_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 pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(eqn_idx%E)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) + q_prim_vf(sys_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 @@ -105,7 +105,7 @@ 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(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres + q_prim_vf(sys_idx%E)%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) end if @@ -138,7 +138,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) end if - q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am + q_prim_vf(sys_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) @@ -164,7 +164,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) end if - q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am + q_prim_vf(sys_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,7 +173,7 @@ ! geometry 9 Mach = 0.1 if (patch_id == 1) then - q_prim_vf(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_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) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 6b58ca2c00..0e94627ae2 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -489,7 +489,7 @@ contains q_prim_vf(momxe)%sf(k, l, -j) = -q_prim_vf(momxe)%sf(k, l, j - 1) - do i = eqn_idx%E, sys_size + do i = sys_idx%E, sys_size q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1) end do @@ -523,7 +523,7 @@ contains q_prim_vf(momxe)%sf(k, l, p + j) = -q_prim_vf(momxe)%sf(k, l, p - (j - 1)) - do i = eqn_idx%E, sys_size + do i = sys_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 @@ -695,7 +695,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l + ((p + 1)/2)) - do i = eqn_idx%E, sys_size + do i = sys_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 @@ -707,7 +707,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l - ((p + 1)/2)) - do i = eqn_idx%E, sys_size + do i = sys_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 diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index b1b3e1ee89..1b84040193 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -67,8 +67,8 @@ contains Ys(eqn - chemxb + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) end do - ! e = E - 1/2*|u|^2 cons. eqn_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i - energy = q_cons_vf(eqn_idx%E)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) + ! e = E - 1/2*|u|^2 cons. sys_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i + energy = q_cons_vf(sys_idx%E)%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 end do @@ -100,7 +100,7 @@ contains end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - 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)) + q_T_sf%sf(x, y, z) = q_prim_vf(sys_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 @@ -235,8 +235,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - 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)) + P_L = q_prim_qp(sys_idx%E)%sf(x, y, z) + P_R = q_prim_qp(sys_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)) @@ -313,7 +313,7 @@ contains Mass_Diffu_Energy = lambda_Cell*dT_dxi + Mass_Diffu_Energy ! Update flux arrays - flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(sys_idx%E)%sf(x, y, z) = flux_src_vf(sys_idx%E)%sf(x, y, z) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') do eqn = chemxb, chemxe @@ -361,8 +361,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - 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)) + P_L = q_prim_qp(sys_idx%E)%sf(x, y, z) + P_R = q_prim_qp(sys_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)) @@ -405,7 +405,7 @@ contains Mass_Diffu_Energy = rho_cell*diffusivity_cell*dh_dxi ! Update flux arrays - flux_src_vf(eqn_idx%E)%sf(x, y, z) = flux_src_vf(eqn_idx%E)%sf(x, y, z) - Mass_Diffu_Energy + flux_src_vf(sys_idx%E)%sf(x, y, z) = flux_src_vf(sys_idx%E)%sf(x, y, z) - Mass_Diffu_Energy $:GPU_LOOP(parallelism='[seq]') do eqn = chemxb, chemxe diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index c514446119..197b5ef0d3 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -113,15 +113,39 @@ module m_derived_types type(int_bounds_info) :: x, y, z end type bc_xyz_info - !> Scalar equation indices computed at startup from model_eqns and enabled features. - type eqn_idx_info - integer :: E !< Index of energy equation - integer :: n !< Index of number density - integer :: alf !< Index of void fraction - integer :: gamma !< Index of specific heat ratio func. eqn. - integer :: pi_inf !< Index of liquid stiffness func. eqn. - integer :: c !< Index of color function - end type eqn_idx_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 + + !> 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). + type sys_idx_info + type(int_bounds_info) :: cont !< Partial densities (continuity equations) + type(int_bounds_info) :: mom !< Momentum components + type(int_bounds_info) :: adv !< Volume fractions (advection equations) + type(bub_bounds_info) :: bub !< Bubble variables (Euler-Euler) + type(int_bounds_info) :: stress !< Stress tensor components + type(int_bounds_info) :: xi !< Reference map equations + type(int_bounds_info) :: B !< Magnetic field components + type(int_bounds_info) :: int_en !< Internal energy equations + type(int_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 sys_idx_info type bc_patch_parameters integer :: geometry @@ -139,18 +163,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 3fc9e0bd9c..f88c7a087e 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -133,7 +133,7 @@ contains ! 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(eqn_idx%E)%sf(j, k, l) - dynE + rhoe = q_cons_vf(sys_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 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index d37d68c281..c6e04d0c81 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 = sys_idx%stress%beg, sys_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(eqn_idx%gamma)%sf(i, j, k) - pi_inf = q_vf(eqn_idx%pi_inf)%sf(i, j, k) + gamma = q_vf(sys_idx%gamma)%sf(i, j, k) + pi_inf = q_vf(sys_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) = sys_idx%bub%rs(i) end do $:GPU_UPDATE(device='[bubrs_vc]') end if @@ -535,12 +535,12 @@ 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(sys_idx%B%beg)%sf(j, k, l) + B(3) = qK_cons_vf(sys_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(sys_idx%B%beg)%sf(j, k, l) + B(2) = qK_cons_vf(sys_idx%B%beg + 1)%sf(j, k, l) + B(3) = qK_cons_vf(sys_idx%B%beg + 2)%sf(j, k, l) end if B2 = B(1)**2 + B(2)**2 + B(3)**2 @@ -556,7 +556,7 @@ contains S = S + qK_cons_vf(momxb + i - 1)%sf(j, k, l)*B(i) end do - E = qK_cons_vf(eqn_idx%E)%sf(j, k, l) + E = qK_cons_vf(sys_idx%E)%sf(j, k, l) D = 0._wp $:GPU_LOOP(parallelism='[seq]') @@ -590,7 +590,7 @@ 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(eqn_idx%E)%sf(j, k, l) = (W - D*Ga)/((gamma_K + 1)*Ga**2) + qK_prim_vf(sys_idx%E)%sf(j, k, l) = (W - D*Ga)/((gamma_K + 1)*Ga**2) ! Recover the other primitive variables $:GPU_LOOP(parallelism='[seq]') @@ -600,7 +600,7 @@ contains 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 = sys_idx%B%beg, sys_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do @@ -659,20 +659,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(sys_idx%B%beg)%sf(j, k, & + & l)**2 + qK_cons_vf(sys_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(sys_idx%B%beg)%sf(j, k, l)**2 + qK_cons_vf(sys_idx%B%beg + 1)%sf(j, k, & + & l)**2 + qK_cons_vf(sys_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(eqn_idx%E)%sf(j, k, l), qK_cons_vf(eqn_idx%alf)%sf(j, k, l), dyn_pres_K, & + call s_compute_pressure(qK_cons_vf(sys_idx%E)%sf(j, k, l), qK_cons_vf(sys_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(eqn_idx%E)%sf(j, k, l) = pres + qK_prim_vf(sys_idx%E)%sf(j, k, l) = pres if (chemistry) then q_T_sf%sf(j, k, l) = T @@ -685,7 +685,7 @@ contains nRtmp(i) = qK_cons_vf(bubrs_vc(i))%sf(j, k, l) end do - vftmp = qK_cons_vf(eqn_idx%alf)%sf(j, k, l) + vftmp = qK_cons_vf(sys_idx%alf)%sf(j, k, l) if (qbmm) then ! Get nb (constant across all R0 bins) @@ -702,8 +702,8 @@ contains #endif else if (adv_n) then - 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) + qK_prim_vf(sys_idx%n)%sf(j, k, l) = qK_cons_vf(sys_idx%n)%sf(j, k, l) + nbub_sc = qK_prim_vf(sys_idx%n)%sf(j, k, l) else call s_comp_n_from_cons(vftmp, nRtmp, nbub_sc, weight) end if @@ -717,7 +717,7 @@ contains if (mhd) then $:GPU_LOOP(parallelism='[seq]') - do i = B_idx%beg, B_idx%end + do i = sys_idx%B%beg, sys_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do end if @@ -730,16 +730,16 @@ contains 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(sys_idx%damage)%sf(j, k, l)), 0._wp) $:GPU_LOOP(parallelism='[seq]') do i = strxb, strxe ! subtracting elastic contribution for pressure calculation if (G_K > verysmall) then - 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, & + qK_prim_vf(sys_idx%E)%sf(j, k, l) = qK_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l) = qK_prim_vf(eqn_idx%E)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, & + qK_prim_vf(sys_idx%E)%sf(j, k, l) = qK_prim_vf(sys_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 @@ -761,12 +761,12 @@ contains end if if (surface_tension) then - qK_prim_vf(eqn_idx%c)%sf(j, k, l) = qK_cons_vf(eqn_idx%c)%sf(j, k, l) + qK_prim_vf(sys_idx%c)%sf(j, k, l) = qK_cons_vf(sys_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(sys_idx%damage)%sf(j, k, l) = qK_cons_vf(sys_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(sys_idx%psi)%sf(j, k, l) = qK_cons_vf(sys_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 +819,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 = sys_idx%adv%beg, sys_idx%adv%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do end if @@ -827,12 +827,12 @@ 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(sys_idx%B%beg)%sf(j, k, l) + B(3) = q_prim_vf(sys_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(sys_idx%B%beg)%sf(j, k, l) + B(2) = q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, l) + B(3) = q_prim_vf(sys_idx%B%beg + 2)%sf(j, k, l) end if v2 = 0._wp @@ -843,10 +843,10 @@ contains Ga = 1._wp/sqrt(1._wp - v2) - h = 1._wp + (gamma + 1)*q_prim_vf(eqn_idx%E)%sf(j, k, l)/rho ! Assume perfect gas for now + h = 1._wp + (gamma + 1)*q_prim_vf(sys_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 = sys_idx%B%beg, sys_idx%B%end B2 = B2 + q_prim_vf(i)%sf(j, k, l)**2 end do if (n == 0) B2 = B2 + Bx0**2 @@ -864,14 +864,14 @@ contains 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) end do - q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*h*Ga**2 - q_prim_vf(eqn_idx%E)%sf(j, k, & + q_cons_vf(sys_idx%E)%sf(j, k, l) = rho*h*Ga**2 - q_prim_vf(sys_idx%E)%sf(j, k, & & l) + 0.5_wp*(B2 + v2*B2 - vdotB**2) ! Remove rest energy do i = 1, contxe - 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) + q_cons_vf(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_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 = sys_idx%B%beg, sys_idx%B%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do @@ -900,33 +900,33 @@ contains end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - T = q_prim_vf(eqn_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho) + T = q_prim_vf(sys_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho) call get_mixture_energy_mass(T, Ys, e_mix) - q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + rho*e_mix + q_cons_vf(sys_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(sys_idx%B%beg)%sf(j, k, & + & l)**2 + q_prim_vf(sys_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(sys_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(sys_idx%B%beg + 1)%sf(j, & + & k, l)**2 + q_prim_vf(sys_idx%B%beg + 2)%sf(j, k, l)**2) end if ! MHD energy includes magnetic pressure contribution - q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, & + q_cons_vf(sys_idx%E)%sf(j, k, l) = gamma*q_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + dyn_pres + pi_inf + qv + q_cons_vf(sys_idx%E)%sf(j, k, l) = gamma*q_prim_vf(sys_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(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) + q_cons_vf(sys_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(sys_idx%alf)%sf(j, k, & + & l))*(gamma*q_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l) = 0._wp + q_cons_vf(sys_idx%E)%sf(j, k, l) = 0._wp end if end if @@ -934,7 +934,7 @@ contains 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(eqn_idx%E)%sf(j, k, & + & l)*(gammas(i)*q_prim_vf(sys_idx%E)%sf(j, k, & & l) + pi_infs(i)) + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) end do end if @@ -942,15 +942,15 @@ contains 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(sys_idx%bub%rs(i))%sf(j, k, l) end do if (.not. qbmm) then if (adv_n) then - 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) + q_cons_vf(sys_idx%n)%sf(j, k, l) = q_prim_vf(sys_idx%n)%sf(j, k, l) + nbub = q_prim_vf(sys_idx%n)%sf(j, k, l) else - call s_comp_n_from_prim(real(q_prim_vf(eqn_idx%alf)%sf(j, k, l), kind=wp), Rtmp, nbub, weight) + call s_comp_n_from_prim(real(q_prim_vf(sys_idx%alf)%sf(j, k, l), kind=wp), Rtmp, nbub, weight) end if else ! Initialize R3 averaging over R0 and R directions @@ -960,16 +960,16 @@ contains R3tmp = R3tmp + weight(i)*0.5_wp*(Rtmp(i) - sigR)**3._wp end do ! Initialize nb - nbub = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*R3tmp) + nbub = 3._wp*q_prim_vf(sys_idx%alf)%sf(j, k, l)/(4._wp*pi*R3tmp) end if - do i = bub_idx%beg, bub_idx%end + do i = sys_idx%bub%beg, sys_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 = sys_idx%B%beg, sys_idx%B%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do end if @@ -982,15 +982,15 @@ contains end if if (hypoelasticity) then - if (cont_damage) G = G*max((1._wp - q_prim_vf(damage_idx)%sf(j, k, l)), 0._wp) + if (cont_damage) G = G*max((1._wp - q_prim_vf(sys_idx%damage)%sf(j, k, l)), 0._wp) do i = strxb, strxe ! adding elastic contribution if (G > verysmall) then - 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, & + q_cons_vf(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_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(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & + q_cons_vf(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, & & l)**2._wp)/(4._wp*G) end if end if @@ -1006,12 +1006,12 @@ contains end if if (surface_tension) then - q_cons_vf(eqn_idx%c)%sf(j, k, l) = q_prim_vf(eqn_idx%c)%sf(j, k, l) + q_cons_vf(sys_idx%c)%sf(j, k, l) = q_prim_vf(sys_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(sys_idx%damage)%sf(j, k, l) = q_prim_vf(sys_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(sys_idx%psi)%sf(j, k, l) = q_prim_vf(sys_idx%psi)%sf(j, k, l) end do end do end do @@ -1079,7 +1079,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe - alpha_K(i - eqn_idx%E) = qK_prim_vf(j, k, l, i) + alpha_K(i - sys_idx%E) = qK_prim_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') @@ -1093,7 +1093,7 @@ contains vel_K_sum = vel_K_sum + vel_K(i)**2._wp end do - pres_K = qK_prim_vf(j, k, l, eqn_idx%E) + pres_K = qK_prim_vf(j, k, l, sys_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) @@ -1131,7 +1131,7 @@ contains end do ! energy flux, u(E+p) - FK_vf(j, k, l, eqn_idx%E) = vel_K(dir_idx(1))*(E_K + pres_K) + FK_vf(j, k, l, sys_idx%E) = vel_K(dir_idx(1))*(E_K + pres_K) ! Species advection Flux, \rho*u*Y if (chemistry) then @@ -1145,13 +1145,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe FK_vf(j, k, l, i) = 0._wp - FK_src_vf(j, k, l, i) = alpha_K(i - eqn_idx%E) + FK_src_vf(j, k, l, i) = alpha_K(i - sys_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 - eqn_idx%E) + FK_vf(j, k, l, i) = vel_K(dir_idx(1))*alpha_K(i - sys_idx%E) end do $:GPU_LOOP(parallelism='[seq]') diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index dda9ecf7fb..1bb38ab8d9 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, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_idx%mom%beg if (mom_wrt(i) .or. cons_vars_wrt) dbvars = dbvars + 1 end do - do i = 1, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_idx%mom%beg if (vel_wrt(i) .or. prim_vars_wrt) dbvars = dbvars + 1 end do - do i = 1, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_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(eqn_idx%E + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(eqn_idx%E + 2)%sf(i, j, k) + if (q_prim_vf(sys_idx%E + 2)%sf(i, j, k) > maxalph_loc) then + maxalph_loc = q_prim_vf(sys_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(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) + axp = q_prim_vf(sys_idx%E + 2)%sf(j + 1, k, cent) + axm = q_prim_vf(sys_idx%E + 2)%sf(j, k, cent) + ayp = q_prim_vf(sys_idx%E + 2)%sf(j, k + 1, cent) + aym = q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, k) - Egint = Egint + q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*(gammas(2)*pres)*dV + pres = q_prim_vf(sys_idx%E)%sf(i, j, k) + Egint = Egint + q_prim_vf(sys_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(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 + Egk = Egk + 0.5_wp*q_prim_vf(sys_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(sys_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 - eqn_idx%E - adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) + do l = 1, sys_idx%adv%end - sys_idx%E + adv(l) = q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, k)*dV + Et = Et + q_cons_vf(sys_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 9eb8fa971b..b3d3ae100a 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(eqn_idx%E)%sf(i, j, k) + pi_inf_sf(i, j, & + q_sf(i, j, k) = (((gamma_sf(i, j, k) + 1._wp)*q_prim_vf(sys_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(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(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(sys_idx%E)%sf(i, j, k) + pi_infs(1))/gammas(1) + blkmod2 = ((gammas(2) + 1._wp)*q_prim_vf(sys_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(sys_idx%adv%beg)%sf(i, j, & + & k)/blkmod1 + (1._wp - q_prim_vf(sys_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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j - 1, k, l) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(sys_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(sys_idx%adv%beg)%sf(j + 2, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(sys_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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k - 1, l) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(sys_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(sys_idx%adv%beg)%sf(j, k + 2, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(sys_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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k, l - 1) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(sys_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(sys_idx%adv%beg)%sf(j, k, l + 2) - q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) + bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(sys_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(sys_idx%mom%end)%sf(j, r + k, l) - fd_coeff_z(r, & + & l)*q_prim_vf(sys_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(sys_idx%mom%end)%sf(j, r + k, & + & l) - fd_coeff_z(r, l)*q_prim_vf(sys_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(sys_idx%mom%beg)%sf(j, k, & + & r + l) - fd_coeff_x(r, j)*q_prim_vf(sys_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(sys_idx%mom%beg)%sf(j, k, & + & r + l) - fd_coeff_x(r, j)*q_prim_vf(sys_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(sys_idx%mom%beg + 1)%sf(r + j, k, & + & l) - fd_coeff_y(r, k)*q_prim_vf(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_idx%mom%beg + i - 1)%sf(j, k, r + l) end do end do @@ -495,8 +495,8 @@ contains do j = -offset_x%beg, m + offset_x%end q_sf(j, k, l) = 0._wp - do i = 1, adv_idx%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, & + do i = 1, sys_idx%adv%end - sys_idx%E + q_sf(j, k, l) = q_sf(j, k, l) - schlieren_alpha(i)*q_cons_vf(i + sys_idx%E)%sf(j, k, l)*gm_rho_sf(j, & & k, l)/gm_rho_max(1) end do end do diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 05176403fa..11f4494440 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -112,19 +112,8 @@ 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. - type(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) - 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. - 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. - 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + 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". @@ -506,46 +495,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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg + 1 - eqn_idx%gamma = adv_idx%beg - eqn_idx%pi_inf = adv_idx%end - sys_size = adv_idx%end + sys_idx%cont%beg = 1 + sys_idx%cont%end = sys_idx%cont%beg + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg + 1 + sys_idx%gamma = sys_idx%adv%beg + sys_idx%pi_inf = sys_idx%adv%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_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 = eqn_idx%E + 1 ! Alpha for fluid 1 - adv_idx%end = eqn_idx%E + num_fluids - 1 + ! volume fractions for N fluids, hence the "-1" in sys_idx%adv%end. If num_fluids = 1 then sys_idx%adv%end < + ! sys_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track + sys_idx%adv%beg = sys_idx%E + 1 ! Alpha for fluid 1 + sys_idx%adv%end = sys_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 = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids + ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in sys_idx%adv%end + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = sys_idx%adv%end if (bubbles_euler) then - eqn_idx%alf = adv_idx%end + sys_idx%alf = sys_idx%adv%end else - eqn_idx%alf = 1 + sys_idx%alf = 1 end if if (qbmm) then @@ -553,34 +542,34 @@ contains end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + sys_idx%bub%beg = sys_size + 1 if (qbmm) then - bub_idx%end = adv_idx%end + nb*nmom + sys_idx%bub%end = sys_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + sys_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end if (adv_n) then - eqn_idx%n = bub_idx%end + 1 - sys_size = eqn_idx%n + sys_idx%n = sys_idx%bub%end + 1 + sys_size = sys_idx%n end if - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) + allocate (sys_idx%bub%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - bub_idx%moms(i, j) = bub_idx%beg + (j - 1) + (i - 1)*nmom + sys_idx%bub%moms(i, j) = sys_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) + sys_idx%bub%rs(i) = sys_idx%bub%moms(i, 2) + sys_idx%bub%vs(i) = sys_idx%bub%moms(i, 3) end do else do i = 1, nb @@ -590,12 +579,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do end if @@ -607,51 +596,51 @@ contains end if if (mhd) then - B_idx%beg = sys_size + 1 + sys_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + sys_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + sys_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - eqn_idx%alf = 1 ! dummy, cannot actually have a void fraction + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids + sys_idx%int_en%beg = sys_idx%adv%end + 1 + sys_idx%int_en%end = sys_idx%adv%end + num_fluids + sys_size = sys_idx%int_en%end + sys_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 - eqn_idx%E = mom_idx%end + 1 ! one energy equation - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - eqn_idx%alf = adv_idx%end - sys_size = eqn_idx%alf ! adv_idx%end + sys_idx%cont%beg = 1 ! one continuity equation + sys_idx%cont%end = 1 ! num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 ! one energy equation + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation + sys_idx%alf = sys_idx%adv%end + sys_size = sys_idx%alf ! sys_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + sys_idx%bub%beg = sys_size + 1 + sys_idx%bub%end = sys_size + 2*nb if (polytropic .neqv. .true.) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) allocate (weight(nb), R0(nb)) do i = 1, nb @@ -661,12 +650,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do @@ -687,24 +676,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 + sys_idx%stress%beg = sys_size + 1 + sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) sys_idx%stress%end = sys_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 = sys_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) = sys_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) = sys_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/)) @@ -714,42 +703,42 @@ contains end if if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + sys_idx%xi%beg = sys_size + 1 + sys_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 = sys_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 - eqn_idx%c = sys_size + 1 - sys_size = eqn_idx%c + sys_idx%c = sys_size + 1 + sys_size = sys_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + sys_idx%damage = sys_size + 1 + sys_size = sys_idx%damage else - damage_idx = dflt_int + sys_idx%damage = dflt_int end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + sys_idx%psi = sys_size + 1 + sys_size = sys_idx%psi else - psi_idx = dflt_int + sys_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 + sys_idx%species%beg = sys_size + 1 + sys_idx%species%end = sys_size + num_species + sys_size = sys_idx%species%end else - species_idx%beg = 1 - species_idx%end = 1 + sys_idx%species%beg = 1 + sys_idx%species%end = 1 end if if (output_partial_domain) then @@ -761,22 +750,22 @@ 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 + momxb = sys_idx%mom%beg + momxe = sys_idx%mom%end + advxb = sys_idx%adv%beg + advxe = sys_idx%adv%end + contxb = sys_idx%cont%beg + contxe = sys_idx%cont%end + bubxb = sys_idx%bub%beg + bubxe = sys_idx%bub%end + strxb = sys_idx%stress%beg + strxe = sys_idx%stress%end + intxb = sys_idx%int_en%beg + intxe = sys_idx%int_en%end + xibeg = sys_idx%xi%beg + xiend = sys_idx%xi%end + chemxb = sys_idx%species%beg + chemxe = sys_idx%species%end #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index 7d3bd12782..57a44abae9 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, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_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 + sys_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, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_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 + sys_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) @@ -316,7 +316,7 @@ contains end if end if - do i = 1, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_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(eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(sys_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) @@ -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(sys_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(sys_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(sys_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 = sys_idx%B%beg, sys_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 == sys_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 == sys_idx%B%beg) then write (varname, '(A)') 'Bx' - else if (i == B_idx%beg + 1) then + else if (i == sys_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, sys_idx%stress%end - sys_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 + sys_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 @@ -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(sys_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(sys_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(eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_prim_vf(sys_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 + eqn_idx%E)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(i + sys_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(eqn_idx%E + l)%sf(i, j, k) + q_sf(i, j, k) = q_sf(i, j, k) - q_cons_vf(sys_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(sys_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 - eqn_idx%E - adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) + do l = 1, sys_idx%adv%end - sys_idx%E + adv(l) = q_prim_vf(sys_idx%E + l)%sf(i, j, k) end do - pres = q_prim_vf(eqn_idx%E)%sf(i, j, k) + pres = q_prim_vf(sys_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(eqn_idx%c)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(sys_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 = sys_idx%adv%beg, sys_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 - eqn_idx%E + write (varname, '(A,I0)') 'alpha', i - sys_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(sys_idx%bub%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(sys_idx%bub%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(sys_idx%bub%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(sys_idx%bub%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(eqn_idx%n)%sf(x_beg:x_end,y_beg:y_end,z_beg:z_end) + q_sf(:,:,:) = q_cons_vf(sys_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 d07e7c35bf..2c646ef5c4 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, eqn_idx%E - mom_idx%beg + do i = 1, sys_idx%E - sys_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(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(sys_idx%gamma)%sf(j, k, l) = eta*patch_icpp(patch_id)%gamma + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma - q_prim_vf(eqn_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(eqn_idx%gamma)%sf(j, k, & + q_prim_vf(sys_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(sys_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(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 + q_prim_vf(sys_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 @@ -147,13 +147,13 @@ contains B_tait = ps_inf(1) if (j < 177) then - q_prim_vf(eqn_idx%E)%sf(j, k, l) = 0.5_wp*q_prim_vf(eqn_idx%E)%sf(j, k, l) + q_prim_vf(sys_idx%E)%sf(j, k, l) = 0.5_wp*q_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp) + & l)*((p0 - bub_pp%pv)/(q_prim_vf(sys_idx%E)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp) end do end if @@ -173,32 +173,32 @@ contains end do end if - n0 = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*R3bar) + n0 = 3._wp*q_prim_vf(sys_idx%alf)%sf(j, k, l)/(4._wp*pi*R3bar) - ratio = ((1._wp + B_tait)/(q_prim_vf(eqn_idx%E)%sf(j, k, l) + B_tait))**(1._wp/n_tait) + ratio = ((1._wp + B_tait)/(q_prim_vf(sys_idx%E)%sf(j, k, l) + B_tait))**(1._wp/n_tait) - nH = n0/((1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*R3bar) + nH = n0/((1._wp - q_prim_vf(sys_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(eqn_idx%alf)%sf(j, k, l))/rhoH + deno = 1._wp - (1._wp - q_prim_vf(sys_idx%alf)%sf(j, k, l))/rhoH if (f_approx_equal(deno, 0._wp)) then velH = 0._wp else - 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 = (q_prim_vf(sys_idx%E)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(sys_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 = sys_idx%cont%beg, sys_idx%cont%end q_prim_vf(i)%sf(j, k, l) = rhoH end do - do i = mom_idx%beg, mom_idx%end + do i = sys_idx%mom%beg, sys_idx%mom%end q_prim_vf(i)%sf(j, k, l) = velH end do - q_prim_vf(eqn_idx%alf)%sf(j, k, l) = vfH + q_prim_vf(sys_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 = sys_idx%adv%beg, sys_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(eqn_idx%alf)%sf)/alf_sum%sf + do i = sys_idx%adv%beg, sys_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_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 - eqn_idx%E) + do i = sys_idx%adv%beg, sys_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - sys_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 = sys_idx%adv%beg, sys_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(eqn_idx%alf)%sf)/alf_sum%sf + do i = sys_idx%adv%beg, sys_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%sf)/alf_sum%sf end do end if if (model_eqns /= 4) then - do i = 1, cont_idx%end + do i = 1, sys_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, sys_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 - eqn_idx%E) + do i = sys_idx%adv%beg, sys_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - sys_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 = sys_idx%adv%beg, sys_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(eqn_idx%alf)%sf)/alf_sum%sf + do i = sys_idx%adv%beg, sys_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%sf)/alf_sum%sf end do end if @@ -315,26 +315,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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 + q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, & + & l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) + q_prim_vf(sys_idx%bub%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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(sys_idx%bub%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(sys_idx%bub%rs(i))%sf(j, k, l) = muR + q_prim_vf(sys_idx%bub%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(sys_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(sys_idx%bub%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if end do @@ -343,9 +344,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(sys_idx%bub%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*R3bar) + q_prim_vf(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if end if @@ -353,29 +354,32 @@ contains & patch_icpp(smooth_patch_id)%gamma, patch_icpp(smooth_patch_id)%pi_inf, & & patch_icpp(smooth_patch_id)%qv) - 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)) + q_prim_vf(sys_idx%E)%sf(j, k, l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(sys_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 - eqn_idx%E) + (1._wp - eta)*orig_prim_vf(i) + do i = sys_idx%adv%beg, sys_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha(i - sys_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(sys_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg) + q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(sys_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(sys_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg) + q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg + 1) + q_prim_vf(sys_idx%B%beg + 2)%sf(j, k, & + & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(sys_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, (sys_idx%stress%end - sys_idx%stress%beg) + 1 + q_prim_vf(i + sys_idx%stress%beg - 1)%sf(j, k, & + & l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + sys_idx%stress%beg - 1)) end do end if @@ -404,18 +408,18 @@ 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 = sys_idx%adv%beg, sys_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(eqn_idx%alf)%sf)/alf_sum%sf + do i = sys_idx%adv%beg, sys_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_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, sys_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 +429,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(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)) + q_prim_vf(1)%sf(j, k, l) = (((q_prim_vf(sys_idx%E)%sf(j, k, & + & l) + pi_inf)/(pref + pi_inf))**(1/lit_gamma))*rhoref*(1 - q_prim_vf(sys_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, eqn_idx%E - 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, sys_idx%E - sys_idx%mom%beg + q_prim_vf(i + sys_idx%cont%end)%sf(j, k, & + & l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + sys_idx%cont%end)) end do if (chemistry) then @@ -460,15 +464,15 @@ contains ! 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 + sys_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)) + & + sys_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(eqn_idx%E)%sf(j, k, l) + do i = sys_idx%int_en%beg, sys_idx%int_en%end + q_prim_vf(i)%sf(j, k, l) = q_prim_vf(sys_idx%E)%sf(j, k, l) end do end if @@ -479,27 +483,28 @@ 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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 + q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, & + & l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) + q_prim_vf(sys_idx%bub%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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(sys_idx%bub%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(sys_idx%bub%rs(i))%sf(j, k, l) = muR + q_prim_vf(sys_idx%bub%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(sys_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(sys_idx%bub%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if end do @@ -508,37 +513,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(sys_idx%bub%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*R3bar) + q_prim_vf(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_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 = sys_idx%adv%beg, sys_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(eqn_idx%alf)%sf)/alf_sum%sf + do i = sys_idx%adv%beg, sys_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_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(sys_idx%bub%ps(i))%sf(j, k, l), kind=wp))) then + q_prim_vf(sys_idx%bub%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(sys_idx%bub%ms(i))%sf(j, k, l), kind=wp))) then + q_prim_vf(sys_idx%bub%ms(i))%sf(j, k, l) = mass_v0(i) end if end do end if if (surface_tension) then - 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) + q_prim_vf(sys_idx%c)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(sys_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 0e224f0b6d..df3fde329e 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -178,51 +178,51 @@ contains if ((i >= chemxb) .and. (i <= chemxe)) 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 >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & + & .and. (i <= sys_idx%adv%end)) .or. ((i >= chemxb) .and. (i <= chemxe))) 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 == eqn_idx%E) then ! p + else if (i == sys_idx%mom%beg) then ! u + write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg)%sf(j, 0, 0)/rho + else if (i == sys_idx%stress%beg) then ! tau_e + write (2, FMT) x_cb(j), q_cons_vf(sys_idx%stress%beg)%sf(j, 0, 0)/rho + else if (i == sys_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(sys_idx%B%beg)%sf(j, 0, & + & 0)**2 + q_cons_vf(sys_idx%B%beg + 1)%sf(j, 0, 0)**2) end if - 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(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(sys_idx%E)%sf(j, 0, 0), q_cons_vf(sys_idx%alf)%sf(j, 0, 0), & + & 0.5_wp*(q_cons_vf(sys_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 == sys_idx%mom%beg + 1) then ! v + write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg + 1)%sf(j, 0, 0)/rho + else if (i == sys_idx%mom%beg + 2) then ! w + write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg + 2)%sf(j, 0, 0)/rho + else if (i == sys_idx%B%beg) then ! By + write (2, FMT) x_cb(j), q_cons_vf(sys_idx%B%beg)%sf(j, 0, 0)/rho + else if (i == sys_idx%B%beg + 1) then ! Bz + write (2, FMT) x_cb(j), q_cons_vf(sys_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 >= sys_idx%bub%beg) .and. (i <= sys_idx%bub%end) .and. bubbles_euler) then if (qbmm) then nbub = q_cons_vf(bubxb)%sf(j, 0, 0) else if (adv_n) then - nbub = q_cons_vf(eqn_idx%n)%sf(j, 0, 0) + nbub = q_cons_vf(sys_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(sys_idx%bub%rs(k))%sf(j, 0, 0) end do - call s_comp_n_from_cons(real(q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), kind=wp), nRtmp, nbub, weight) + call s_comp_n_from_cons(real(q_cons_vf(sys_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 == eqn_idx%n .and. adv_n .and. bubbles_euler) then + else if (i == sys_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 == sys_idx%damage) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) end if end do @@ -576,7 +576,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 +611,44 @@ 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)') " " + write (iu, '(A3,A20,A20)') "#", "Conservative", "Primitive" + write (iu, '(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, '(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) - end do - do i = eqn_idx%E, eqn_idx%E - write (1, '(I3,A20,A20)') i, "\rho U", "p" + write (iu, '(I3,A20,A20)') i, "\rho u_" // coord(i - momxb + 1), "u_" // coord(i - momxb + 1) end do + if (sys_idx%E /= 0) write (iu, '(I3,A20,A20)') sys_idx%E, "\rho U", "p" do i = advxb, advxe write (temp, '(I0)') i - contxb + 1 - write (1, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "}", "\alpha_{" // trim(temp) // "}" + 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)') chemxb + 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 (eqn_idx%E /= 0) write (1, '("[",I2,",",I2,"]",A)') eqn_idx%E, eqn_idx%E, " 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)') "" + if (momxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') momxb, momxe, " Momentum" + if (sys_idx%E /= 0) write (iu, '("[",I2,",",I2,"]",A)') sys_idx%E, sys_idx%E, " Energy/Pressure" + if (advxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') advxb, advxe, " Advection" + if (contxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') contxb, contxe, " Continuity" + if (bubxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') bubxb, bubxe, " Bubbles_euler" + if (strxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') strxb, strxe, " Stress" + if (intxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') intxb, intxe, " Internal Energies" + if (chemxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') chemxb, chemxe, " Chemistry" + + close (iu) if (down_sample) then m_ds = int((m + 1)/3) - 1 diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 01960ef0c1..3fce0b048f 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -82,18 +82,7 @@ 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. - type(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) - 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. - 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. - 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. ! 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) @@ -558,87 +547,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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg + 1 - eqn_idx%gamma = adv_idx%beg - eqn_idx%pi_inf = adv_idx%end - sys_size = adv_idx%end + sys_idx%cont%beg = 1 + sys_idx%cont%end = sys_idx%cont%beg + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg + 1 + sys_idx%gamma = sys_idx%adv%beg + sys_idx%pi_inf = sys_idx%adv%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_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 = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids - 1 + ! volume fractions for N fluids, hence the "-1" in sys_idx%adv%end. If num_fluids = 1 then sys_idx%adv%end < + ! sys_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_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 = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids + ! a total of (N) volume fractions for N fluids, hence the lack of "-1" in sys_idx%adv%end + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = sys_idx%adv%end if (bubbles_euler) then - eqn_idx%alf = adv_idx%end + sys_idx%alf = sys_idx%adv%end else - eqn_idx%alf = 1 + sys_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + sys_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 + sys_idx%bub%end = sys_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + sys_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end if (adv_n) then - eqn_idx%n = bub_idx%end + 1 - sys_size = eqn_idx%n + sys_idx%n = sys_idx%bub%end + 1 + sys_size = sys_idx%n end if - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) - allocate (bub_idx%fullmom(nb,0:nmom,0:nmom)) + allocate (sys_idx%bub%moms(nb, nmom)) + allocate (sys_idx%bub%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 + sys_idx%bub%moms(i, j) = sys_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) + sys_idx%bub%fullmom(i, 0, 0) = sys_idx%bub%moms(i, 1) + sys_idx%bub%fullmom(i, 1, 0) = sys_idx%bub%moms(i, 2) + sys_idx%bub%fullmom(i, 0, 1) = sys_idx%bub%moms(i, 3) + sys_idx%bub%fullmom(i, 2, 0) = sys_idx%bub%moms(i, 4) + sys_idx%bub%fullmom(i, 1, 1) = sys_idx%bub%moms(i, 5) + sys_idx%bub%fullmom(i, 0, 2) = sys_idx%bub%moms(i, 6) + sys_idx%bub%rs(i) = sys_idx%bub%fullmom(i, 1, 0) end do else do i = 1, nb @@ -648,63 +637,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do end if end if if (mhd) then - B_idx%beg = sys_size + 1 + sys_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + sys_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + sys_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids + sys_idx%int_en%beg = sys_idx%adv%end + 1 + sys_idx%int_en%end = sys_idx%adv%end + num_fluids + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 ! one energy equation - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - eqn_idx%alf = adv_idx%end - sys_size = eqn_idx%alf ! adv_idx%end + sys_idx%cont%beg = 1 ! one continuity equation + sys_idx%cont%end = 1 ! num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each direction + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 ! one energy equation + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation + sys_idx%alf = sys_idx%adv%end + sys_size = sys_idx%alf ! sys_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + sys_idx%bub%beg = sys_size + 1 + sys_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) allocate (weight(nb), R0(nb)) do i = 1, nb @@ -714,12 +703,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do @@ -740,24 +729,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 + sys_idx%stress%beg = sys_size + 1 + sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) sys_idx%stress%end = sys_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 = sys_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) = sys_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) = sys_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/)) @@ -770,50 +759,50 @@ 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 + sys_idx%xi%beg = sys_size + 1 + sys_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 = sys_idx%xi%end + 1 end if if (surface_tension) then - eqn_idx%c = sys_size + 1 - sys_size = eqn_idx%c + sys_idx%c = sys_size + 1 + sys_size = sys_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + sys_idx%damage = sys_size + 1 + sys_size = sys_idx%damage end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + sys_idx%psi = sys_size + 1 + sys_size = sys_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 + sys_idx%species%beg = sys_size + 1 + sys_idx%species%end = sys_size + num_species + sys_size = sys_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 + momxb = sys_idx%mom%beg + momxe = sys_idx%mom%end + advxb = sys_idx%adv%beg + advxe = sys_idx%adv%end + contxb = sys_idx%cont%beg + contxe = sys_idx%cont%end + bubxb = sys_idx%bub%beg + bubxe = sys_idx%bub%end + strxb = sys_idx%stress%beg + strxe = sys_idx%stress%end + intxb = sys_idx%int_en%beg + intxe = sys_idx%int_en%end + xibeg = sys_idx%xi%beg + xiend = sys_idx%xi%end + chemxb = sys_idx%species%beg + chemxe = sys_idx%species%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) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index e58b2e582f..6e21217d0e 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(eqn_idx%alf)%sf(i, j, & + q_prim_vf(sys_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(eqn_idx%alf)%sf(i, j, & + q_prim_vf(sys_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(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) & + q_prim_vf(1)%sf(i, j, 0) = (((q_prim_vf(sys_idx%E)%sf(i, j, & + & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(sys_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(eqn_idx%E)%sf(i, j, & + q_prim_vf(sys_idx%mom%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) + q_prim_vf(sys_idx%mom%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) + q_prim_vf(sys_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..52fcdac33f 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(sys_idx%damage)%sf = 0._wp + q_prim_vf(sys_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(sys_idx%psi)%sf = 0._wp + q_prim_vf(sys_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 4bcd2f131d..de05e35c7c 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(eqn_idx%E + perturb_sph_fluid)%sf(i, j, k) + perturb_alpha = q_prim_vf(sys_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(eqn_idx%E + l)%sf(i, j, k)*fluid_rho(l) + q_prim_vf(l)%sf(i, j, k) = q_prim_vf(sys_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(sys_idx%mom%end)%sf(i, j, k) = rand_real*q_prim_vf(sys_idx%mom%beg)%sf(i, j, k) + q_prim_vf(sys_idx%mom%beg)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(sys_idx%mom%beg)%sf(i, j, k) if (bubbles_euler) then - q_prim_vf(eqn_idx%alf)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(eqn_idx%alf)%sf(i, j, k) + q_prim_vf(sys_idx%alf)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(sys_idx%alf)%sf(i, j, k) end if end do end do diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 0cf3a475f3..57fc767b2b 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(sys_idx%psi > 0, "hyper_cleaning requires sys_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(sys_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2)) + q_prim_vf(sys_idx%psi)%sf(j, k, l) = q_cons_vf(sys_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 55136ec77f..2ec7d8c43f 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -250,7 +250,7 @@ contains end if small_gamma = 1._wp/small_gamma + 1._wp - c = sqrt(small_gamma*(q_prim_vf(eqn_idx%E)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho) + c = sqrt(small_gamma*(q_prim_vf(sys_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) @@ -322,7 +322,7 @@ contains 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) end do - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + e_src(j, k, l) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_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 d649782326..0bc2cdcba0 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -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, eqn_idx%E + do i = momxb, sys_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -105,7 +105,7 @@ contains 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(momxb)%sf(j, k, l)*accel_bf(1) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxb)%sf(j, k, l)*accel_bf(1) end do end do end do @@ -119,7 +119,7 @@ contains do k = 0, n do j = 0, m rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + 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(momxb + 1)%sf(j, k, l)*accel_bf(2) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxb + 1)%sf(j, k, l)*accel_bf(2) end do end do end do @@ -133,7 +133,7 @@ contains 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + q_cons_vf(momxe)%sf(j, k, l)*accel_bf(3) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxe)%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 b1f408643a..9c3976ae62 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) = sys_idx%bub%rs(l) + vs(l) = sys_idx%bub%vs(l) if (.not. polytropic) then - ps(l) = bub_idx%ps(l) - ms(l) = bub_idx%ms(l) + ps(l) = sys_idx%bub%ps(l) + ms(l) = sys_idx%bub%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(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) + q_cons_vf(sys_idx%alf)%sf(j, k, l) = (4._wp*pi*nR3bar)/(3._wp*q_cons_vf(sys_idx%n)%sf(j, k, l)**2._wp) 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(eqn_idx%n)%sf(j, k, l) + nbub = q_prim_vf(sys_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(eqn_idx%alf)%sf(j, k, l)/R3 + nbub = (3._wp/(4._wp*pi))*q_prim_vf(sys_idx%alf)%sf(j, k, l)/R3 end if if (.not. adap_dt) 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(eqn_idx%E)%sf(j, k, l) - alf = q_prim_vf(eqn_idx%alf)%sf(j, k, l) + myP = q_prim_vf(sys_idx%E)%sf(j, k, l) + alf = q_prim_vf(sys_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,7 +303,7 @@ contains do l = 0, p do q = 0, n do i = 0, m - rhs_vf(eqn_idx%alf)%sf(i, q, l) = rhs_vf(eqn_idx%alf)%sf(i, q, l) + bub_adv_src(i, q, l) + rhs_vf(sys_idx%alf)%sf(i, q, l) = rhs_vf(sys_idx%alf)%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) $:GPU_LOOP(parallelism='[seq]') do k = 1, nb diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index 856d041c42..81d904b92f 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -281,8 +281,8 @@ contains do i = 1, num_dims dynP = dynP + 0.5_wp*q_cons_vf(contxe + i)%sf(cell(1), cell(2), cell(3))**2/rhol end do - 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 = (q_cons_vf(sys_idx%E)%sf(cell(1), cell(2), cell(3)) - dynP - pi_inf)/gamma + if (pliq < 0) print *, "Negative pressure", proc_rank, q_cons_vf(sys_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, eqn_idx%E + do l = 1, sys_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, eqn_idx%E + do l = 1, sys_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(eqn_idx%E)%sf, q_beta(3)%sf, l) + call s_gradient_dir(q_prim_vf(sys_idx%E)%sf, q_beta(3)%sf, l) ! (q / (1 - beta)) * d(beta)/dt source $:GPU_PARALLEL_LOOP(private='[i, j, k]', collapse=3) @@ -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(eqn_idx%E)%sf(i, j, k)*q_prim_vf(contxe + l)%sf(i, j, k) + q_beta(3)%sf(i, j, k) = q_prim_vf(sys_idx%E)%sf(i, j, k)*q_prim_vf(contxe + 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(eqn_idx%E)%sf(i, j, k) = rhs_vf(eqn_idx%E)%sf(i, j, k) - q_beta(4)%sf(i, j, & + rhs_vf(sys_idx%E)%sf(i, j, k) = rhs_vf(sys_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 @@ -842,19 +842,19 @@ contains !> Perform bilinear interpolation if (p == 0) then ! 2D - 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) + f_pinfl = q_prim_vf(sys_idx%E)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2)) + f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2)) + f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2) + f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%sf(cell(1), cell(2) + 1, cell(3))*(1._wp - psi(1))*psi(2) else ! 3D - 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) + f_pinfl = q_prim_vf(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(eqn_idx%E)%sf(cellaux(1), cellaux(2), cellaux(3))*vol + charpres = charpres + q_prim_vf(sys_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(eqn_idx%E)%sf(cellaux(1), cellaux(2), & + charpres2 = charpres2 + q_prim_vf(sys_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 999dbc1cd3..2e5347a187 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -96,7 +96,7 @@ contains if (chemistry) then flux_cbc_index = sys_size else - flux_cbc_index = adv_idx%end + flux_cbc_index = sys_idx%adv%end end if $:GPU_UPDATE(device='[flux_cbc_index]') @@ -124,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, sys_idx%adv%beg:sys_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, sys_idx%adv%beg:sys_idx%adv%end)) if (n > 0) then if (m == 0) then @@ -152,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, sys_idx%adv%beg:sys_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, sys_idx%adv%beg:sys_idx%adv%end)) end if if (p > 0) then @@ -181,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, sys_idx%adv%beg:sys_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, sys_idx%adv%beg:sys_idx%adv%end)) end if ! Allocating the cell-width distribution in the s-direction @@ -620,11 +620,11 @@ contains vel_K_sum = vel_K_sum + vel(i)**2._wp end do - pres = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E) + pres = q_prim_rs${XYZ}$_vf(0, k, r, sys_idx%E) $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E - adv_local(i) = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E + i) + do i = 1, advxe - sys_idx%E + adv_local(i) = q_prim_rs${XYZ}$_vf(0, k, r, sys_idx%E + i) end do call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, adv_local, alpha_rho, Re_cbc) @@ -680,7 +680,7 @@ contains dpres_ds = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E + do i = 1, advxe - sys_idx%E dadv_ds(i) = 0._wp end do @@ -702,10 +702,10 @@ contains dvel_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, contxe + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dvel_ds(i) end do - dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%E)*fd_coef_${XYZ}$ (j, cbc_loc) + dpres_ds + dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, sys_idx%E)*fd_coef_${XYZ}$ (j, cbc_loc) + dpres_ds $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - 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) + do i = 1, advxe - sys_idx%E + dadv_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, sys_idx%E + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dadv_ds(i) end do if (chemistry) then @@ -748,8 +748,8 @@ contains end if end if $:GPU_LOOP(parallelism='[seq]') - do i = eqn_idx%E, advxe - 1 - L(i) = c*Ma*(adv_local(i + 1 - eqn_idx%E) - alpha_in(i + 1 - eqn_idx%E, & + do i = sys_idx%E, advxe - 1 + L(i) = c*Ma*(adv_local(i + 1 - sys_idx%E) - alpha_in(i + 1 - sys_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, & @@ -820,12 +820,12 @@ contains ! 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 - eqn_idx%E + do i = 1, advxe - sys_idx%E dadv_dt(i) = -L(momxe + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) end do else $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E + do i = 1, advxe - sys_idx%E dadv_dt(i) = -L(momxe + i) end do end if @@ -876,8 +876,8 @@ 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, 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) & + flux_rs${XYZ}$_vf_l(-1, k, r, sys_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & + & sys_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 @@ -885,8 +885,8 @@ contains & chemxb + i - 1) + ds(0)*(drho_dt*Ys(i) + rho*dYs_dt(i)) end do else - 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 & + flux_rs${XYZ}$_vf_l(-1, k, r, sys_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & + & sys_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 @@ -901,12 +901,12 @@ contains 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 - eqn_idx%E)) + & i) + ds(0)*dadv_dt(i - sys_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 - eqn_idx%E) + flux_rs${XYZ}$_vf_l(-1, k, r, i) = flux_rs${XYZ}$_vf_l(0, k, r, i) + ds(0)*dadv_dt(i - sys_idx%E) end do $:GPU_LOOP(parallelism='[seq]') diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 713f20d2d8..e592db7c24 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -100,7 +100,7 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = eqn_idx%E, advxe - 1 + do i = sys_idx%E, advxe - 1 L(i) = lambda_factor*lambda2*dadv_ds(i - momxe) end do diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 624ae9fc9d..cdea3dda63 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -414,7 +414,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 >= sys_idx%adv%beg) .and. (i <= sys_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 +532,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 >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & + & .and. (i <= sys_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 +627,8 @@ 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 >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & + & .and. (i <= sys_idx%adv%end)) .or. ((i >= chemxb) .and. (i <= chemxe))) 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) @@ -1062,43 +1062,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(sys_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(sys_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(eqn_idx%alf)%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(sys_idx%alf)%sf(j - 2, k, l), dyn_p, & + & pi_inf, gamma, rho, qv, rhoYks(:), pres, T, & + & q_cons_vf(sys_idx%stress%beg)%sf(j - 2, k, l), & + & q_cons_vf(sys_idx%mom%beg)%sf(j - 2, k, l), G_local) else - 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), & + call s_compute_pressure(q_cons_vf(sys_idx%E)%sf(j - 2, k, l), q_cons_vf(sys_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(sys_idx%stress%end)%sf(j - 2, k, l)/rho end if if (bubbles_euler) then - alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l) + alf = q_cons_vf(sys_idx%alf)%sf(j - 2, k, l) if (num_fluids == 3) then - alfgr = q_cons_vf(eqn_idx%alf - 1)%sf(j - 2, k, l) + alfgr = q_cons_vf(sys_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(sys_idx%bub%rs(s))%sf(j - 2, k, l) + nRdot(s) = q_cons_vf(sys_idx%bub%vs(s))%sf(j - 2, k, l) end do if (adv_n) then - nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k, l) + nbub = q_cons_vf(sys_idx%n)%sf(j - 2, k, l) else nR3 = 0._wp do s = 1, nb @@ -1111,11 +1112,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(sys_idx%bub%moms(1, 1))%sf(j - 2, k, l)/nbub + M10 = q_cons_vf(sys_idx%bub%moms(1, 2))%sf(j - 2, k, l)/nbub + M01 = q_cons_vf(sys_idx%bub%moms(1, 3))%sf(j - 2, k, l)/nbub + M20 = q_cons_vf(sys_idx%bub%moms(1, 4))%sf(j - 2, k, l)/nbub + M02 = q_cons_vf(sys_idx%bub%moms(1, 6))%sf(j - 2, k, l)/nbub M10 = M10/M00 M01 = M01/M00 @@ -1165,23 +1166,23 @@ 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(sys_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(sys_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(eqn_idx%alf)%sf(j - 2, k - 2, l), & + call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l), q_cons_vf(sys_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(sys_idx%stress%beg)%sf(j - 2, k - 2, l), & + & q_cons_vf(sys_idx%mom%beg)%sf(j - 2, k - 2, l), G_local) else - 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, & + call s_compute_pressure(q_cons_vf(sys_idx%E)%sf(j - 2, k - 2, l), q_cons_vf(sys_idx%alf)%sf(j - 2, & & k - 2, l), dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T) end if @@ -1194,14 +1195,14 @@ contains end if if (bubbles_euler) then - alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l) + alf = q_cons_vf(sys_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(sys_idx%bub%rs(s))%sf(j - 2, k - 2, l) + nRdot(s) = q_cons_vf(sys_idx%bub%vs(s))%sf(j - 2, k - 2, l) end do if (adv_n) then - nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k - 2, l) + nbub = q_cons_vf(sys_idx%n)%sf(j - 2, k - 2, l) else nR3 = 0._wp do s = 1, nb @@ -1246,7 +1247,7 @@ 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(sys_idx%cont%end + s)%sf(j - 2, k - 2, l - 2)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) @@ -1259,17 +1260,17 @@ contains 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(sys_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(eqn_idx%alf)%sf(j - 2, & + call s_compute_pressure(q_cons_vf(1)%sf(j - 2, k - 2, l - 2), q_cons_vf(sys_idx%alf)%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) + & q_cons_vf(sys_idx%stress%beg)%sf(j - 2, k - 2, l - 2), & + & q_cons_vf(sys_idx%mom%beg)%sf(j - 2, k - 2, l - 2), G_local) else - 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, & + call s_compute_pressure(q_cons_vf(sys_idx%E)%sf(j - 2, k - 2, l - 2), & + & q_cons_vf(sys_idx%alf)%sf(j - 2, k - 2, l - 2), dyn_p, pi_inf, gamma, & & rho, qv, rhoYks, pres, T) end if @@ -1390,11 +1391,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(sys_idx%cont%end + s)%sf(j, k, l)/rho end do - pres = ((q_cons_vf(eqn_idx%E)%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(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma + pres = ((q_cons_vf(sys_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(sys_idx%mom%beg)%sf(j, k, & + & l)**2._wp)/rho)/(1._wp - q_cons_vf(sys_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma int_pres = int_pres + (pres - 1._wp)**2._wp end if end do @@ -1453,11 +1454,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(sys_idx%cont%end + s)%sf(j, k, l)/rho end do - pres = ((q_cons_vf(eqn_idx%E)%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(eqn_idx%alf)%sf(j, k, l)) - pi_inf - qv)/gamma + pres = ((q_cons_vf(sys_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(sys_idx%mom%beg)%sf(j, k, & + & l)**2._wp)/rho)/(1._wp - q_cons_vf(sys_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_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index fdb15df790..91fd09dd53 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -249,25 +249,12 @@ 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. - type(eqn_idx_info) :: eqn_idx !< Scalar equation indices (E, n, alf, gamma, pi_inf, c) - 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. - 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 :: 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + 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, eqn_idx, bub_idx]') - $:GPU_DECLARE(create='[B_idx, stress_idx, xi_idx, b_size]') - $:GPU_DECLARE(create='[tensor_size, species_idx]') + $:GPU_DECLARE(create='[sys_size, sys_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) @@ -866,83 +853,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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg + 1 - eqn_idx%gamma = adv_idx%beg - eqn_idx%pi_inf = adv_idx%end - sys_size = adv_idx%end + sys_idx%cont%beg = 1 + sys_idx%cont%end = sys_idx%cont%beg + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg + 1 + sys_idx%gamma = sys_idx%adv%beg + sys_idx%pi_inf = sys_idx%adv%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_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 = eqn_idx%E + 1 ! Alpha for fluid 1 - adv_idx%end = eqn_idx%E + num_fluids - 1 + sys_idx%adv%beg = sys_idx%E + 1 ! Alpha for fluid 1 + sys_idx%adv%end = sys_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 = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids + ! tracks a total of (N) volume fractions for N fluids, hence the lack of "-1" in sys_idx%adv%end + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids end if - sys_size = adv_idx%end + sys_size = sys_idx%adv%end if (bubbles_euler) then - eqn_idx%alf = adv_idx%end + sys_idx%alf = sys_idx%adv%end else - eqn_idx%alf = 1 + sys_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + sys_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 + sys_idx%bub%end = sys_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + sys_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end if (adv_n) then - eqn_idx%n = bub_idx%end + 1 - sys_size = eqn_idx%n + sys_idx%n = sys_idx%bub%end + 1 + sys_size = sys_idx%n end if - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + @:ALLOCATE(sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) gam = bub_pp%gam_g if (qbmm) then - @:ALLOCATE(bub_idx%moms(nb, nmom)) + @:ALLOCATE(sys_idx%bub%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - bub_idx%moms(i, j) = bub_idx%beg + (j - 1) + (i - 1)*nmom + sys_idx%bub%moms(i, j) = sys_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) + sys_idx%bub%rs(i) = sys_idx%bub%moms(i, 2) + sys_idx%bub%vs(i) = sys_idx%bub%moms(i, 3) end do else do i = 1, nb @@ -952,59 +939,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do end if end if if (mhd) then - B_idx%beg = sys_size + 1 + sys_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + sys_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + sys_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = eqn_idx%E + num_fluids - eqn_idx%alf = adv_idx%end - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + sys_idx%cont%beg = 1 + sys_idx%cont%end = num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%E + num_fluids + sys_idx%alf = sys_idx%adv%end + sys_idx%int_en%beg = sys_idx%adv%end + 1 + sys_idx%int_en%end = sys_idx%adv%end + num_fluids + sys_size = sys_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 - eqn_idx%E = mom_idx%end + 1 ! one energy equation - adv_idx%beg = eqn_idx%E + 1 - adv_idx%end = adv_idx%beg ! one volume advection equation - eqn_idx%alf = adv_idx%end - sys_size = adv_idx%end + sys_idx%cont%beg = 1 ! one continuity equation + sys_idx%cont%end = 1 ! num_fluids + sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each direction + sys_idx%mom%end = sys_idx%cont%end + num_vels + sys_idx%E = sys_idx%mom%end + 1 ! one energy equation + sys_idx%adv%beg = sys_idx%E + 1 + sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation + sys_idx%alf = sys_idx%adv%end + sys_size = sys_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + sys_idx%bub%beg = sys_size + 1 + sys_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + sys_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = sys_idx%bub%end - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) + @:ALLOCATE(sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) do i = 1, nb if (polytropic) then @@ -1013,12 +1000,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 + sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac + sys_idx%bub%vs(i) = sys_idx%bub%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 + sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 + sys_idx%bub%ms(i) = sys_idx%bub%ps(i) + 1 end if end do end if @@ -1061,24 +1048,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 + sys_idx%stress%beg = sys_size + 1 + sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) sys_idx%stress%end = sys_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 = sys_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) = sys_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) = sys_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/)) @@ -1093,34 +1080,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 + sys_idx%xi%beg = sys_size + 1 + sys_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 = sys_idx%xi%end + 1 end if if (surface_tension) then - eqn_idx%c = sys_size + 1 - sys_size = eqn_idx%c + sys_idx%c = sys_size + 1 + sys_size = sys_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + sys_idx%damage = sys_size + 1 + sys_size = sys_idx%damage end if if (hyper_cleaning) then - psi_idx = sys_size + 1 - sys_size = psi_idx + sys_idx%psi = sys_size + 1 + sys_size = sys_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 + sys_idx%species%beg = sys_size + 1 + sys_idx%species%end = sys_size + num_species + sys_size = sys_idx%species%end end if if (bubbles_euler .and. qbmm .and. .not. polytropic) then @@ -1195,34 +1182,33 @@ 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 + momxb = sys_idx%mom%beg + momxe = sys_idx%mom%end + advxb = sys_idx%adv%beg + advxe = sys_idx%adv%end + contxb = sys_idx%cont%beg + contxe = sys_idx%cont%end + bubxb = sys_idx%bub%beg + bubxe = sys_idx%bub%end + strxb = sys_idx%stress%beg + strxe = sys_idx%stress%end + intxb = sys_idx%int_en%beg + intxe = sys_idx%int_en%end + xibeg = sys_idx%xi%beg + xiend = sys_idx%xi%end + chemxb = sys_idx%species%beg + chemxe = sys_idx%species%end $:GPU_UPDATE(device='[momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, & - & eqn_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') + & sys_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') $:GPU_UPDATE(device='[b_size, xibeg, xiend, tensor_size]') - $:GPU_UPDATE(device='[species_idx]') $: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, eqn_idx, stress_idx, mpp_lim, bubbles_euler, hypoelasticity, & + $:GPU_UPDATE(device='[dt, sys_size, buff_size, pref, rhoref, sys_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]') + & hyperelasticity, hyper_model, elasticity, low_Mach]') $:GPU_UPDATE(device='[Bx0]') diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e8793517a9..b04168a6da 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -173,7 +173,7 @@ 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(eqn_idx%E)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, & + q_prim_vf(sys_idx%E)%sf(j, k, l) = q_prim_vf(sys_idx%E)%sf(j, k, & & l) - G_local*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field $:GPU_LOOP(parallelism='[seq]') diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index d38741934e..2b8668c576 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -192,7 +192,7 @@ contains 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(sys_idx%damage)%sf(k, l, q)), 0._wp) rho_K_field(k, l, q) = rho_K G_K_field(k, l, q) = G_K @@ -360,7 +360,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(sys_idx%damage)%sf(k, l, q) = (alpha_bar*max(abs(real(q_cons_vf(sys_idx%stress%beg)%sf(k, l, q), & & kind=wp)) - tau_star, 0._wp))**cont_damage_s end do $:END_GPU_PARALLEL_LOOP() @@ -370,11 +370,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(sys_idx%stress%beg)%sf(k, l, q) + q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, & + & q)) + sqrt((q_cons_vf(sys_idx%stress%beg)%sf(k, l, & + & q) - q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, & + & q))**2.0_wp + 4._wp*q_cons_vf(sys_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(sys_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 +385,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(sys_idx%stress%beg)%sf(k, l, q) + tau_xy = q_cons_vf(sys_idx%stress%beg + 1)%sf(k, l, q) + tau_yy = q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, q) + tau_xz = q_cons_vf(sys_idx%stress%beg + 3)%sf(k, l, q) + tau_yz = q_cons_vf(sys_idx%stress%beg + 4)%sf(k, l, q) + tau_zz = q_cons_vf(sys_idx%stress%beg + 5)%sf(k, l, q) ! Invariants of the stress tensor I1 = tau_xx + tau_yy + tau_zz @@ -411,7 +412,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(sys_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 9e942cff5b..e899e7a2b1 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,13 +165,13 @@ contains ! set the Moving IBM interior conservative variables - $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[eqn_idx%E, momxb]', collapse=3) + $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[sys_idx%E, momxb]', 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(eqn_idx%E)%sf(j, k, l) = 1._wp + q_prim_vf(sys_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) @@ -230,18 +230,18 @@ contains end do if (surface_tension) then - q_prim_vf(eqn_idx%c)%sf(j, k, l) = c_IP + q_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l) = pres_IP + q_prim_vf(sys_idx%E)%sf(j, k, l) = pres_IP else - q_prim_vf(eqn_idx%E)%sf(j, k, l) = 0._wp + q_prim_vf(sys_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(eqn_idx%E)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, & + q_prim_vf(sys_idx%E)%sf(j, k, l) = q_prim_vf(sys_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 @@ -310,14 +310,14 @@ contains ! Set color function if (surface_tension) then - q_cons_vf(eqn_idx%c)%sf(j, k, l) = c_IP + q_cons_vf(sys_idx%c)%sf(j, k, l) = c_IP end if ! Set Energy if (bubbles_euler) then - q_cons_vf(eqn_idx%E)%sf(j, k, l) = (1 - alpha_IP(1))*(gamma*pres_IP + pi_inf + dyn_pres) + q_cons_vf(sys_idx%E)%sf(j, k, l) = (1 - alpha_IP(1))*(gamma*pres_IP + pi_inf + dyn_pres) else - q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*pres_IP + pi_inf + dyn_pres + q_cons_vf(sys_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 @@ -779,7 +779,7 @@ 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(eqn_idx%E)%sf(i, j, k) + pres_IP = pres_IP + coeff*q_prim_vf(sys_idx%E)%sf(i, j, k) $:GPU_LOOP(parallelism='[seq]') do q = momxb, momxe @@ -793,7 +793,7 @@ contains end do if (surface_tension) then - c_IP = c_IP + coeff*q_prim_vf(eqn_idx%c)%sf(i, j, k) + c_IP = c_IP + coeff*q_prim_vf(sys_idx%c)%sf(i, j, k) end if if (bubbles_euler .and. .not. qbmm) then @@ -936,17 +936,17 @@ 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(eqn_idx%E + fluid_idx)%sf(i & - & + 1, j, k) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i - 1, j, & + local_force_contribution(1) = local_force_contribution(1) - (q_prim_vf(sys_idx%E + fluid_idx)%sf(i & + & + 1, j, k) - q_prim_vf(sys_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(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) + local_force_contribution(2) = local_force_contribution(2) - (q_prim_vf(sys_idx%E + fluid_idx)%sf(i, & + & j + 1, k) - q_prim_vf(sys_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(eqn_idx%E + fluid_idx) & - & %sf(i, j, k + 1) - q_prim_vf(eqn_idx%E + fluid_idx)%sf(i, j, & + local_force_contribution(3) = local_force_contribution(3) - (q_prim_vf(sys_idx%E + fluid_idx) & + & %sf(i, j, k + 1) - q_prim_vf(sys_idx%E + fluid_idx)%sf(i, j, & & k - 1))/(2._wp*dz) cell_volume = abs(cell_volume*dz) end if diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index 130c98a0d6..b21aeb84a8 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -372,12 +372,12 @@ contains rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) #:endfor end do @@ -527,7 +527,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(eqn_idx%E + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(sys_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -549,7 +549,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(eqn_idx%E + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(sys_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -605,56 +605,56 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 +662,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%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(eqn_idx%E)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(sys_idx%E)%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, & @@ -721,7 +721,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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) @@ -736,7 +736,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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) @@ -789,7 +789,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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) @@ -804,7 +804,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 @@ -964,7 +964,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(eqn_idx%E + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(sys_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -986,7 +986,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(eqn_idx%E + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(sys_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -1043,84 +1043,84 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 +1128,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%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(eqn_idx%E)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(sys_idx%E)%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, & @@ -1193,7 +1193,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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) @@ -1213,7 +1213,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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) @@ -1271,7 +1271,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%sf(j + 1, k, & + rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%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) @@ -1291,7 +1291,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 @@ -1397,7 +1397,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(eqn_idx%E + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(sys_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1419,7 +1419,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(eqn_idx%E + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(sys_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1476,56 +1476,56 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 +1534,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%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(eqn_idx%E)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(sys_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -1596,7 +1596,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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) @@ -1611,7 +1611,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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) @@ -1660,7 +1660,7 @@ contains & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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') @@ -1672,7 +1672,7 @@ contains & 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 @@ -1806,7 +1806,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(eqn_idx%E + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(sys_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1828,7 +1828,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(eqn_idx%E + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(sys_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1885,84 +1885,84 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 +1971,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%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(eqn_idx%E)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(sys_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -2038,7 +2038,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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) @@ -2058,7 +2058,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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) @@ -2116,7 +2116,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%sf(j, k + 1, & + rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%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) @@ -2136,7 +2136,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 @@ -2271,7 +2271,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(eqn_idx%E + i)%sf(j, k, l + q) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(sys_idx%E + i)%sf(j, k, l + q) end do else alpha_L(1) = 1._wp @@ -2293,7 +2293,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(eqn_idx%E + i)%sf(j, k, l + q) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(sys_idx%E + i)%sf(j, k, l + q) end do else alpha_R(1) = 1._wp @@ -2350,84 +2350,84 @@ contains rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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, & & 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 +2436,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%sf(j, k, l + q) + E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%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(eqn_idx%E)%sf(j, k, l + q) + E_R = E_R + coeff_R(q)*q_cons_vf(sys_idx%E)%sf(j, k, l + q) F_R = F_R + coeff_R(q)*jac(j, k, l + q) end do @@ -2503,7 +2503,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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) @@ -2523,7 +2523,7 @@ contains & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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) @@ -2581,7 +2581,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%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) @@ -2601,7 +2601,7 @@ contains & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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_pressure_relaxation.fpp b/src/simulation/m_pressure_relaxation.fpp index e30032717e..47d0aeed13 100644 --- a/src/simulation/m_pressure_relaxation.fpp +++ b/src/simulation/m_pressure_relaxation.fpp @@ -225,7 +225,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(eqn_idx%E + i)%sf(j, k, l) + alpha(i) = q_cons_vf(sys_idx%E + i)%sf(j, k, l) end do ! Compute mixture properties (combined bubble and standard logic) @@ -293,7 +293,7 @@ contains 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(eqn_idx%E)%sf(j, k, l) - dyn_pres - pi_inf)/gamma + pres_relax = (q_cons_vf(sys_idx%E)%sf(j, k, l) - dyn_pres - pi_inf)/gamma $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index ce6094d1c3..12e09fd0a3 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) = sys_idx%bub%moms(i, j) end do end do $:GPU_UPDATE(device='[bubmoms]') @@ -559,7 +559,7 @@ contains do l = 0, p do q = 0, n do i = 0, m - 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) + rhs_vf(sys_idx%alf)%sf(i, q, l) = rhs_vf(sys_idx%alf)%sf(i, q, l) + mom_sp(2)%sf(i, q, l) j = bubxb $:GPU_LOOP(parallelism='[seq]') do k = 1, nb @@ -764,8 +764,8 @@ 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(eqn_idx%alf)%sf(id1, id2, id3) - pres = q_prim_vf(eqn_idx%E)%sf(id1, id2, id3) + alf = q_prim_vf(sys_idx%alf)%sf(id1, id2, id3) + pres = q_prim_vf(sys_idx%E)%sf(id1, id2, id3) rho = q_prim_vf(contxb)%sf(id1, id2, id3) if (bubble_model == 2) then diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 2f6adf73c5..4212c34f56 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -127,7 +127,7 @@ 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, eqn_idx%E + do l = sys_idx%mom%beg, sys_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 @@ -136,12 +136,12 @@ contains 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 = sys_idx%adv%end + 1, sys_size - 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 = sys_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 +150,7 @@ contains if (.not. igr) then @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - do l = 1, cont_idx%end + do l = 1, sys_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 +162,7 @@ contains end if end do - do l = adv_idx%beg, adv_idx%end + do l = sys_idx%adv%beg, sys_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 +170,15 @@ contains end if if (surface_tension) then - 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]') + q_prim_qp%vf(sys_idx%c)%sf => q_cons_qp%vf(sys_idx%c)%sf + $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(sys_idx%c)%sf]') + $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(sys_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(sys_idx%psi)%sf => q_cons_qp%vf(sys_idx%psi)%sf + $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(sys_idx%psi)%sf]') + $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(sys_idx%psi)%sf]') end if if (.not. igr) then @@ -200,17 +200,17 @@ contains end do if (viscous .or. surface_tension) then - do l = mom_idx%beg, eqn_idx%E + do l = sys_idx%mom%beg, sys_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(sys_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 = sys_idx%adv%beg + 1, sys_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 @@ -222,7 +222,7 @@ contains & idwbuff(3)%beg:idwbuff(3)%end)) end do if (chem_params%diffusion .and. .not. viscous) then - @:ALLOCATE(flux_src_n(i)%vf(eqn_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + @:ALLOCATE(flux_src_n(i)%vf(sys_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 @@ -238,8 +238,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 = sys_idx%adv%beg + 1, sys_idx%adv%end + flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(sys_idx%adv%beg)%sf $:GPU_ENTER_DATA(attach='[flux_src_n(i)%vf(l)%sf]') end do end if @@ -272,7 +272,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 = sys_idx%mom%beg, sys_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, & @@ -335,19 +335,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(sys_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(sys_idx%cont%end + i)) end do - @:ALLOCATE(tau_Re_vf(eqn_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(tau_Re_vf(sys_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(eqn_idx%E)) + @:ACC_SETUP_SFs(tau_Re_vf(sys_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 = sys_idx%mom%beg, sys_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 +355,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dx_qp(1)) if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 +363,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dy_qp(1)) if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 +381,7 @@ contains end do do i = 1, num_dims - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 +389,7 @@ contains end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 +398,7 @@ contains end if if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 +412,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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_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, sys_idx%mom%beg:sys_idx%mom%end)) end if end if ! end allocation for weno_Re_flux else @@ -565,7 +565,7 @@ contains $: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(eqn_idx%alf)%sf(j, k, l))/alf_sum%sf(j, k, l) + & l)*(1._wp - q_cons_qp%vf(sys_idx%alf)%sf(j, k, l))/alf_sum%sf(j, k, l) end do end do end do @@ -663,21 +663,21 @@ contains 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 = eqn_idx%E; iv%end = sys_size + iv%beg = sys_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 = eqn_idx%E - 1 + iv%beg = 1; iv%end = sys_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 = 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, & + iv%beg = sys_idx%E; iv%end = sys_idx%E + call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(sys_idx%E), qL_rsx_vf, qL_rsy_vf, & & qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = eqn_idx%E + 1; iv%end = sys_size + iv%beg = sys_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 @@ -685,11 +685,11 @@ contains 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 = 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, & + iv%beg = sys_idx%E; iv%end = sys_idx%E + call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(sys_idx%E), qL_rsx_vf, qL_rsy_vf, & & qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, id) - iv%beg = eqn_idx%E + 1; iv%end = sys_size + iv%beg = sys_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 @@ -779,8 +779,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(sys_idx%psi)%sf(j, k, l) = rhs_vf(sys_idx%psi)%sf(j, k, l) - q_prim_vf(sys_idx%psi)%sf(j, & + & k, l)/hyper_cleaning_tau end do end do end do @@ -892,14 +892,14 @@ 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(eqn_idx%E)%sf(k_loop, l_loop, & + blkmod1(k_loop, l_loop, q_loop) = ((gammas(1) + 1._wp)*q_prim_vf%vf(sys_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(eqn_idx%E)%sf(k_loop, l_loop, & + blkmod2(k_loop, l_loop, q_loop) = ((gammas(2) + 1._wp)*q_prim_vf%vf(sys_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) if (bubbles_euler) then - alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(eqn_idx%alf - 1)%sf(k_loop, l_loop, q_loop) + alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(sys_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) end if @@ -947,7 +947,7 @@ contains 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(eqn_idx%E)%sf(k_loop, l_loop, q_loop) + pressure_val = q_prim_vf%vf(sys_idx%E)%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, & @@ -993,7 +993,7 @@ contains 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(eqn_idx%E)%sf(q, k, l) + pressure_val = q_prim_vf%vf(sys_idx%E)%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, & @@ -1089,7 +1089,7 @@ contains 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(eqn_idx%E)%sf(l, q, k) + pressure_val = q_prim_vf%vf(sys_idx%E)%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, & @@ -1362,8 +1362,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - 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(advxb)%sf(j, k, & + rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & + & l) + 1._wp/dx(j)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j - 1, k, l)) end do end do @@ -1378,7 +1378,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1392,9 +1392,9 @@ contains end do if (.not. viscous) then - 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)) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + & l) + 1._wp/dx(j)*(flux_src_n_in(sys_idx%E)%sf(j - 1, k, & + & l) - flux_src_n_in(sys_idx%E)%sf(j, k, l)) end if end if end do @@ -1408,8 +1408,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - 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(advxb)%sf(j, k, & + rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & + & l) + 1._wp/dy(k)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j, k - 1, l)) end do end do @@ -1420,20 +1420,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(sys_idx%mom%beg:sys_idx%mom%end), dq_prim_dy_vf(sys_idx%mom%beg:sys_idx%mom%end), & + & dq_prim_dz_vf(sys_idx%mom%beg:sys_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(sys_idx%mom%beg:sys_idx%mom%end), dq_prim_dy_vf(sys_idx%mom%beg:sys_idx%mom%end), & + & dq_prim_dz_vf(sys_idx%mom%beg:sys_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, eqn_idx%E + do i = momxb, sys_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 @@ -1447,7 +1447,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1463,7 +1463,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1476,9 +1476,9 @@ contains & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - 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)) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + & l) + 1._wp/dy(k)*(flux_src_n_in(sys_idx%E)%sf(j, k - 1, & + & l) - flux_src_n_in(sys_idx%E)%sf(j, k, l)) end if end if end do @@ -1496,7 +1496,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1510,7 +1510,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1523,7 +1523,7 @@ contains do k = 0, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1539,8 +1539,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - 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(advxb)%sf(j, k, & + rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & + & l) + 1._wp/dz(l)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j, k, l - 1)) end do end do @@ -1555,7 +1555,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + do i = momxb, sys_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 @@ -1568,9 +1568,9 @@ contains & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - 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)) + rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + & l) + 1._wp/dz(l)*(flux_src_n_in(sys_idx%E)%sf(j, k, & + & l - 1) - flux_src_n_in(sys_idx%E)%sf(j, k, l)) end if end if end do @@ -1726,7 +1726,7 @@ contains call s_finalize_pressure_relaxation_module if (.not. igr) then - do j = cont_idx%beg, cont_idx%end + do j = sys_idx%cont%beg, sys_idx%cont%end if (relativity) then ! Cons and Prim densities are different for relativity @:DEALLOCATE(q_cons_qp%vf(j)%sf) @@ -1736,11 +1736,11 @@ contains end if end do - do j = adv_idx%beg, adv_idx%end + do j = sys_idx%adv%beg, sys_idx%adv%end nullify (q_prim_qp%vf(j)%sf) end do - do j = mom_idx%beg, eqn_idx%E + do j = sys_idx%mom%beg, sys_idx%E @:DEALLOCATE(q_cons_qp%vf(j)%sf) @:DEALLOCATE(q_prim_qp%vf(j)%sf) end do @@ -1760,17 +1760,17 @@ contains end if if (viscous) then - do l = mom_idx%beg, mom_idx%end + do l = sys_idx%mom%beg, sys_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 = sys_idx%mom%beg, sys_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 = sys_idx%mom%beg, sys_idx%mom%end @:DEALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf) end do end if @@ -1781,20 +1781,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 = sys_idx%mom%beg, sys_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 = sys_idx%mom%beg, sys_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 = sys_idx%mom%beg, sys_idx%mom%end @:DEALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf) end do @@ -1822,9 +1822,9 @@ contains if (cyl_coord) then do i = 1, num_dims - @:DEALLOCATE(tau_re_vf(cont_idx%end + i)%sf) + @:DEALLOCATE(tau_re_vf(sys_idx%cont%end + i)%sf) end do - @:DEALLOCATE(tau_re_vf(eqn_idx%E)%sf) + @:DEALLOCATE(tau_re_vf(sys_idx%E)%sf) @:DEALLOCATE(tau_re_vf) end if end if @@ -1852,26 +1852,26 @@ contains end do if (viscous) then - do l = mom_idx%beg, eqn_idx%E + do l = sys_idx%mom%beg, sys_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(eqn_idx%E)%sf) + @:DEALLOCATE(flux_src_n(i)%vf(sys_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 = sys_idx%adv%beg + 1, sys_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 = sys_idx%adv%beg + 1, sys_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(sys_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 73821e2c2f..592341be67 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -250,28 +250,28 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, sys_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, sys_idx%B%beg) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 2) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 2) end if end if @@ -446,8 +446,8 @@ 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, sys_idx%damage)), 0._wp) + G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 0._wp) end if $:GPU_LOOP(parallelism='[seq]') @@ -642,7 +642,7 @@ 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, & - & eqn_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & sys_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 & @@ -651,12 +651,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, & - & eqn_idx%E) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & + & sys_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, & - & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & + & sys_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,12 +667,12 @@ 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, & - & eqn_idx%E) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & + & sys_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, & - & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & sys_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 @@ -723,7 +723,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) & + & sys_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,24 +734,26 @@ 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) & + & sys_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, sys_idx%B%beg + norm_dir - 1) = flux_rs${XYZ}$_vf(j, k, l, & + & sys_idx%B%beg + norm_dir - 1) + (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, sys_idx%psi) - s_P*qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_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) & + & sys_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) + & sys_idx%psi) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & sys_idx%psi)))/(s_M - s_P) else flux_rs${XYZ}$_vf(j, k, l, & - & B_idx%beg + norm_dir - 1) & + & sys_idx%B%beg + norm_dir - 1) & & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero end if end if @@ -762,7 +764,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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 @@ -930,28 +932,28 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, sys_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, sys_idx%B%beg) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 2) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 2) end if end if @@ -1124,8 +1126,8 @@ 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, sys_idx%damage)), 0._wp) + G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 0._wp) end if do i = 1, strxe - strxb + 1 @@ -1257,7 +1259,7 @@ 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, & - & eqn_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & sys_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 & @@ -1266,12 +1268,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, & - & eqn_idx%E) = (s_M*(cm%R(norm_dir) - Ga%R*alpha_rho_R(1)*vel_R(norm_dir)) & + & sys_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, & - & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & + & sys_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,12 +1284,12 @@ 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, & - & eqn_idx%E) = (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) - flux_tau_R) & + & sys_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, & - & eqn_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & sys_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 @@ -1338,7 +1340,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) & + & sys_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,10 +1351,10 @@ 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) + & sys_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 @@ -1362,7 +1364,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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 @@ -1407,8 +1409,8 @@ 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, eqn_idx%E + i) - alpha_R(i) = qR_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) + alpha_L(i) = qL_prim_rsx_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rsx_vf(j + 1, k, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') @@ -1419,8 +1421,8 @@ contains 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, eqn_idx%E + i) - alpha_R(i) = qR_prim_rsy_vf(k + 1, j, l, eqn_idx%E + i) + alpha_L(i) = qL_prim_rsy_vf(k, j, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rsy_vf(k + 1, j, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims @@ -1430,8 +1432,8 @@ contains else $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rsz_vf(l, k, j, sys_idx%E + i) + alpha_R(i) = qR_prim_rsz_vf(l + 1, k, j, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') @@ -1484,34 +1486,34 @@ contains if (norm_dir == 1) then flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & & l) - (4._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & l) - (-2._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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)) @@ -1523,31 +1525,31 @@ contains #: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, & & l) - (-2._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & l) - (4._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2)) - flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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)) @@ -1558,29 +1560,29 @@ contains #: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, & & l) - (-2._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & l) - (-2._wp/3._wp)*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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & l) - (4._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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -1612,20 +1614,20 @@ contains 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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_L(1, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -1635,19 +1637,19 @@ contains #: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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -1656,17 +1658,17 @@ contains #: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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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, & & 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, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -1816,8 +1818,8 @@ contains vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) rho_L = 0._wp gamma_L = 0._wp @@ -1836,38 +1838,38 @@ 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, 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) + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & + & l, sys_idx%E + i)), 1._wp) + alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, 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) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = min(max(0._wp, & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)), 1._wp) + alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_idx%E + i)/max(alpha_L_sum, sgm_eps) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & sys_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, 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) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, 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) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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) @@ -1883,8 +1885,8 @@ 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, 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, & + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, sys_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) @@ -2071,7 +2073,7 @@ contains 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, eqn_idx%E) = (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, sys_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 @@ -2089,7 +2091,7 @@ 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, eqn_idx%E) = flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + flux_ene_e + flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) = flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) + flux_ene_e end if ! VOLUME FRACTION FLUX. @@ -2155,8 +2157,8 @@ contains ! COLOR FUNCTION FLUX if (surface_tension) then - 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 + flux_rs${XYZ}$_vf(j, k, l, sys_idx%c) = (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_idx%c) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%c))*s_S end if ! Geometrical source flux for cylindrical coordinates @@ -2164,7 +2166,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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]') @@ -2233,13 +2235,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, eqn_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') @@ -2255,8 +2257,8 @@ contains qv_R = qv_R + alpha_rho_R(i)*qvs(i) end do - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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 @@ -2344,10 +2346,10 @@ contains end do end if - flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction + do i = sys_idx%alf, sys_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)) @@ -2379,7 +2381,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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 @@ -2438,8 +2440,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do vel_L_rms = 0._wp; vel_R_rms = 0._wp @@ -2457,24 +2459,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, 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) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, 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) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, 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) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, 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) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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 @@ -2500,9 +2502,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, eqn_idx%E + Re_idx(i, & + Re_L(i) = (1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, & + Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + Re_idx(i, & & q)))/Res_gs(i, q) + Re_R(i) end do @@ -2512,8 +2514,8 @@ contains end if end if - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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 @@ -2537,8 +2539,8 @@ contains if (.not. qbmm) then if (adv_n) then - 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) + nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%n) + nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%n) else nbub_L = 0._wp nbub_R = 0._wp @@ -2548,9 +2550,9 @@ 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, eqn_idx%E + num_fluids)/nbub_L + nbub_L = (3._wp/(4._wp*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, sys_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 + & sys_idx%E + num_fluids)/nbub_R end if else ! nb stored in 0th moment of first R0 bin in variable conversion module @@ -2721,7 +2723,7 @@ contains ! 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, & - & eqn_idx%E) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & + & sys_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)) & @@ -2765,7 +2767,7 @@ contains if (adv_n) then flux_rs${XYZ}$_vf(j, k, l, & - & eqn_idx%n) = xi_M*nbub_L*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + & sys_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 @@ -2774,7 +2776,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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 @@ -2835,8 +2837,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') @@ -2847,42 +2849,42 @@ contains vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - 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) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, eqn_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & - & l, eqn_idx%E + i)), 1._wp) + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & + & l, sys_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, 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) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = min(max(0._wp, & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)), 1._wp) + alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 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) + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_idx%E + i)/max(alpha_L_sum, sgm_eps) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & sys_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, 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) + gamma_L = gamma_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i)*gammas(i) + pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_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, 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) + gamma_R = gamma_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)*gammas(i) + pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)*pi_infs(i) qv_R = qv_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*qvs(i) end do @@ -3137,7 +3139,7 @@ contains ! 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, & - & eqn_idx%E) = xi_M*(vel_L(dir_idx(1))*(E_L + pres_L) + s_M*(xi_L*(E_L + (s_S & + & sys_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)) & @@ -3159,7 +3161,7 @@ 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, eqn_idx%E) = flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + flux_ene_e + flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) = flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) + flux_ene_e end if ! HYPOELASTIC STRESS EVOLUTION FLUX. @@ -3192,10 +3194,10 @@ contains ! COLOR FUNCTION FLUX if (surface_tension) then - 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)) & + flux_rs${XYZ}$_vf(j, k, l, sys_idx%c) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_idx%c)*(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & eqn_idx%c)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + & sys_idx%c)*(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if ! Hyperelastic reference map flux for material deformation tracking @@ -3229,7 +3231,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, eqn_idx%E + do i = 1, sys_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 @@ -3378,27 +3380,28 @@ contains vel_rms%R = sum(vel%R**2._wp) do i = 1, num_fluids - 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) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) end do - 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) + pres%L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) + pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_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, sys_idx%B%beg), qL_prim_rs${XYZ}$_vf(j, k, l, & + & sys_idx%B%beg + 1)] + B%R = [Bx0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg), qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, sys_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, sys_idx%B%beg + dir_idx(1) - 1), qL_prim_rs${XYZ}$_vf(j, & + & k, l, sys_idx%B%beg + dir_idx(2) - 1), qL_prim_rs${XYZ}$_vf(j, & + & k, l, sys_idx%B%beg + dir_idx(3) - 1)] + B%R = [qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + dir_idx(1) - 1), & + & qR_prim_rs${XYZ}$_vf(j + 1, k, l, & + & sys_idx%B%beg + dir_idx(2) - 1), qR_prim_rs${XYZ}$_vf(j + 1, k, & + & l, sys_idx%B%beg + dir_idx(3) - 1)] end if end if @@ -3524,14 +3527,14 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 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, sys_idx%B%beg) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, sys_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, sys_idx%B%beg + dir_idx(2) - 1) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + dir_idx(3) - 1) = F_hlld(6) end if ! Energy - flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = F_hlld(7) + flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) = F_hlld(7) ! Volume fractions $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe @@ -3978,7 +3981,7 @@ contains if (norm_dir == 1) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + do i = momxb, sys_idx%E do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -3992,11 +3995,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, chemxe + do i = sys_idx%E, chemxe do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - if (i == eqn_idx%E .or. i >= chemxb) then + if (i == sys_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(j, k, l) = 0._wp end if end do @@ -4024,7 +4027,7 @@ contains else if (norm_dir == 2) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + do i = momxb, sys_idx%E do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4038,11 +4041,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, chemxe + do i = sys_idx%E, chemxe do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end - if (i == eqn_idx%E .or. i >= chemxb) then + if (i == sys_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(k, j, l) = 0._wp end if end do @@ -4070,7 +4073,7 @@ contains else if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + do i = momxb, sys_idx%E do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4084,11 +4087,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, chemxe + do i = sys_idx%E, chemxe do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end - if (i == eqn_idx%E .or. i >= chemxb) then + if (i == sys_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(l, k, j) = 0._wp end if end do @@ -4267,7 +4270,7 @@ contains 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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, & & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel) end do end if @@ -4277,7 +4280,7 @@ contains 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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, & & l) - vel_src_int(norm_dir)*stress_normal_bulk end if end do @@ -4387,7 +4390,7 @@ contains 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%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, & + flux_src_vf(sys_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(sys_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 @@ -4400,7 +4403,7 @@ contains 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%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, & + flux_src_vf(sys_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(sys_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 diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index e246238d4a..09fff2990e 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -121,10 +121,10 @@ contains end do if (igr) then - E = q_prim_vf(eqn_idx%E)%sf(j, k, l) + E = q_prim_vf(sys_idx%E)%sf(j, k, l) pres = (E - pi_inf - qv - 5.e-1_wp*rho*vel_sum)/gamma else - pres = q_prim_vf(eqn_idx%E)%sf(j, k, l) + pres = q_prim_vf(sys_idx%E)%sf(j, k, l) E = gamma*pres + pi_inf + 5.e-1_wp*rho*vel_sum + qv end if diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index cb957a72b7..7eb8c9c5ae 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 ! sys_idx%adv%end 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 ! sys_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -569,7 +569,7 @@ 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 = sys_idx%mom%beg, sys_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 @@ -581,14 +581,14 @@ contains 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(sys_idx%B%beg)%sf(j, k, l)**2 + v_vf(sys_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(sys_idx%B%beg)%sf(j, k, l)**2 + v_vf(sys_idx%B%beg + 1)%sf(j, k, & + & l)**2 + v_vf(sys_idx%B%beg + 2)%sf(j, k, l)**2) end if end if - call s_compute_pressure(v_vf(eqn_idx%E)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres, & + call s_compute_pressure(v_vf(sys_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 @@ -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. sys_idx%adv%end > 20 .and. (.not. chemistry), & + & "CBC module with AMD compiler requires sys_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, eqn_idx%n, pi_fac, low_Mach]') + & adap_dt_max_iters, sys_idx%n, pi_fac, low_Mach]') if (bubbles_euler) then $:GPU_UPDATE(device='[weight, R0]') @@ -1046,7 +1046,7 @@ contains end if end if - $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, eqn_idx%n, pi_fac, low_Mach]') + $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, sys_idx%n, pi_fac, low_Mach]') $:GPU_UPDATE(device='[acoustic_source, num_source]') $:GPU_UPDATE(device='[sigma, surface_tension]') diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 06bb5e06cf..08e217d4cb 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -115,12 +115,12 @@ contains 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%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(1, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -157,11 +157,11 @@ contains 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%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(2, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) + Omega(2, & & i)*vSrc_rsy_vf(k, j, l, i) end do - flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 @@ -199,11 +199,11 @@ contains 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%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) + Omega(3, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) + Omega(3, & & i)*vSrc_rsz_vf(l, k, j, i) end do - flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & + flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_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 +234,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(eqn_idx%c)%sf(j + 1, k, & - & l) - q_prim_vf(eqn_idx%c)%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(sys_idx%c)%sf(j + 1, k, & + & l) - q_prim_vf(sys_idx%c)%sf(j - 1, k, l)) end do end do end do @@ -245,8 +245,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(eqn_idx%c)%sf(j, k + 1, & - & l) - q_prim_vf(eqn_idx%c)%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(sys_idx%c)%sf(j, k + 1, & + & l) - q_prim_vf(sys_idx%c)%sf(j, k - 1, l)) end do end do end do @@ -257,8 +257,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(eqn_idx%c)%sf(j, k, & - & l + 1) - q_prim_vf(eqn_idx%c)%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(sys_idx%c)%sf(j, k, & + & l + 1) - q_prim_vf(sys_idx%c)%sf(j, k, l - 1)) end do end do end do diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 64410c6e6b..ea81d779e0 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, sys_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 = sys_idx%bub%beg, sys_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(eqn_idx%n)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(sys_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(eqn_idx%n)) + @:ACC_SETUP_SFs(q_prim_vf(sys_idx%n)) end if end if if (mhd) then - do i = B_idx%beg, B_idx%end + do i = sys_idx%B%beg, sys_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 = sys_idx%stress%beg, sys_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)) @@ -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(sys_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(sys_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(sys_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(sys_idx%psi)) end if if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end + do i = sys_idx%int_en%beg, sys_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,9 +287,9 @@ contains end if if (surface_tension) then - @:ALLOCATE(q_prim_vf(eqn_idx%c)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, & + @:ALLOCATE(q_prim_vf(sys_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(eqn_idx%c)) + @:ACC_SETUP_SFs(q_prim_vf(sys_idx%c)) end if if (chemistry) then @@ -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, eqn_idx%E + do i = momxb, sys_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -915,18 +915,18 @@ contains if (.not. igr) then ! Deallocating the cell-average primitive variables - do i = 1, adv_idx%end + do i = 1, sys_idx%adv%end @:DEALLOCATE(q_prim_vf(i)%sf) end do if (mhd) then - do i = B_idx%beg, B_idx%end + do i = sys_idx%B%beg, sys_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 = sys_idx%stress%beg, sys_idx%stress%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if @@ -938,21 +938,21 @@ contains end if if (cont_damage) then - @:DEALLOCATE(q_prim_vf(damage_idx)%sf) + @:DEALLOCATE(q_prim_vf(sys_idx%damage)%sf) end if if (hyper_cleaning) then - @:DEALLOCATE(q_prim_vf(psi_idx)%sf) + @:DEALLOCATE(q_prim_vf(sys_idx%psi)%sf) end if if (bubbles_euler) then - do i = bub_idx%beg, bub_idx%end + do i = sys_idx%bub%beg, sys_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 = sys_idx%int_en%beg, sys_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 a6375e8a3c..76a6342b89 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, eqn_idx%E + do i = momxb, sys_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(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(sys_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(sys_idx%E + i)%sf(j, k, l) end if end do @@ -172,7 +172,7 @@ contains 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%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & + tau_Re_vf(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & & k, l)*tau_Re(2, i) end do end do @@ -193,9 +193,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(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(sys_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(sys_idx%E + i)%sf(j, k, l) end if end do @@ -269,7 +269,7 @@ contains 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%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do @@ -290,9 +290,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(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(sys_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(sys_idx%E + i)%sf(j, k, l) end if end do @@ -370,7 +370,7 @@ contains 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%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & + tau_Re_vf(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & & k, l)*tau_Re(2, i) end do end do @@ -389,9 +389,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(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(sys_idx%E + i)%sf(j, k, l) else - alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(sys_idx%E + i)%sf(j, k, l) end if end do @@ -464,7 +464,7 @@ contains 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%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do @@ -494,7 +494,7 @@ contains integer :: i, j, k, l do i = 1, num_dims - iv%beg = mom_idx%beg; iv%end = mom_idx%end + iv%beg = sys_idx%mom%beg; iv%end = sys_idx%mom%end $:GPU_UPDATE(device='[iv]') @@ -521,7 +521,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 = sys_idx%mom%beg; iv%end = sys_idx%mom%end $:GPU_UPDATE(device='[iv]') is1_viscous = ix; is2_viscous = iy; is3_viscous = iz From a19cae2770f72628731f1e87ee492dad5d7273d0 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 20:08:55 -0400 Subject: [PATCH 05/17] refactor: rewrite indices.dat summary using sys_idx; add missing xi, B, color entries --- src/pre_process/m_data_output.fpp | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index df3fde329e..584b73be2d 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -639,14 +639,17 @@ contains end if write (iu, '(A)') "" - if (momxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') momxb, momxe, " Momentum" - if (sys_idx%E /= 0) write (iu, '("[",I2,",",I2,"]",A)') sys_idx%E, sys_idx%E, " Energy/Pressure" - if (advxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') advxb, advxe, " Advection" - if (contxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') contxb, contxe, " Continuity" - if (bubxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') bubxb, bubxe, " Bubbles_euler" - if (strxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') strxb, strxe, " Stress" - if (intxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') intxb, intxe, " Internal Energies" - if (chemxb /= 0) write (iu, '("[",I2,",",I2,"]",A)') chemxb, chemxe, " Chemistry" + call write_range(sys_idx%cont%beg, sys_idx%cont%end, " Continuity") + call write_range(sys_idx%mom%beg, sys_idx%mom%end, " Momentum") + call write_range(sys_idx%E, sys_idx%E, " Energy/Pressure") + call write_range(sys_idx%adv%beg, sys_idx%adv%end, " Advection") + call write_range(sys_idx%bub%beg, sys_idx%bub%end, " Bubbles") + call write_range(sys_idx%stress%beg, sys_idx%stress%end, " Stress") + call write_range(sys_idx%int_en%beg, sys_idx%int_en%end, " Internal Energies") + call write_range(sys_idx%xi%beg, sys_idx%xi%end, " Reference Map") + call write_range(sys_idx%B%beg, sys_idx%B%end, " Magnetic Field") + call write_range(sys_idx%c, sys_idx%c, " Color Function") + call write_range(sys_idx%species%beg, sys_idx%species%end, " Chemistry") close (iu) @@ -661,6 +664,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, '("[",I2,",",I2,"]",A)') beg, end, label + + end subroutine write_range + end subroutine s_initialize_data_output_module !> Resets s_write_data_files pointer From 4022b72686d6e173c9cfcc2736646358f46924ec Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 20:32:11 -0400 Subject: [PATCH 06/17] refactor: split qbmm_idx out of bub_bounds_info; sys_idx is now allocatable-free --- src/common/m_derived_types.fpp | 21 +++---- src/common/m_variables_conversion.fpp | 4 +- src/post_process/m_global_parameters.fpp | 37 +++++------ src/post_process/m_start_up.fpp | 8 +-- src/pre_process/m_assign_variables.fpp | 78 ++++++++++++------------ src/pre_process/m_data_output.fpp | 2 +- src/pre_process/m_global_parameters.fpp | 47 +++++++------- src/simulation/m_bubbles_EE.fpp | 8 +-- src/simulation/m_data_output.fpp | 18 +++--- src/simulation/m_global_parameters.fpp | 42 +++++++------ src/simulation/m_qbmm.fpp | 2 +- 11 files changed, 134 insertions(+), 133 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 197b5ef0d3..ff86514f89 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -113,25 +113,24 @@ module m_derived_types type(int_bounds_info) :: x, y, z end type bc_xyz_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 + !> QBMM moment index mappings - separate from bub beg/end so sys_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 !< Moment indices for qbmm - end type bub_bounds_info + 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 sys_idx_info type(int_bounds_info) :: cont !< Partial densities (continuity equations) type(int_bounds_info) :: mom !< Momentum components type(int_bounds_info) :: adv !< Volume fractions (advection equations) - type(bub_bounds_info) :: bub !< Bubble variables (Euler-Euler) + type(int_bounds_info) :: bub !< Bubble equation range (beg/end only) type(int_bounds_info) :: stress !< Stress tensor components type(int_bounds_info) :: xi !< Reference map equations type(int_bounds_info) :: B !< Magnetic field components diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c6e04d0c81..9ec4f4f59a 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -364,7 +364,7 @@ contains if (bubbles_euler) then @:ALLOCATE(bubrs_vc(1:nb)) do i = 1, nb - bubrs_vc(i) = sys_idx%bub%rs(i) + bubrs_vc(i) = qbmm_idx%rs(i) end do $:GPU_UPDATE(device='[bubrs_vc]') end if @@ -942,7 +942,7 @@ contains if (bubbles_euler) then ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3} do i = 1, nb - Rtmp(i) = q_prim_vf(sys_idx%bub%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 diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 11f4494440..316a2f19f5 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -112,8 +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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. - integer :: beta_idx !< Index of lagrange bubbles beta + type(sys_idx_info) :: sys_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". @@ -559,17 +560,17 @@ contains sys_size = sys_idx%n end if - allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) if (qbmm) then - allocate (sys_idx%bub%moms(nb, nmom)) + allocate (qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - sys_idx%bub%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - sys_idx%bub%rs(i) = sys_idx%bub%moms(i, 2) - sys_idx%bub%vs(i) = sys_idx%bub%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 @@ -579,12 +580,12 @@ contains fac = 2 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (polytropic .neqv. .true.) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 @@ -639,8 +640,8 @@ contains end if sys_size = sys_idx%bub%end - allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - allocate (sys_idx%bub%ps(nb), sys_idx%bub%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 @@ -650,12 +651,12 @@ contains fac = 2 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (polytropic .neqv. .true.) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index 57a44abae9..e12de3907d 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -694,7 +694,7 @@ contains if (bubbles_euler) then ! nR do i = 1, nb - q_sf(:,:,:) = q_cons_vf(sys_idx%bub%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(:) = ' ' @@ -702,7 +702,7 @@ contains ! nRdot do i = 1, nb - q_sf(:,:,:) = q_cons_vf(sys_idx%bub%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(:) = ' ' @@ -710,7 +710,7 @@ contains if ((polytropic .neqv. .true.) .and. (.not. qbmm)) then ! nP do i = 1, nb - q_sf(:,:,:) = q_cons_vf(sys_idx%bub%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(:) = ' ' @@ -718,7 +718,7 @@ contains ! nM do i = 1, nb - q_sf(:,:,:) = q_cons_vf(sys_idx%bub%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(:) = ' ' diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 2c646ef5c4..2964cea279 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -315,27 +315,26 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) then - q_prim_vf(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR - q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 - q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, & - & l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) - q_prim_vf(sys_idx%bub%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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR - q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) - q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV - q_prim_vf(sys_idx%bub%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(sys_idx%bub%rs(i))%sf(j, k, l) = muR - q_prim_vf(sys_idx%bub%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(sys_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 - q_prim_vf(sys_idx%bub%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 @@ -344,7 +343,7 @@ contains ! Initialize number density R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(sys_idx%bub%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(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if @@ -483,28 +482,27 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) then - q_prim_vf(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR - q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + (sigR*R0ref)**2 - q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, & - & l) = muR*muV + rhoRV*(sigR*R0ref)*(sigV*sqrt(p0ref/rho0ref)) - q_prim_vf(sys_idx%bub%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(sys_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(sys_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR - q_prim_vf(sys_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(sys_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) - q_prim_vf(sys_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV - q_prim_vf(sys_idx%bub%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(sys_idx%bub%rs(i))%sf(j, k, l) = muR - q_prim_vf(sys_idx%bub%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(sys_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 - q_prim_vf(sys_idx%bub%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 @@ -513,7 +511,7 @@ contains ! Initialize number density R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(sys_idx%bub%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(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if @@ -533,11 +531,11 @@ contains if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm)) then do i = 1, nb - if (f_is_default(real(q_prim_vf(sys_idx%bub%ps(i))%sf(j, k, l), kind=wp))) then - q_prim_vf(sys_idx%bub%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(sys_idx%bub%ms(i))%sf(j, k, l), kind=wp))) then - q_prim_vf(sys_idx%bub%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 diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index 584b73be2d..26c4df12db 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -213,7 +213,7 @@ contains nbub = q_cons_vf(sys_idx%n)%sf(j, 0, 0) else do k = 1, nb - nRtmp(k) = q_cons_vf(sys_idx%bub%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(sys_idx%alf)%sf(j, 0, 0), kind=wp), nRtmp, nbub, weight) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 3fce0b048f..7ddd7ed8c9 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -82,7 +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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + type(sys_idx_info) :: sys_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) @@ -610,24 +611,24 @@ contains sys_size = sys_idx%n end if - allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - allocate (sys_idx%bub%ps(nb), sys_idx%bub%ms(nb)) + allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) + allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) if (qbmm) then - allocate (sys_idx%bub%moms(nb, nmom)) - allocate (sys_idx%bub%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 - sys_idx%bub%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - sys_idx%bub%fullmom(i, 0, 0) = sys_idx%bub%moms(i, 1) - sys_idx%bub%fullmom(i, 1, 0) = sys_idx%bub%moms(i, 2) - sys_idx%bub%fullmom(i, 0, 1) = sys_idx%bub%moms(i, 3) - sys_idx%bub%fullmom(i, 2, 0) = sys_idx%bub%moms(i, 4) - sys_idx%bub%fullmom(i, 1, 1) = sys_idx%bub%moms(i, 5) - sys_idx%bub%fullmom(i, 0, 2) = sys_idx%bub%moms(i, 6) - sys_idx%bub%rs(i) = sys_idx%bub%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 @@ -637,12 +638,12 @@ contains fac = 2 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 @@ -692,8 +693,8 @@ contains end if sys_size = sys_idx%bub%end - allocate (sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - allocate (sys_idx%bub%ps(nb), sys_idx%bub%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 @@ -703,12 +704,12 @@ contains fac = 2 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp index 9c3976ae62..6062ae3b84 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) = sys_idx%bub%rs(l) - vs(l) = sys_idx%bub%vs(l) + rs(l) = qbmm_idx%rs(l) + vs(l) = qbmm_idx%vs(l) if (.not. polytropic) then - ps(l) = sys_idx%bub%ps(l) - ms(l) = sys_idx%bub%ms(l) + ps(l) = qbmm_idx%ps(l) + ms(l) = qbmm_idx%ms(l) else ps(l) = rs(l) ms(l) = rs(l) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index cdea3dda63..6bbc4ae8bc 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1094,8 +1094,8 @@ contains alfgr = q_cons_vf(sys_idx%alf - 1)%sf(j - 2, k, l) end if do s = 1, nb - nR(s) = q_cons_vf(sys_idx%bub%rs(s))%sf(j - 2, k, l) - nRdot(s) = q_cons_vf(sys_idx%bub%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 @@ -1112,11 +1112,11 @@ contains print *, 'In probe, nbub: ', nbub #endif if (qbmm) then - M00 = q_cons_vf(sys_idx%bub%moms(1, 1))%sf(j - 2, k, l)/nbub - M10 = q_cons_vf(sys_idx%bub%moms(1, 2))%sf(j - 2, k, l)/nbub - M01 = q_cons_vf(sys_idx%bub%moms(1, 3))%sf(j - 2, k, l)/nbub - M20 = q_cons_vf(sys_idx%bub%moms(1, 4))%sf(j - 2, k, l)/nbub - M02 = q_cons_vf(sys_idx%bub%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 @@ -1197,8 +1197,8 @@ contains if (bubbles_euler) then alf = q_cons_vf(sys_idx%alf)%sf(j - 2, k - 2, l) do s = 1, nb - nR(s) = q_cons_vf(sys_idx%bub%rs(s))%sf(j - 2, k - 2, l) - nRdot(s) = q_cons_vf(sys_idx%bub%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 diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 91fd09dd53..4317b1e474 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -249,12 +249,14 @@ 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. - 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 + integer :: sys_size !< Number of unknowns in system of eqns. + type(sys_idx_info) :: sys_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, sys_idx, b_size, tensor_size]') + $:GPU_DECLARE(create='[qbmm_idx]') ! 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) @@ -917,19 +919,19 @@ contains sys_size = sys_idx%n end if - @:ALLOCATE(sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - @:ALLOCATE(sys_idx%bub%ps(nb), sys_idx%bub%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(sys_idx%bub%moms(nb, nmom)) + @:ALLOCATE(qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - sys_idx%bub%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - sys_idx%bub%rs(i) = sys_idx%bub%moms(i, 2) - sys_idx%bub%vs(i) = sys_idx%bub%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 @@ -939,12 +941,12 @@ contains fac = 2 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 @@ -990,8 +992,8 @@ contains end if sys_size = sys_idx%bub%end - @:ALLOCATE(sys_idx%bub%rs(nb), sys_idx%bub%vs(nb)) - @:ALLOCATE(sys_idx%bub%ps(nb), sys_idx%bub%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 @@ -1000,12 +1002,12 @@ contains fac = 4 end if - sys_idx%bub%rs(i) = sys_idx%bub%beg + (i - 1)*fac - sys_idx%bub%vs(i) = sys_idx%bub%rs(i) + 1 + qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then - sys_idx%bub%ps(i) = sys_idx%bub%vs(i) + 1 - sys_idx%bub%ms(i) = sys_idx%bub%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 diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 12e09fd0a3..5c6f98bbfb 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) = sys_idx%bub%moms(i, j) + bubmoms(i, j) = qbmm_idx%moms(i, j) end do end do $:GPU_UPDATE(device='[bubmoms]') From 141226f738b59917224ca7f45d4bc903b99899af Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 20:41:21 -0400 Subject: [PATCH 07/17] refactor: rename sys_idx -> eqn_idx, sys_idx_info -> eqn_idx_info --- src/common/include/1dHardcodedIC.fpp | 6 +- src/common/include/2dHardcodedIC.fpp | 68 ++-- src/common/include/3dHardcodedIC.fpp | 12 +- src/common/m_boundary_common.fpp | 8 +- src/common/m_chemistry.fpp | 18 +- src/common/m_derived_types.fpp | 6 +- src/common/m_phase_change.fpp | 2 +- src/common/m_variables_conversion.fpp | 134 ++++---- src/post_process/m_data_output.fpp | 32 +- src/post_process/m_derived_variables.fpp | 76 ++--- src/post_process/m_global_parameters.fpp | 204 ++++++------ src/post_process/m_start_up.fpp | 56 ++-- src/pre_process/m_assign_variables.fpp | 124 +++---- src/pre_process/m_data_output.fpp | 72 ++--- src/pre_process/m_global_parameters.fpp | 194 +++++------ src/pre_process/m_icpp_patches.fpp | 14 +- src/pre_process/m_initial_condition.fpp | 8 +- src/pre_process/m_perturbation.fpp | 10 +- src/pre_process/m_start_up.fpp | 6 +- src/simulation/m_acoustic_src.fpp | 4 +- src/simulation/m_body_forces.fpp | 8 +- src/simulation/m_bubbles_EE.fpp | 12 +- src/simulation/m_bubbles_EL.fpp | 42 +-- src/simulation/m_cbc.fpp | 48 +-- src/simulation/m_compute_cbc.fpp | 2 +- src/simulation/m_data_output.fpp | 72 ++--- src/simulation/m_global_parameters.fpp | 198 ++++++------ src/simulation/m_hyperelastic.fpp | 2 +- src/simulation/m_hypoelastic.fpp | 28 +- src/simulation/m_ibm.fpp | 34 +- src/simulation/m_igr.fpp | 188 +++++------ src/simulation/m_pressure_relaxation.fpp | 4 +- src/simulation/m_qbmm.fpp | 6 +- src/simulation/m_rhs.fpp | 194 +++++------ src/simulation/m_riemann_solvers.fpp | 390 +++++++++++------------ src/simulation/m_sim_helpers.fpp | 4 +- src/simulation/m_start_up.fpp | 22 +- src/simulation/m_surface_tension.fpp | 24 +- src/simulation/m_time_steppers.fpp | 42 +-- src/simulation/m_viscous.fpp | 30 +- 40 files changed, 1202 insertions(+), 1202 deletions(-) diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index daec4129c1..c522b230f2 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -11,8 +11,8 @@ q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i)) ! magnetic field - q_prim_vf(sys_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) - q_prim_vf(sys_idx%B%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) @@ -33,7 +33,7 @@ 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(sys_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 + q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp diff --git a/src/common/include/2dHardcodedIC.fpp b/src/common/include/2dHardcodedIC.fpp index 5e60512a7c..5df3a9125f 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -25,7 +25,7 @@ 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(sys_idx%E)%sf(i, j, 0) = 1000._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 @@ -38,15 +38,15 @@ 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(sys_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + 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(sys_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(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(sys_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._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 @@ -59,18 +59,18 @@ 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(sys_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) + 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(sys_idx%E)%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%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(sys_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._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(sys_idx%E)%sf(i, j, 0)**(1._wp/gam) + q_prim_vf(contxb)%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 @@ -93,14 +93,14 @@ 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(sys_idx%E)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + 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 pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(sys_idx%E)%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 @@ -112,7 +112,7 @@ 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(sys_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%E)%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) end if @@ -126,7 +126,7 @@ 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(sys_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%E)%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) end if @@ -157,20 +157,20 @@ 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(sys_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) - q_prim_vf(sys_idx%B%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(sys_idx%E)%sf(i, j, 0) = 1.0 + 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(sys_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_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(sys_idx%E)%sf(i, j, 0) = 3.e-5_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 @@ -209,11 +209,11 @@ 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)) ! magnetic field - q_prim_vf(sys_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(sys_idx%B%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(sys_idx%E)%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(sys_idx%B%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(sys_idx%B%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp) - ! q_prim_vf(sys_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(sys_idx%B%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp) - ! q_prim_vf(sys_idx%E)%sf(i,j,0) = 6._wp - q_prim_vf(sys_idx%B%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) @@ -250,17 +250,17 @@ 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(sys_idx%E)%sf(i, j, 0) = 20._wp - q_prim_vf(sys_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA - q_prim_vf(sys_idx%B%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%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(sys_idx%E)%sf(i, j, 0) = 1._wp - q_prim_vf(sys_idx%B%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosA - (5._wp/sqrt(4._wp*pi))*sinA - q_prim_vf(sys_idx%B%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%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,7 +270,7 @@ ! 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(sys_idx%E)%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, & @@ -287,7 +287,7 @@ ! 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(sys_idx%E)%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, & & 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)) @@ -296,7 +296,7 @@ ! 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(sys_idx%E)%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, & & 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)) diff --git a/src/common/include/3dHardcodedIC.fpp b/src/common/include/3dHardcodedIC.fpp index e6d7497588..f96a130532 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -88,14 +88,14 @@ 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(sys_idx%E)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) + 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 pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) - q_prim_vf(sys_idx%E)%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 @@ -105,7 +105,7 @@ 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(sys_idx%E)%sf(i, j, k) = patch_icpp(1)%pres + q_prim_vf(eqn_idx%E)%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) end if @@ -138,7 +138,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) end if - q_prim_vf(sys_idx%E)%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) @@ -164,7 +164,7 @@ q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k)) end if - q_prim_vf(sys_idx%E)%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,7 +173,7 @@ ! geometry 9 Mach = 0.1 if (patch_id == 1) then - q_prim_vf(sys_idx%E)%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) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 0e94627ae2..6b58ca2c00 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -489,7 +489,7 @@ contains q_prim_vf(momxe)%sf(k, l, -j) = -q_prim_vf(momxe)%sf(k, l, j - 1) - do i = sys_idx%E, 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 @@ -523,7 +523,7 @@ contains q_prim_vf(momxe)%sf(k, l, p + j) = -q_prim_vf(momxe)%sf(k, l, p - (j - 1)) - do i = sys_idx%E, 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 @@ -695,7 +695,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l + ((p + 1)/2)) - do i = sys_idx%E, 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 @@ -707,7 +707,7 @@ contains q_prim_vf(momxe)%sf(k, -j, l) = -q_prim_vf(momxe)%sf(k, j - 1, l - ((p + 1)/2)) - do i = sys_idx%E, 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 diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index 1b84040193..b1b3e1ee89 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -67,8 +67,8 @@ contains Ys(eqn - chemxb + 1) = q_cons_vf(eqn)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) end do - ! e = E - 1/2*|u|^2 cons. sys_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i - energy = q_cons_vf(sys_idx%E)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) + ! e = E - 1/2*|u|^2 cons. eqn_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i + energy = q_cons_vf(eqn_idx%E)%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 end do @@ -100,7 +100,7 @@ contains end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - q_T_sf%sf(x, y, z) = q_prim_vf(sys_idx%E)%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 @@ -235,8 +235,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - P_L = q_prim_qp(sys_idx%E)%sf(x, y, z) - P_R = q_prim_qp(sys_idx%E)%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)) @@ -313,7 +313,7 @@ contains Mass_Diffu_Energy = lambda_Cell*dT_dxi + Mass_Diffu_Energy ! Update flux arrays - flux_src_vf(sys_idx%E)%sf(x, y, z) = flux_src_vf(sys_idx%E)%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 @@ -361,8 +361,8 @@ contains Rgas_L = gas_constant/MW_L Rgas_R = gas_constant/MW_R - P_L = q_prim_qp(sys_idx%E)%sf(x, y, z) - P_R = q_prim_qp(sys_idx%E)%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)) @@ -405,7 +405,7 @@ contains Mass_Diffu_Energy = rho_cell*diffusivity_cell*dh_dxi ! Update flux arrays - flux_src_vf(sys_idx%E)%sf(x, y, z) = flux_src_vf(sys_idx%E)%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 diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index ff86514f89..34935ccb16 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -113,7 +113,7 @@ module m_derived_types type(int_bounds_info) :: x, y, z end type bc_xyz_info - !> QBMM moment index mappings - separate from bub beg/end so sys_idx contains no allocatables. + !> 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 @@ -126,7 +126,7 @@ module m_derived_types !> 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 sys_idx_info + type eqn_idx_info type(int_bounds_info) :: cont !< Partial densities (continuity equations) type(int_bounds_info) :: mom !< Momentum components type(int_bounds_info) :: adv !< Volume fractions (advection equations) @@ -144,7 +144,7 @@ module m_derived_types integer :: c !< Color function equation integer :: damage !< Damage variable equation integer :: psi !< Psi variable equation - end type sys_idx_info + end type eqn_idx_info type bc_patch_parameters integer :: geometry diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index f88c7a087e..3fc9e0bd9c 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -133,7 +133,7 @@ contains ! 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(sys_idx%E)%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 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 9ec4f4f59a..a6142f422b 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 = sys_idx%stress%beg, sys_idx%stress%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(sys_idx%gamma)%sf(i, j, k) - pi_inf = q_vf(sys_idx%pi_inf)%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 @@ -535,12 +535,12 @@ contains if (relativity) then if (n == 0) then B(1) = Bx0 - B(2) = qK_cons_vf(sys_idx%B%beg)%sf(j, k, l) - B(3) = qK_cons_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l) - B(2) = qK_cons_vf(sys_idx%B%beg + 1)%sf(j, k, l) - B(3) = qK_cons_vf(sys_idx%B%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 @@ -556,7 +556,7 @@ contains S = S + qK_cons_vf(momxb + i - 1)%sf(j, k, l)*B(i) end do - E = qK_cons_vf(sys_idx%E)%sf(j, k, l) + E = qK_cons_vf(eqn_idx%E)%sf(j, k, l) D = 0._wp $:GPU_LOOP(parallelism='[seq]') @@ -590,7 +590,7 @@ 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(sys_idx%E)%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]') @@ -600,7 +600,7 @@ contains qK_prim_vf(1)%sf(j, k, l) = D/Ga ! Hard-coded for single-component for now $:GPU_LOOP(parallelism='[seq]') - do i = sys_idx%B%beg, sys_idx%B%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 @@ -659,20 +659,20 @@ contains if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + qK_cons_vf(sys_idx%B%beg)%sf(j, k, & - & l)**2 + qK_cons_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l)**2 + qK_cons_vf(sys_idx%B%beg + 1)%sf(j, k, & - & l)**2 + qK_cons_vf(sys_idx%B%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(sys_idx%E)%sf(j, k, l), qK_cons_vf(sys_idx%alf)%sf(j, k, l), dyn_pres_K, & + 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(sys_idx%E)%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,7 +685,7 @@ contains nRtmp(i) = qK_cons_vf(bubrs_vc(i))%sf(j, k, l) end do - vftmp = qK_cons_vf(sys_idx%alf)%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) @@ -702,8 +702,8 @@ contains #endif else if (adv_n) then - qK_prim_vf(sys_idx%n)%sf(j, k, l) = qK_cons_vf(sys_idx%n)%sf(j, k, l) - nbub_sc = qK_prim_vf(sys_idx%n)%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 @@ -717,7 +717,7 @@ contains if (mhd) then $:GPU_LOOP(parallelism='[seq]') - do i = sys_idx%B%beg, sys_idx%B%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 @@ -730,16 +730,16 @@ contains end if if (hypoelasticity) then - if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(sys_idx%damage)%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 ! subtracting elastic contribution for pressure calculation if (G_K > verysmall) then - qK_prim_vf(sys_idx%E)%sf(j, k, l) = qK_prim_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = qK_prim_vf(sys_idx%E)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, & + 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 @@ -761,12 +761,12 @@ contains end if if (surface_tension) then - qK_prim_vf(sys_idx%c)%sf(j, k, l) = qK_cons_vf(sys_idx%c)%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(sys_idx%damage)%sf(j, k, l) = qK_cons_vf(sys_idx%damage)%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(sys_idx%psi)%sf(j, k, l) = qK_cons_vf(sys_idx%psi)%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 +819,7 @@ contains if (.not. igr .or. num_fluids > 1) then ! Transferring the advection equation(s) variable(s) - do i = sys_idx%adv%beg, sys_idx%adv%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,12 +827,12 @@ contains if (relativity) then if (n == 0) then B(1) = Bx0 - B(2) = q_prim_vf(sys_idx%B%beg)%sf(j, k, l) - B(3) = q_prim_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l) - B(2) = q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, l) - B(3) = q_prim_vf(sys_idx%B%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 @@ -843,10 +843,10 @@ contains Ga = 1._wp/sqrt(1._wp - v2) - h = 1._wp + (gamma + 1)*q_prim_vf(sys_idx%E)%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 = sys_idx%B%beg, sys_idx%B%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 @@ -864,14 +864,14 @@ contains 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) end do - q_cons_vf(sys_idx%E)%sf(j, k, l) = rho*h*Ga**2 - q_prim_vf(sys_idx%E)%sf(j, k, & + 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(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_idx%E)%sf(j, k, l) - q_cons_vf(i)%sf(j, k, l) + 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 = sys_idx%B%beg, sys_idx%B%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 @@ -900,33 +900,33 @@ contains end do call get_mixture_molecular_weight(Ys, mix_mol_weight) - T = q_prim_vf(sys_idx%E)%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(sys_idx%E)%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(sys_idx%B%beg)%sf(j, k, & - & l)**2 + q_prim_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(sys_idx%B%beg + 1)%sf(j, & - & k, l)**2 + q_prim_vf(sys_idx%B%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(sys_idx%E)%sf(j, k, l) = gamma*q_prim_vf(sys_idx%E)%sf(j, k, & + 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(sys_idx%E)%sf(j, k, l) = gamma*q_prim_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(sys_idx%alf)%sf(j, k, & - & l))*(gamma*q_prim_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = 0._wp + q_cons_vf(eqn_idx%E)%sf(j, k, l) = 0._wp end if end if @@ -934,7 +934,7 @@ contains 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(sys_idx%E)%sf(j, k, & + & l)*(gammas(i)*q_prim_vf(eqn_idx%E)%sf(j, k, & & l) + pi_infs(i)) + q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i) end do end if @@ -947,10 +947,10 @@ contains if (.not. qbmm) then if (adv_n) then - q_cons_vf(sys_idx%n)%sf(j, k, l) = q_prim_vf(sys_idx%n)%sf(j, k, l) - nbub = q_prim_vf(sys_idx%n)%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(sys_idx%alf)%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 @@ -960,16 +960,16 @@ contains R3tmp = R3tmp + weight(i)*0.5_wp*(Rtmp(i) - sigR)**3._wp end do ! Initialize nb - nbub = 3._wp*q_prim_vf(sys_idx%alf)%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 = sys_idx%bub%beg, sys_idx%bub%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 = sys_idx%B%beg, sys_idx%B%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 @@ -982,15 +982,15 @@ contains end if if (hypoelasticity) then - if (cont_damage) G = G*max((1._wp - q_prim_vf(sys_idx%damage)%sf(j, k, l)), 0._wp) + if (cont_damage) G = G*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp) do i = strxb, strxe ! adding elastic contribution if (G > verysmall) then - q_cons_vf(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = q_cons_vf(sys_idx%E)%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 @@ -1006,12 +1006,12 @@ contains end if if (surface_tension) then - q_cons_vf(sys_idx%c)%sf(j, k, l) = q_prim_vf(sys_idx%c)%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(sys_idx%damage)%sf(j, k, l) = q_prim_vf(sys_idx%damage)%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(sys_idx%psi)%sf(j, k, l) = q_prim_vf(sys_idx%psi)%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 @@ -1079,7 +1079,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe - alpha_K(i - sys_idx%E) = qK_prim_vf(j, k, l, i) + alpha_K(i - eqn_idx%E) = qK_prim_vf(j, k, l, i) end do $:GPU_LOOP(parallelism='[seq]') @@ -1093,7 +1093,7 @@ contains vel_K_sum = vel_K_sum + vel_K(i)**2._wp end do - pres_K = qK_prim_vf(j, k, l, sys_idx%E) + 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) @@ -1131,7 +1131,7 @@ contains end do ! energy flux, u(E+p) - FK_vf(j, k, l, sys_idx%E) = 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 @@ -1145,13 +1145,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = advxb, advxe FK_vf(j, k, l, i) = 0._wp - FK_src_vf(j, k, l, i) = alpha_K(i - sys_idx%E) + 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 - sys_idx%E) + FK_vf(j, k, l, i) = vel_K(dir_idx(1))*alpha_K(i - eqn_idx%E) end do $:GPU_LOOP(parallelism='[seq]') diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 1bb38ab8d9..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, sys_idx%E - sys_idx%mom%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, sys_idx%E - sys_idx%mom%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, sys_idx%E - sys_idx%mom%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(sys_idx%E + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(sys_idx%E + 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(sys_idx%E + 2)%sf(j + 1, k, cent) - axm = q_prim_vf(sys_idx%E + 2)%sf(j, k, cent) - ayp = q_prim_vf(sys_idx%E + 2)%sf(j, k + 1, cent) - aym = q_prim_vf(sys_idx%E + 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(sys_idx%E)%sf(i, j, k) - Egint = Egint + q_prim_vf(sys_idx%E + 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(sys_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(sys_idx%E + 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, sys_idx%adv%end - sys_idx%E - adv(l) = q_prim_vf(sys_idx%E + 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(sys_idx%E)%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 b3d3ae100a..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(sys_idx%E)%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(sys_idx%E)%sf(i, j, k) + pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1._wp)*q_prim_vf(sys_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(sys_idx%adv%beg)%sf(i, j, & - & k)/blkmod1 + (1._wp - q_prim_vf(sys_idx%adv%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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j - 1, k, l) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(sys_idx%adv%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(sys_idx%adv%beg)%sf(j + 2, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j + 1, k, l) - q_prim_vf(sys_idx%adv%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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k - 1, l) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(sys_idx%adv%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(sys_idx%adv%beg)%sf(j, k + 2, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k + 1, l) - q_prim_vf(sys_idx%adv%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(sys_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l) - q_prim_vf(sys_idx%adv%beg)%sf(j, k, l - 1) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(sys_idx%adv%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(sys_idx%adv%beg)%sf(j, k, l + 2) - q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) - bottom = q_prim_vf(sys_idx%adv%beg)%sf(j, k, l + 1) - q_prim_vf(sys_idx%adv%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(sys_idx%mom%end)%sf(j, r + k, l) - fd_coeff_z(r, & - & l)*q_prim_vf(sys_idx%mom%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(sys_idx%mom%end)%sf(j, r + k, & - & l) - fd_coeff_z(r, l)*q_prim_vf(sys_idx%mom%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(sys_idx%mom%beg)%sf(j, k, & - & r + l) - fd_coeff_x(r, j)*q_prim_vf(sys_idx%mom%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(sys_idx%mom%beg)%sf(j, k, & - & r + l) - fd_coeff_x(r, j)*q_prim_vf(sys_idx%mom%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(sys_idx%mom%beg + 1)%sf(r + j, k, & - & l) - fd_coeff_y(r, k)*q_prim_vf(sys_idx%mom%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(sys_idx%mom%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(sys_idx%mom%beg + jj - 1)%sf(j, r + k, l) + & 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(sys_idx%mom%beg + jj - 1)%sf(j, k, r + l) + & 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(sys_idx%mom%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(sys_idx%mom%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(sys_idx%mom%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,8 +495,8 @@ contains do j = -offset_x%beg, m + offset_x%end q_sf(j, k, l) = 0._wp - do i = 1, sys_idx%adv%end - sys_idx%E - q_sf(j, k, l) = q_sf(j, k, l) - schlieren_alpha(i)*q_cons_vf(i + sys_idx%E)%sf(j, k, l)*gm_rho_sf(j, & + 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 diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 316a2f19f5..17e60a8194 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -112,7 +112,7 @@ 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + 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 !> @} @@ -496,46 +496,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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = sys_idx%cont%beg - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg + 1 - sys_idx%gamma = sys_idx%adv%beg - sys_idx%pi_inf = sys_idx%adv%end - sys_size = sys_idx%adv%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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%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 sys_idx%adv%end. If num_fluids = 1 then sys_idx%adv%end < - ! sys_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track - sys_idx%adv%beg = sys_idx%E + 1 ! Alpha for fluid 1 - sys_idx%adv%end = sys_idx%E + 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 sys_idx%adv%end - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + 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 = sys_idx%adv%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - sys_idx%alf = sys_idx%adv%end + eqn_idx%alf = eqn_idx%adv%end else - sys_idx%alf = 1 + eqn_idx%alf = 1 end if if (qbmm) then @@ -543,21 +543,21 @@ contains end if if (bubbles_euler) then - sys_idx%bub%beg = sys_size + 1 + eqn_idx%bub%beg = sys_size + 1 if (qbmm) then - sys_idx%bub%end = sys_idx%adv%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - sys_idx%bub%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end if (adv_n) then - sys_idx%n = sys_idx%bub%end + 1 - sys_size = sys_idx%n + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) @@ -567,7 +567,7 @@ contains allocate (qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do qbmm_idx%rs(i) = qbmm_idx%moms(i, 2) qbmm_idx%vs(i) = qbmm_idx%moms(i, 3) @@ -580,7 +580,7 @@ contains fac = 2 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + 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 @@ -597,48 +597,48 @@ contains end if if (mhd) then - sys_idx%B%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - sys_idx%B%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - sys_idx%B%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 = sys_idx%B%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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + num_fluids - sys_idx%int_en%beg = sys_idx%adv%end + 1 - sys_idx%int_en%end = sys_idx%adv%end + num_fluids - sys_size = sys_idx%int_en%end - sys_idx%alf = 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 - sys_idx%cont%beg = 1 ! one continuity equation - sys_idx%cont%end = 1 ! num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 ! one energy equation - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation - sys_idx%alf = sys_idx%adv%end - sys_size = sys_idx%alf ! sys_idx%adv%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 - sys_idx%bub%beg = sys_size + 1 - sys_idx%bub%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 - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) @@ -651,7 +651,7 @@ contains fac = 2 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + 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 @@ -677,24 +677,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - sys_idx%stress%beg = sys_size + 1 - sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) sys_idx%stress%end = sys_idx%stress%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 = sys_idx%stress%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) = sys_idx%stress%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) = sys_idx%stress%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/)) @@ -704,42 +704,42 @@ contains end if if (hyperelasticity) then - sys_idx%xi%beg = sys_size + 1 - sys_idx%xi%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 = sys_idx%xi%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 - sys_idx%c = sys_size + 1 - sys_size = sys_idx%c + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - sys_idx%damage = sys_size + 1 - sys_size = sys_idx%damage + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage else - sys_idx%damage = dflt_int + eqn_idx%damage = dflt_int end if if (hyper_cleaning) then - sys_idx%psi = sys_size + 1 - sys_size = sys_idx%psi + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi else - sys_idx%psi = dflt_int + eqn_idx%psi = dflt_int end if end if if (chemistry) then - sys_idx%species%beg = sys_size + 1 - sys_idx%species%end = sys_size + num_species - sys_size = sys_idx%species%end + eqn_idx%species%beg = sys_size + 1 + eqn_idx%species%end = sys_size + num_species + sys_size = eqn_idx%species%end else - sys_idx%species%beg = 1 - sys_idx%species%end = 1 + eqn_idx%species%beg = 1 + eqn_idx%species%end = 1 end if if (output_partial_domain) then @@ -751,22 +751,22 @@ contains z_output_idx%end = 0 end if - momxb = sys_idx%mom%beg - momxe = sys_idx%mom%end - advxb = sys_idx%adv%beg - advxe = sys_idx%adv%end - contxb = sys_idx%cont%beg - contxe = sys_idx%cont%end - bubxb = sys_idx%bub%beg - bubxe = sys_idx%bub%end - strxb = sys_idx%stress%beg - strxe = sys_idx%stress%end - intxb = sys_idx%int_en%beg - intxe = sys_idx%int_en%end - xibeg = sys_idx%xi%beg - xiend = sys_idx%xi%end - chemxb = sys_idx%species%beg - chemxe = sys_idx%species%end + momxb = eqn_idx%mom%beg + momxe = eqn_idx%mom%end + advxb = eqn_idx%adv%beg + advxe = eqn_idx%adv%end + contxb = eqn_idx%cont%beg + contxe = eqn_idx%cont%end + bubxb = eqn_idx%bub%beg + bubxe = eqn_idx%bub%end + strxb = eqn_idx%stress%beg + strxe = eqn_idx%stress%end + intxb = eqn_idx%int_en%beg + intxe = eqn_idx%int_en%end + xibeg = eqn_idx%xi%beg + xiend = eqn_idx%xi%end + chemxb = eqn_idx%species%beg + chemxe = eqn_idx%species%end #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index e12de3907d..bd120ade8c 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, sys_idx%E - sys_idx%mom%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 + sys_idx%cont%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, sys_idx%E - sys_idx%mom%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 + sys_idx%cont%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) @@ -316,7 +316,7 @@ contains end if end if - do i = 1, sys_idx%E - sys_idx%mom%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(sys_idx%E)%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) @@ -351,7 +351,7 @@ 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(sys_idx%mom%beg)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, l), & + 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 @@ -364,7 +364,7 @@ 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(sys_idx%mom%beg + 1)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, & + 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 @@ -377,7 +377,7 @@ 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(sys_idx%mom%beg + 2)%sf(j, k, l)/q_cons_vf(1)%sf(j, k, & + 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 @@ -454,21 +454,21 @@ contains end if if (mhd .and. prim_vars_wrt) then - do i = sys_idx%B%beg, sys_idx%B%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 == sys_idx%B%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 == sys_idx%B%beg) then + if (i == eqn_idx%B%beg) then write (varname, '(A)') 'Bx' - else if (i == sys_idx%B%beg + 1) then + else if (i == eqn_idx%B%beg + 1) then write (varname, '(A)') 'By' else write (varname, '(A)') 'Bz' @@ -481,9 +481,9 @@ contains end if if (elasticity) then - do i = 1, sys_idx%stress%end - sys_idx%stress%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 + sys_idx%stress%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 @@ -503,7 +503,7 @@ contains end if if (cont_damage) then - q_sf(:,:,:) = q_cons_vf(sys_idx%damage)%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) @@ -511,7 +511,7 @@ contains end if if (hyper_cleaning) then - q_sf = q_cons_vf(sys_idx%psi)%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) @@ -519,7 +519,7 @@ contains end if if (pres_wrt .or. prim_vars_wrt) then - q_sf(:,:,:) = q_prim_vf(sys_idx%E)%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) @@ -529,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 + sys_idx%E)%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) @@ -544,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(sys_idx%E + 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(sys_idx%adv%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) @@ -597,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, sys_idx%adv%end - sys_idx%E - adv(l) = q_prim_vf(sys_idx%E + 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(sys_idx%E)%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) @@ -676,16 +676,16 @@ contains end if if (cf_wrt) then - q_sf(:,:,:) = q_cons_vf(sys_idx%c)%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 = sys_idx%adv%beg, sys_idx%adv%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 - sys_idx%E + write (varname, '(A,I0)') 'alpha', i - eqn_idx%E call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' end do @@ -727,7 +727,7 @@ contains ! number density if (adv_n) then - q_sf(:,:,:) = q_cons_vf(sys_idx%n)%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 2964cea279..b3924d52fa 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, sys_idx%E - sys_idx%mom%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(sys_idx%gamma)%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(sys_idx%E)%sf(j, k, l) = 1._wp/q_prim_vf(sys_idx%gamma)%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(sys_idx%pi_inf)%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 @@ -147,13 +147,13 @@ contains B_tait = ps_inf(1) if (j < 177) then - q_prim_vf(sys_idx%E)%sf(j, k, l) = 0.5_wp*q_prim_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l)*p0 - bub_pp%pv))**(1._wp/3._wp) + & 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 @@ -173,32 +173,32 @@ contains end do end if - n0 = 3._wp*q_prim_vf(sys_idx%alf)%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(sys_idx%E)%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(sys_idx%alf)%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(sys_idx%alf)%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(sys_idx%E)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(sys_idx%alf)%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 = sys_idx%cont%beg, sys_idx%cont%end + do i = eqn_idx%cont%beg, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = rhoH end do - do i = sys_idx%mom%beg, sys_idx%mom%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(sys_idx%alf)%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 = sys_idx%adv%beg, sys_idx%adv%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 = sys_idx%adv%beg, sys_idx%adv%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%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 = sys_idx%adv%beg, sys_idx%adv%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - sys_idx%E) + 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 = sys_idx%adv%beg, sys_idx%adv%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 = sys_idx%adv%beg, sys_idx%adv%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%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, sys_idx%cont%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, sys_idx%cont%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 = sys_idx%adv%beg, sys_idx%adv%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - sys_idx%E) + 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 = sys_idx%adv%beg, sys_idx%adv%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 = sys_idx%adv%beg, sys_idx%adv%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%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 @@ -345,7 +345,7 @@ contains do i = 1, nb R3bar = R3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_idx%alf)%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,32 +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(sys_idx%E)%sf(j, k, l) = (eta*patch_icpp(patch_id)%pres + (1._wp - eta)*orig_prim_vf(sys_idx%E)) + 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 = sys_idx%adv%beg, sys_idx%adv%end - q_prim_vf(i)%sf(j, k, l) = eta*patch_icpp(patch_id)%alpha(i - sys_idx%E) + (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(sys_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg) - q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, & - & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l) = eta*patch_icpp(patch_id)%Bx + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg) - q_prim_vf(sys_idx%B%beg + 1)%sf(j, k, & - & l) = eta*patch_icpp(patch_id)%By + (1._wp - eta)*orig_prim_vf(sys_idx%B%beg + 1) - q_prim_vf(sys_idx%B%beg + 2)%sf(j, k, & - & l) = eta*patch_icpp(patch_id)%Bz + (1._wp - eta)*orig_prim_vf(sys_idx%B%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, (sys_idx%stress%end - sys_idx%stress%beg) + 1 - q_prim_vf(i + sys_idx%stress%beg - 1)%sf(j, k, & - & l) = (eta*patch_icpp(patch_id)%tau_e(i) + (1._wp - eta)*orig_prim_vf(i + sys_idx%stress%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 @@ -407,18 +407,18 @@ contains if (mpp_lim .and. bubbles_euler) then ! adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = sys_idx%adv%beg, sys_idx%adv%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 = sys_idx%adv%beg, sys_idx%adv%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%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, sys_idx%cont%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 @@ -428,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(sys_idx%E)%sf(j, k, & - & l) + pi_inf)/(pref + pi_inf))**(1/lit_gamma))*rhoref*(1 - q_prim_vf(sys_idx%alf)%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, sys_idx%E - sys_idx%mom%beg - q_prim_vf(i + sys_idx%cont%end)%sf(j, k, & - & l) = (eta*patch_icpp(patch_id)%vel(i) + (1._wp - eta)*orig_prim_vf(i + sys_idx%cont%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 @@ -463,15 +463,15 @@ contains ! Set streamwise velocity to hyperbolic tangent function of y if (mixlayer_vel_profile) then - q_prim_vf(1 + sys_idx%cont%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 & - & + sys_idx%cont%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 = sys_idx%int_en%beg, sys_idx%int_en%end - q_prim_vf(i)%sf(j, k, l) = q_prim_vf(sys_idx%E)%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 @@ -513,19 +513,19 @@ contains do i = 1, nb R3bar = R3bar + weight(i)*(q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(sys_idx%n)%sf(j, k, l) = 3*q_prim_vf(sys_idx%alf)%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 = sys_idx%adv%beg, sys_idx%adv%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 = sys_idx%adv%beg, sys_idx%adv%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(sys_idx%alf)%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 @@ -541,7 +541,7 @@ contains end if if (surface_tension) then - q_prim_vf(sys_idx%c)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + (1._wp - eta)*orig_prim_vf(sys_idx%c) + 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 26c4df12db..ead7d8f1a3 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -178,51 +178,51 @@ contains if ((i >= chemxb) .and. (i <= chemxe)) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/rho - else if (((i >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & - & .and. (i <= sys_idx%adv%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 >= chemxb) .and. (i <= chemxe))) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) - else if (i == sys_idx%mom%beg) then ! u - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg)%sf(j, 0, 0)/rho - else if (i == sys_idx%stress%beg) then ! tau_e - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%stress%beg)%sf(j, 0, 0)/rho - else if (i == sys_idx%E) 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(sys_idx%B%beg)%sf(j, 0, & - & 0)**2 + q_cons_vf(sys_idx%B%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(sys_idx%E)%sf(j, 0, 0), q_cons_vf(sys_idx%alf)%sf(j, 0, 0), & - & 0.5_wp*(q_cons_vf(sys_idx%mom%beg)%sf(j, 0, 0)**2._wp)/rho, pi_inf, gamma, & + 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 == sys_idx%mom%beg + 1) then ! v - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg + 1)%sf(j, 0, 0)/rho - else if (i == sys_idx%mom%beg + 2) then ! w - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%mom%beg + 2)%sf(j, 0, 0)/rho - else if (i == sys_idx%B%beg) then ! By - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%B%beg)%sf(j, 0, 0)/rho - else if (i == sys_idx%B%beg + 1) then ! Bz - write (2, FMT) x_cb(j), q_cons_vf(sys_idx%B%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 >= sys_idx%bub%beg) .and. (i <= sys_idx%bub%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) else if (adv_n) then - nbub = q_cons_vf(sys_idx%n)%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(qbmm_idx%rs(k))%sf(j, 0, 0) end do - call s_comp_n_from_cons(real(q_cons_vf(sys_idx%alf)%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 == sys_idx%n .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 == sys_idx%damage) 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 @@ -626,7 +626,7 @@ contains do i = momxb, momxe write (iu, '(I3,A20,A20)') i, "\rho u_" // coord(i - momxb + 1), "u_" // coord(i - momxb + 1) end do - if (sys_idx%E /= 0) write (iu, '(I3,A20,A20)') sys_idx%E, "\rho U", "p" + if (eqn_idx%E /= 0) write (iu, '(I3,A20,A20)') eqn_idx%E, "\rho U", "p" do i = advxb, advxe write (temp, '(I0)') i - contxb + 1 write (iu, '(I3,A20,A20)') i, "\alpha_{" // trim(temp) // "}", "\alpha_{" // trim(temp) // "}" @@ -639,17 +639,17 @@ contains end if write (iu, '(A)') "" - call write_range(sys_idx%cont%beg, sys_idx%cont%end, " Continuity") - call write_range(sys_idx%mom%beg, sys_idx%mom%end, " Momentum") - call write_range(sys_idx%E, sys_idx%E, " Energy/Pressure") - call write_range(sys_idx%adv%beg, sys_idx%adv%end, " Advection") - call write_range(sys_idx%bub%beg, sys_idx%bub%end, " Bubbles") - call write_range(sys_idx%stress%beg, sys_idx%stress%end, " Stress") - call write_range(sys_idx%int_en%beg, sys_idx%int_en%end, " Internal Energies") - call write_range(sys_idx%xi%beg, sys_idx%xi%end, " Reference Map") - call write_range(sys_idx%B%beg, sys_idx%B%end, " Magnetic Field") - call write_range(sys_idx%c, sys_idx%c, " Color Function") - call write_range(sys_idx%species%beg, sys_idx%species%end, " Chemistry") + 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) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 7ddd7ed8c9..0a6e6b6494 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -82,7 +82,7 @@ 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(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + 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) @@ -548,67 +548,67 @@ 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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = sys_idx%cont%beg - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg + 1 - sys_idx%gamma = sys_idx%adv%beg - sys_idx%pi_inf = sys_idx%adv%end - sys_size = sys_idx%adv%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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%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 sys_idx%adv%end. If num_fluids = 1 then sys_idx%adv%end < - ! sys_idx%adv%beg, which skips all loops over the volume fractions since there is no volume fraction to track - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + 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 sys_idx%adv%end - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + 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 = sys_idx%adv%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - sys_idx%alf = sys_idx%adv%end + eqn_idx%alf = eqn_idx%adv%end else - sys_idx%alf = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - sys_idx%bub%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 - sys_idx%bub%end = sys_idx%adv%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - sys_idx%bub%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end if (adv_n) then - sys_idx%n = sys_idx%bub%end + 1 - sys_size = sys_idx%n + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) @@ -620,7 +620,7 @@ contains do i = 1, nb do j = 1, nmom - qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do qbmm_idx%fullmom(i, 0, 0) = qbmm_idx%moms(i, 1) qbmm_idx%fullmom(i, 1, 0) = qbmm_idx%moms(i, 2) @@ -638,7 +638,7 @@ contains fac = 2 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then @@ -650,48 +650,48 @@ contains end if if (mhd) then - sys_idx%B%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - sys_idx%B%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - sys_idx%B%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 = sys_idx%B%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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + num_fluids - sys_idx%int_en%beg = sys_idx%adv%end + 1 - sys_idx%int_en%end = sys_idx%adv%end + num_fluids - sys_size = sys_idx%int_en%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 - sys_idx%cont%beg = 1 ! one continuity equation - sys_idx%cont%end = 1 ! num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each direction - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 ! one energy equation - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation - sys_idx%alf = sys_idx%adv%end - sys_size = sys_idx%alf ! sys_idx%adv%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 - sys_idx%bub%beg = sys_size + 1 - sys_idx%bub%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end allocate (qbmm_idx%rs(nb), qbmm_idx%vs(nb)) allocate (qbmm_idx%ps(nb), qbmm_idx%ms(nb)) @@ -704,7 +704,7 @@ contains fac = 2 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then @@ -730,24 +730,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - sys_idx%stress%beg = sys_size + 1 - sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) sys_idx%stress%end = sys_idx%stress%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 = sys_idx%stress%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) = sys_idx%stress%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) = sys_idx%stress%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/)) @@ -760,50 +760,50 @@ 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 - sys_idx%xi%beg = sys_size + 1 - sys_idx%xi%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 = sys_idx%xi%end + 1 + sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - sys_idx%c = sys_size + 1 - sys_size = sys_idx%c + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - sys_idx%damage = sys_size + 1 - sys_size = sys_idx%damage + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage end if if (hyper_cleaning) then - sys_idx%psi = sys_size + 1 - sys_size = sys_idx%psi + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi end if end if if (chemistry) then - sys_idx%species%beg = sys_size + 1 - sys_idx%species%end = sys_size + num_species - sys_size = sys_idx%species%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 = sys_idx%mom%beg - momxe = sys_idx%mom%end - advxb = sys_idx%adv%beg - advxe = sys_idx%adv%end - contxb = sys_idx%cont%beg - contxe = sys_idx%cont%end - bubxb = sys_idx%bub%beg - bubxe = sys_idx%bub%end - strxb = sys_idx%stress%beg - strxe = sys_idx%stress%end - intxb = sys_idx%int_en%beg - intxe = sys_idx%int_en%end - xibeg = sys_idx%xi%beg - xiend = sys_idx%xi%end - chemxb = sys_idx%species%beg - chemxe = sys_idx%species%end + momxb = eqn_idx%mom%beg + momxe = eqn_idx%mom%end + advxb = eqn_idx%adv%beg + advxe = eqn_idx%adv%end + contxb = eqn_idx%cont%beg + contxe = eqn_idx%cont%end + bubxb = eqn_idx%bub%beg + bubxe = eqn_idx%bub%end + strxb = eqn_idx%stress%beg + strxe = eqn_idx%stress%end + intxb = eqn_idx%int_en%beg + intxe = eqn_idx%int_en%end + xibeg = eqn_idx%xi%beg + xiend = eqn_idx%xi%end + chemxb = eqn_idx%species%beg + chemxe = eqn_idx%species%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) diff --git a/src/pre_process/m_icpp_patches.fpp b/src/pre_process/m_icpp_patches.fpp index 6e21217d0e..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(sys_idx%alf)%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(sys_idx%alf)%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(sys_idx%E)%sf(i, j, & - & 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))*rhoref*(1._wp - q_prim_vf(sys_idx%alf) & + 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(sys_idx%mom%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) - q_prim_vf(sys_idx%mom%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) - q_prim_vf(sys_idx%E)%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 52fcdac33f..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(sys_idx%damage)%sf = 0._wp - q_prim_vf(sys_idx%damage)%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(sys_idx%psi)%sf = 0._wp - q_prim_vf(sys_idx%psi)%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 de05e35c7c..0f47a1581a 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(sys_idx%E + 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(sys_idx%E + 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(sys_idx%mom%end)%sf(i, j, k) = rand_real*q_prim_vf(sys_idx%mom%beg)%sf(i, j, k) - q_prim_vf(sys_idx%mom%beg)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(sys_idx%mom%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(sys_idx%alf)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(sys_idx%alf)%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 diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 57fc767b2b..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(sys_idx%psi > 0, "hyper_cleaning requires sys_idx%psi 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(sys_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2)) - q_prim_vf(sys_idx%psi)%sf(j, k, l) = q_cons_vf(sys_idx%psi)%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 2ec7d8c43f..55136ec77f 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -250,7 +250,7 @@ contains end if small_gamma = 1._wp/small_gamma + 1._wp - c = sqrt(small_gamma*(q_prim_vf(sys_idx%E)%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) @@ -322,7 +322,7 @@ contains 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) end do - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%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 0bc2cdcba0..d649782326 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -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, sys_idx%E + do i = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -105,7 +105,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxb)%sf(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(momxb)%sf(j, k, l)*accel_bf(1) end do end do end do @@ -119,7 +119,7 @@ contains do k = 0, n do j = 0, m rhs_vf(momxb + 1)%sf(j, k, l) = rhs_vf(momxb + 1)%sf(j, k, l) + rhoM(j, k, l)*accel_bf(2) - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxb + 1)%sf(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(momxb + 1)%sf(j, k, l)*accel_bf(2) end do end do end do @@ -133,7 +133,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, l) + q_cons_vf(momxe)%sf(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(momxe)%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 6062ae3b84..1abba408d6 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -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(sys_idx%alf)%sf(j, k, l) = (4._wp*pi*nR3bar)/(3._wp*q_cons_vf(sys_idx%n)%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 @@ -188,7 +188,7 @@ contains do k = 0, n do j = 0, m if (adv_n) then - nbub = q_prim_vf(sys_idx%n)%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(sys_idx%alf)%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 @@ -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(sys_idx%E)%sf(j, k, l) - alf = q_prim_vf(sys_idx%alf)%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,7 +303,7 @@ contains do l = 0, p do q = 0, n do i = 0, m - rhs_vf(sys_idx%alf)%sf(i, q, l) = rhs_vf(sys_idx%alf)%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(advxb)%sf(i, q, l) = rhs_vf(advxb)%sf(i, q, l) - bub_adv_src(i, q, l) $:GPU_LOOP(parallelism='[seq]') do k = 1, nb diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index 81d904b92f..856d041c42 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -281,8 +281,8 @@ contains do i = 1, num_dims dynP = dynP + 0.5_wp*q_cons_vf(contxe + i)%sf(cell(1), cell(2), cell(3))**2/rhol end do - pliq = (q_cons_vf(sys_idx%E)%sf(cell(1), cell(2), cell(3)) - dynP - pi_inf)/gamma - if (pliq < 0) print *, "Negative pressure", proc_rank, q_cons_vf(sys_idx%E)%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, sys_idx%E + 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, sys_idx%E + 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(sys_idx%E)%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) @@ -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(sys_idx%E)%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(contxe + 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(sys_idx%E)%sf(i, j, k) = rhs_vf(sys_idx%E)%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 @@ -842,19 +842,19 @@ contains !> Perform bilinear interpolation if (p == 0) then ! 2D - f_pinfl = q_prim_vf(sys_idx%E)%sf(cell(1), cell(2), cell(3))*(1._wp - psi(1))*(1._wp - psi(2)) - f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%sf(cell(1) + 1, cell(2), cell(3))*psi(1)*(1._wp - psi(2)) - f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%sf(cell(1) + 1, cell(2) + 1, cell(3))*psi(1)*psi(2) - f_pinfl = f_pinfl + q_prim_vf(sys_idx%E)%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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_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(sys_idx%E)%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(sys_idx%E)%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(sys_idx%E)%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 2e5347a187..7d5788fede 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -96,7 +96,7 @@ contains if (chemistry) then flux_cbc_index = sys_size else - flux_cbc_index = sys_idx%adv%end + flux_cbc_index = eqn_idx%adv%end end if $:GPU_UPDATE(device='[flux_cbc_index]') @@ -124,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, sys_idx%adv%beg:sys_idx%adv%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, sys_idx%adv%beg:sys_idx%adv%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 @@ -152,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, sys_idx%adv%beg:sys_idx%adv%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, sys_idx%adv%beg:sys_idx%adv%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 @@ -181,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, sys_idx%adv%beg:sys_idx%adv%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, sys_idx%adv%beg:sys_idx%adv%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 @@ -620,11 +620,11 @@ contains vel_K_sum = vel_K_sum + vel(i)**2._wp end do - pres = q_prim_rs${XYZ}$_vf(0, k, r, sys_idx%E) + pres = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E) $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - sys_idx%E - adv_local(i) = q_prim_rs${XYZ}$_vf(0, k, r, sys_idx%E + i) + do i = 1, advxe - 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) @@ -680,7 +680,7 @@ contains dpres_ds = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - sys_idx%E + do i = 1, advxe - eqn_idx%E dadv_ds(i) = 0._wp end do @@ -702,10 +702,10 @@ contains dvel_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, contxe + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dvel_ds(i) end do - dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, sys_idx%E)*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 - sys_idx%E - dadv_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, sys_idx%E + i)*fd_coef_${XYZ}$ (j, cbc_loc) + dadv_ds(i) + do i = 1, advxe - 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 @@ -748,8 +748,8 @@ contains end if end if $:GPU_LOOP(parallelism='[seq]') - do i = sys_idx%E, advxe - 1 - L(i) = c*Ma*(adv_local(i + 1 - sys_idx%E) - alpha_in(i + 1 - sys_idx%E, & + do i = eqn_idx%E, advxe - 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, & @@ -820,12 +820,12 @@ contains ! 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 - sys_idx%E + do i = 1, advxe - eqn_idx%E dadv_dt(i) = -L(momxe + i) ! + adv_local(i) * vel(dir_idx(1))/y_cc(n) end do else $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - sys_idx%E + do i = 1, advxe - eqn_idx%E dadv_dt(i) = -L(momxe + i) end do end if @@ -876,8 +876,8 @@ 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, sys_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & - & sys_idx%E) + ds(0)*((E/rho + pres/rho)*drho_dt + rho*vel_dv_dt_sum + Cp*T*L(2) & + 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 @@ -885,8 +885,8 @@ contains & chemxb + i - 1) + ds(0)*(drho_dt*Ys(i) + rho*dYs_dt(i)) end do else - flux_rs${XYZ}$_vf_l(-1, k, r, sys_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & - & sys_idx%E) + 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 @@ -901,12 +901,12 @@ contains 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 - sys_idx%E)) + & 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 - sys_idx%E) + 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]') diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index e592db7c24..713f20d2d8 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -100,7 +100,7 @@ contains integer :: i ! $:GPU_LOOP(parallelism='[seq]') - do i = sys_idx%E, advxe - 1 + do i = eqn_idx%E, advxe - 1 L(i) = lambda_factor*lambda2*dadv_ds(i - momxe) end do diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6bbc4ae8bc..77b7a1b083 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -414,7 +414,7 @@ contains open (2, FILE=trim(file_path)) do j = 0, m ! todo: revisit change here - if (((i >= sys_idx%adv%beg) .and. (i <= sys_idx%adv%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 +532,8 @@ contains do j = 0, m do k = 0, n - if (((i >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & - & .and. (i <= sys_idx%adv%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 +627,8 @@ contains do j = 0, m do k = 0, n do l = 0, p - if (((i >= sys_idx%cont%beg) .and. (i <= sys_idx%cont%end)) .or. ((i >= sys_idx%adv%beg) & - & .and. (i <= sys_idx%adv%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 >= chemxb) .and. (i <= chemxe))) 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) @@ -1062,36 +1062,36 @@ 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(sys_idx%cont%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(sys_idx%damage)%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(sys_idx%alf)%sf(j - 2, k, l), dyn_p, & + 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(sys_idx%stress%beg)%sf(j - 2, k, l), & - & q_cons_vf(sys_idx%mom%beg)%sf(j - 2, k, l), G_local) + & 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(sys_idx%E)%sf(j - 2, k, l), q_cons_vf(sys_idx%alf)%sf(j - 2, k, l), & + 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(sys_idx%stress%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(sys_idx%alf)%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(sys_idx%alf - 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(qbmm_idx%rs(s))%sf(j - 2, k, l) @@ -1099,7 +1099,7 @@ contains end do if (adv_n) then - nbub = q_cons_vf(sys_idx%n)%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 @@ -1166,23 +1166,23 @@ 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(sys_idx%cont%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(sys_idx%damage)%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(sys_idx%alf)%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(sys_idx%stress%beg)%sf(j - 2, k - 2, l), & - & q_cons_vf(sys_idx%mom%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(sys_idx%E)%sf(j - 2, k - 2, l), q_cons_vf(sys_idx%alf)%sf(j - 2, & + 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 @@ -1195,14 +1195,14 @@ contains end if if (bubbles_euler) then - alf = q_cons_vf(sys_idx%alf)%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(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(sys_idx%n)%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 @@ -1247,7 +1247,7 @@ 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(sys_idx%cont%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) @@ -1260,17 +1260,17 @@ contains if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(sys_idx%damage)%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(sys_idx%alf)%sf(j - 2, & + 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(sys_idx%stress%beg)%sf(j - 2, k - 2, l - 2), & - & q_cons_vf(sys_idx%mom%beg)%sf(j - 2, k - 2, l - 2), G_local) + & 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(sys_idx%E)%sf(j - 2, k - 2, l - 2), & - & q_cons_vf(sys_idx%alf)%sf(j - 2, k - 2, l - 2), dyn_p, pi_inf, gamma, & + 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 @@ -1391,11 +1391,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(sys_idx%cont%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(sys_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(sys_idx%mom%beg)%sf(j, k, & - & l)**2._wp)/rho)/(1._wp - q_cons_vf(sys_idx%alf)%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 @@ -1454,11 +1454,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(sys_idx%cont%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(sys_idx%E)%sf(j, k, l) - 0.5_wp*(q_cons_vf(sys_idx%mom%beg)%sf(j, k, & - & l)**2._wp)/rho)/(1._wp - q_cons_vf(sys_idx%alf)%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_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 4317b1e474..f04e2ef37b 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -250,12 +250,12 @@ module m_global_parameters !! equations to which they belong !> @{ integer :: sys_size !< Number of unknowns in system of eqns. - type(sys_idx_info) :: sys_idx !< All conserved-variable equation index ranges and scalars. + 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, sys_idx, b_size, tensor_size]') + $:GPU_DECLARE(create='[sys_size, eqn_idx, b_size, tensor_size]') $:GPU_DECLARE(create='[qbmm_idx]') ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). Stands for "InDices With INTerior". @@ -855,68 +855,68 @@ 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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = sys_idx%cont%beg - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg + 1 - sys_idx%gamma = sys_idx%adv%beg - sys_idx%pi_inf = sys_idx%adv%end - sys_size = sys_idx%adv%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 - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%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) - sys_idx%adv%beg = sys_idx%E + 1 ! Alpha for fluid 1 - sys_idx%adv%end = sys_idx%E + 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 sys_idx%adv%end - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + 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 = sys_idx%adv%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - sys_idx%alf = sys_idx%adv%end + eqn_idx%alf = eqn_idx%adv%end else - sys_idx%alf = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - sys_idx%bub%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 - sys_idx%bub%end = sys_idx%adv%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - sys_idx%bub%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end if (adv_n) then - sys_idx%n = sys_idx%bub%end + 1 - sys_size = sys_idx%n + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if @:ALLOCATE(qbmm_idx%rs(nb), qbmm_idx%vs(nb)) @@ -928,7 +928,7 @@ contains @:ALLOCATE(qbmm_idx%moms(nb, nmom)) do i = 1, nb do j = 1, nmom - qbmm_idx%moms(i, j) = sys_idx%bub%beg + (j - 1) + (i - 1)*nmom + qbmm_idx%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do qbmm_idx%rs(i) = qbmm_idx%moms(i, 2) qbmm_idx%vs(i) = qbmm_idx%moms(i, 3) @@ -941,7 +941,7 @@ contains fac = 2 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then @@ -953,44 +953,44 @@ contains end if if (mhd) then - sys_idx%B%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - sys_idx%B%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - sys_idx%B%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 = sys_idx%B%end + sys_size = eqn_idx%B%end end if else if (model_eqns == 3) then - sys_idx%cont%beg = 1 - sys_idx%cont%end = num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%E + num_fluids - sys_idx%alf = sys_idx%adv%end - sys_idx%int_en%beg = sys_idx%adv%end + 1 - sys_idx%int_en%end = sys_idx%adv%end + num_fluids - sys_size = sys_idx%int_en%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 - sys_idx%cont%beg = 1 ! one continuity equation - sys_idx%cont%end = 1 ! num_fluids - sys_idx%mom%beg = sys_idx%cont%end + 1 ! one momentum equation in each direction - sys_idx%mom%end = sys_idx%cont%end + num_vels - sys_idx%E = sys_idx%mom%end + 1 ! one energy equation - sys_idx%adv%beg = sys_idx%E + 1 - sys_idx%adv%end = sys_idx%adv%beg ! one volume advection equation - sys_idx%alf = sys_idx%adv%end - sys_size = sys_idx%adv%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 - sys_idx%bub%beg = sys_size + 1 - sys_idx%bub%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - sys_idx%bub%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = sys_idx%bub%end + sys_size = eqn_idx%bub%end @:ALLOCATE(qbmm_idx%rs(nb), qbmm_idx%vs(nb)) @:ALLOCATE(qbmm_idx%ps(nb), qbmm_idx%ms(nb)) @@ -1002,7 +1002,7 @@ contains fac = 4 end if - qbmm_idx%rs(i) = sys_idx%bub%beg + (i - 1)*fac + qbmm_idx%rs(i) = eqn_idx%bub%beg + (i - 1)*fac qbmm_idx%vs(i) = qbmm_idx%rs(i) + 1 if (.not. polytropic) then @@ -1050,24 +1050,24 @@ contains if (model_eqns == 2 .or. model_eqns == 3) then if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - sys_idx%stress%beg = sys_size + 1 - sys_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) sys_idx%stress%end = sys_idx%stress%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 = sys_idx%stress%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) = sys_idx%stress%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) = sys_idx%stress%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/)) @@ -1082,34 +1082,34 @@ contains b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 - sys_idx%xi%beg = sys_size + 1 - sys_idx%xi%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 = sys_idx%xi%end + 1 + sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - sys_idx%c = sys_size + 1 - sys_size = sys_idx%c + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - sys_idx%damage = sys_size + 1 - sys_size = sys_idx%damage + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage end if if (hyper_cleaning) then - sys_idx%psi = sys_size + 1 - sys_size = sys_idx%psi + eqn_idx%psi = sys_size + 1 + sys_size = eqn_idx%psi end if end if ! END: Volume Fraction Model if (chemistry) then - sys_idx%species%beg = sys_size + 1 - sys_idx%species%end = sys_size + num_species - sys_size = sys_idx%species%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 @@ -1184,31 +1184,31 @@ contains grid_geometry = 3 end if - momxb = sys_idx%mom%beg - momxe = sys_idx%mom%end - advxb = sys_idx%adv%beg - advxe = sys_idx%adv%end - contxb = sys_idx%cont%beg - contxe = sys_idx%cont%end - bubxb = sys_idx%bub%beg - bubxe = sys_idx%bub%end - strxb = sys_idx%stress%beg - strxe = sys_idx%stress%end - intxb = sys_idx%int_en%beg - intxe = sys_idx%int_en%end - xibeg = sys_idx%xi%beg - xiend = sys_idx%xi%end - chemxb = sys_idx%species%beg - chemxe = sys_idx%species%end + momxb = eqn_idx%mom%beg + momxe = eqn_idx%mom%end + advxb = eqn_idx%adv%beg + advxe = eqn_idx%adv%end + contxb = eqn_idx%cont%beg + contxe = eqn_idx%cont%end + bubxb = eqn_idx%bub%beg + bubxe = eqn_idx%bub%end + strxb = eqn_idx%stress%beg + strxe = eqn_idx%stress%end + intxb = eqn_idx%int_en%beg + intxe = eqn_idx%int_en%end + xibeg = eqn_idx%xi%beg + xiend = eqn_idx%xi%end + chemxb = eqn_idx%species%beg + chemxe = eqn_idx%species%end $:GPU_UPDATE(device='[momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, & - & sys_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') + & eqn_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') $:GPU_UPDATE(device='[b_size, xibeg, xiend, 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, sys_idx, mpp_lim, bubbles_euler, hypoelasticity, & + $: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]') diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index b04168a6da..e8793517a9 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -173,7 +173,7 @@ 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(sys_idx%E)%sf(j, k, l) = q_prim_vf(sys_idx%E)%sf(j, k, & + 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(xiend + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field $:GPU_LOOP(parallelism='[seq]') diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 2b8668c576..4ab774f4da 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -192,7 +192,7 @@ contains 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(sys_idx%damage)%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 @@ -360,7 +360,7 @@ contains l = 0; q = 0 $:GPU_PARALLEL_LOOP() do k = 0, m - rhs_vf(sys_idx%damage)%sf(k, l, q) = (alpha_bar*max(abs(real(q_cons_vf(sys_idx%stress%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,12 +370,12 @@ contains do l = 0, n do k = 0, m ! Maximum principal stress - tau_p = 0.5_wp*(q_cons_vf(sys_idx%stress%beg)%sf(k, l, q) + q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, & - & q)) + sqrt((q_cons_vf(sys_idx%stress%beg)%sf(k, l, & - & q) - q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, & - & q))**2.0_wp + 4._wp*q_cons_vf(sys_idx%stress%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(sys_idx%damage)%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() @@ -385,12 +385,12 @@ contains do q = 0, p do l = 0, n do k = 0, m - tau_xx = q_cons_vf(sys_idx%stress%beg)%sf(k, l, q) - tau_xy = q_cons_vf(sys_idx%stress%beg + 1)%sf(k, l, q) - tau_yy = q_cons_vf(sys_idx%stress%beg + 2)%sf(k, l, q) - tau_xz = q_cons_vf(sys_idx%stress%beg + 3)%sf(k, l, q) - tau_yz = q_cons_vf(sys_idx%stress%beg + 4)%sf(k, l, q) - tau_zz = q_cons_vf(sys_idx%stress%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 @@ -412,7 +412,7 @@ contains tau_p = I1/3.0_wp end if - rhs_vf(sys_idx%damage)%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 e899e7a2b1..9e942cff5b 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,13 +165,13 @@ contains ! set the Moving IBM interior conservative variables - $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[sys_idx%E, momxb]', collapse=3) + $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[eqn_idx%E, momxb]', 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(sys_idx%E)%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) @@ -230,18 +230,18 @@ contains end do if (surface_tension) then - q_prim_vf(sys_idx%c)%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(sys_idx%E)%sf(j, k, l) = pres_IP + q_prim_vf(eqn_idx%E)%sf(j, k, l) = pres_IP else - q_prim_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = q_prim_vf(sys_idx%E)%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 @@ -310,14 +310,14 @@ contains ! Set color function if (surface_tension) then - q_cons_vf(sys_idx%c)%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(sys_idx%E)%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(sys_idx%E)%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 @@ -779,7 +779,7 @@ 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(sys_idx%E)%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 @@ -793,7 +793,7 @@ contains end do if (surface_tension) then - c_IP = c_IP + coeff*q_prim_vf(sys_idx%c)%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 @@ -936,17 +936,17 @@ 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(sys_idx%E + fluid_idx)%sf(i & - & + 1, j, k) - q_prim_vf(sys_idx%E + 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(sys_idx%E + fluid_idx)%sf(i, & - & j + 1, k) - q_prim_vf(sys_idx%E + 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(sys_idx%E + fluid_idx) & - & %sf(i, j, k + 1) - q_prim_vf(sys_idx%E + fluid_idx)%sf(i, j, & + 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 diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index b21aeb84a8..130c98a0d6 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -372,12 +372,12 @@ contains rhs_vf(momxb)%sf(j + 1, k, l) = rhs_vf(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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) #:endfor end do @@ -527,7 +527,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(sys_idx%E + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -549,7 +549,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(sys_idx%E + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -605,56 +605,56 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +662,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(sys_idx%E)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(eqn_idx%E)%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, & @@ -721,7 +721,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -736,7 +736,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -789,7 +789,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -804,7 +804,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -964,7 +964,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(sys_idx%E + i)%sf(j + q, k, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_L(1) = 1._wp @@ -986,7 +986,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(sys_idx%E + i)%sf(j + q, k, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(eqn_idx%E + i)%sf(j + q, k, l) end do else alpha_R(1) = 1._wp @@ -1043,84 +1043,84 @@ contains rhs_vf(momxb + 1)%sf(j + 1, k, l) = rhs_vf(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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1128,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%sf(j + q, k, l) + E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(sys_idx%E)%sf(j + q, k, l) + E_R = E_R + coeff_R(q)*q_cons_vf(eqn_idx%E)%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, & @@ -1193,7 +1193,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1213,7 +1213,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1271,7 +1271,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j + 1))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j + 1, k, l) = rhs_vf(sys_idx%E)%sf(j + 1, k, & + rhs_vf(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1291,7 +1291,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dx(j))), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1397,7 +1397,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(sys_idx%E + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1419,7 +1419,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(sys_idx%E + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1476,56 +1476,56 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1534,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(sys_idx%E)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(eqn_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -1596,7 +1596,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(1))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -1611,7 +1611,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1660,7 +1660,7 @@ contains & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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') @@ -1672,7 +1672,7 @@ contains & 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(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1806,7 +1806,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(sys_idx%E + i)%sf(j, k + q, l) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_L(1) = 1._wp @@ -1828,7 +1828,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(sys_idx%E + i)%sf(j, k + q, l) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k + q, l) end do else alpha_R(1) = 1._wp @@ -1885,84 +1885,84 @@ contains rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +1971,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%sf(j, k + q, l) + E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(sys_idx%E)%sf(j, k + q, l) + E_R = E_R + coeff_R(q)*q_cons_vf(eqn_idx%E)%sf(j, k + q, l) F_R = F_R + coeff_R(q)*jac(j, k + q, l) end do @@ -2038,7 +2038,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -2058,7 +2058,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2116,7 +2116,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(3))*(1._wp/dy(k + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k + 1, l) = rhs_vf(sys_idx%E)%sf(j, k + 1, & + rhs_vf(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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) @@ -2136,7 +2136,7 @@ contains & )*(1._wp/dy(k)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -2271,7 +2271,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(sys_idx%E + i)%sf(j, k, l + q) + alpha_L(i) = alpha_L(i) + coeff_L(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k, l + q) end do else alpha_L(1) = 1._wp @@ -2293,7 +2293,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(sys_idx%E + i)%sf(j, k, l + q) + alpha_R(i) = alpha_R(i) + coeff_R(q)*q_cons_vf(eqn_idx%E + i)%sf(j, k, l + q) end do else alpha_R(1) = 1._wp @@ -2350,84 +2350,84 @@ contains rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(1)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(2)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_L*vflux_L_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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, & & l) + real(0.5_wp*dt*mu_R*vflux_R_arr(3)*(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 +2436,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(sys_idx%E)%sf(j, k, l + q) + E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(sys_idx%E)%sf(j, k, l + q) + E_R = E_R + coeff_R(q)*q_cons_vf(eqn_idx%E)%sf(j, k, l + q) F_R = F_R + coeff_R(q)*jac(j, k, l + q) end do @@ -2503,7 +2503,7 @@ contains & - 0.5_wp*dt*cfl*(rho_L*vel_L(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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) @@ -2523,7 +2523,7 @@ contains & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2581,7 +2581,7 @@ contains & + 0.5_wp*dt*cfl*(rho_R*vel_R(2))*(1._wp/dz(l + 1)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l + 1) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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) @@ -2601,7 +2601,7 @@ contains & *(1._wp/dz(l)), kind=stp) $:GPU_ATOMIC(atomic='update') - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & + rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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_pressure_relaxation.fpp b/src/simulation/m_pressure_relaxation.fpp index 47d0aeed13..e30032717e 100644 --- a/src/simulation/m_pressure_relaxation.fpp +++ b/src/simulation/m_pressure_relaxation.fpp @@ -225,7 +225,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(sys_idx%E + 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) @@ -293,7 +293,7 @@ contains 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(sys_idx%E)%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 diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 5c6f98bbfb..fcc1c0c96f 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -559,7 +559,7 @@ contains do l = 0, p do q = 0, n do i = 0, m - rhs_vf(sys_idx%alf)%sf(i, q, l) = rhs_vf(sys_idx%alf)%sf(i, q, l) + mom_sp(2)%sf(i, q, l) + 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 = bubxb $:GPU_LOOP(parallelism='[seq]') do k = 1, nb @@ -764,8 +764,8 @@ 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(sys_idx%alf)%sf(id1, id2, id3) - pres = q_prim_vf(sys_idx%E)%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(contxb)%sf(id1, id2, id3) if (bubble_model == 2) then diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 4212c34f56..b77eeea2d2 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -127,7 +127,7 @@ 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 = sys_idx%mom%beg, sys_idx%E + 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 @@ -136,12 +136,12 @@ contains 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 = sys_idx%adv%end + 1, sys_size - 1 + do l = eqn_idx%adv%end + 1, sys_size - 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 = sys_idx%adv%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 +150,7 @@ contains if (.not. igr) then @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - do l = 1, sys_idx%cont%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 +162,7 @@ contains end if end do - do l = sys_idx%adv%beg, sys_idx%adv%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 +170,15 @@ contains end if if (surface_tension) then - q_prim_qp%vf(sys_idx%c)%sf => q_cons_qp%vf(sys_idx%c)%sf - $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(sys_idx%c)%sf]') - $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(sys_idx%c)%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(sys_idx%psi)%sf => q_cons_qp%vf(sys_idx%psi)%sf - $:GPU_ENTER_DATA(copyin='[q_prim_qp%vf(sys_idx%psi)%sf]') - $:GPU_ENTER_DATA(attach='[q_prim_qp%vf(sys_idx%psi)%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,17 +200,17 @@ contains end do if (viscous .or. surface_tension) then - do l = sys_idx%mom%beg, sys_idx%E + 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(sys_idx%adv%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 = sys_idx%adv%beg + 1, sys_idx%adv%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 @@ -222,7 +222,7 @@ contains & idwbuff(3)%beg:idwbuff(3)%end)) end do if (chem_params%diffusion .and. .not. viscous) then - @:ALLOCATE(flux_src_n(i)%vf(sys_idx%E)%sf(idwbuff(1)%beg:idwbuff(1)%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 @@ -238,8 +238,8 @@ contains if (i == 1) then if (riemann_solver /= 1) then - do l = sys_idx%adv%beg + 1, sys_idx%adv%end - flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(sys_idx%adv%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 +272,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 = sys_idx%mom%beg, sys_idx%mom%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, & @@ -335,19 +335,19 @@ contains if (viscous) then @:ALLOCATE(tau_Re_vf(1:sys_size)) do i = 1, num_dims - @:ALLOCATE(tau_Re_vf(sys_idx%cont%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(sys_idx%cont%end + i)) + @:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%cont%end + i)) end do - @:ALLOCATE(tau_Re_vf(sys_idx%E)%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(sys_idx%E)) + @: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 = sys_idx%mom%beg, sys_idx%mom%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 +355,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dx_qp(1)) if (n > 0) then - do l = sys_idx%mom%beg, sys_idx%mom%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 +363,7 @@ contains @:ACC_SETUP_VFs(dq_prim_dy_qp(1)) if (p > 0) then - do l = sys_idx%mom%beg, sys_idx%mom%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 +381,7 @@ contains end do do i = 1, num_dims - do l = sys_idx%mom%beg, sys_idx%mom%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 +389,7 @@ contains end do if (n > 0) then - do l = sys_idx%mom%beg, sys_idx%mom%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 +398,7 @@ contains end if if (p > 0) then - do l = sys_idx%mom%beg, sys_idx%mom%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 +412,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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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, sys_idx%mom%beg:sys_idx%mom%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 @@ -565,7 +565,7 @@ contains $: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(sys_idx%alf)%sf(j, k, l))/alf_sum%sf(j, k, l) + & 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 @@ -663,21 +663,21 @@ contains 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 = sys_idx%E; 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 = sys_idx%E - 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 = sys_idx%E; iv%end = sys_idx%E - call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(sys_idx%E), qL_rsx_vf, qL_rsy_vf, & + 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 = sys_idx%E + 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 @@ -685,11 +685,11 @@ contains 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 = sys_idx%E; iv%end = sys_idx%E - call s_reconstruct_cell_boundary_values_first_order(q_prim_qp%vf(sys_idx%E), qL_rsx_vf, qL_rsy_vf, & + 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 = sys_idx%E + 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 @@ -779,7 +779,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(sys_idx%psi)%sf(j, k, l) = rhs_vf(sys_idx%psi)%sf(j, k, l) - q_prim_vf(sys_idx%psi)%sf(j, & + 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 @@ -892,14 +892,14 @@ 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(sys_idx%E)%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(sys_idx%E)%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) if (bubbles_euler) then - alpha2(k_loop, l_loop, q_loop) = q_cons_vf%vf(sys_idx%alf - 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) end if @@ -947,7 +947,7 @@ contains 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(sys_idx%E)%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(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, & @@ -993,7 +993,7 @@ contains 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(sys_idx%E)%sf(q, k, l) + pressure_val = q_prim_vf%vf(eqn_idx%E)%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, & @@ -1089,7 +1089,7 @@ contains 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(sys_idx%E)%sf(l, q, k) + pressure_val = q_prim_vf%vf(eqn_idx%E)%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, & @@ -1362,8 +1362,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & - & l) + 1._wp/dx(j)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & + 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(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j - 1, k, l)) end do end do @@ -1378,7 +1378,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1392,9 +1392,9 @@ contains end do if (.not. viscous) then - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & - & l) + 1._wp/dx(j)*(flux_src_n_in(sys_idx%E)%sf(j - 1, k, & - & l) - flux_src_n_in(sys_idx%E)%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 @@ -1408,8 +1408,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & - & l) + 1._wp/dy(k)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & + 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(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j, k - 1, l)) end do end do @@ -1421,19 +1421,19 @@ contains if (viscous .or. dummy) then if (p > 0) then call s_compute_viscous_stress_cylindrical_boundary(q_prim_vf, & - & dq_prim_dx_vf(sys_idx%mom%beg:sys_idx%mom%end), dq_prim_dy_vf(sys_idx%mom%beg:sys_idx%mom%end), & - & dq_prim_dz_vf(sys_idx%mom%beg:sys_idx%mom%end), tau_Re_vf, idwbuff(1), idwbuff(2), idwbuff(3)) + & 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(sys_idx%mom%beg:sys_idx%mom%end), dq_prim_dy_vf(sys_idx%mom%beg:sys_idx%mom%end), & - & dq_prim_dz_vf(sys_idx%mom%beg:sys_idx%mom%end), tau_Re_vf, idwbuff(1), idwbuff(2), idwbuff(3)) + & 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, sys_idx%E + do i = momxb, 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 @@ -1447,7 +1447,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1463,7 +1463,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1476,9 +1476,9 @@ contains & k - 1, l) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & - & l) + 1._wp/dy(k)*(flux_src_n_in(sys_idx%E)%sf(j, k - 1, & - & l) - flux_src_n_in(sys_idx%E)%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 @@ -1496,7 +1496,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1510,7 +1510,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1523,7 +1523,7 @@ contains do k = 0, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1539,8 +1539,8 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(sys_idx%c)%sf(j, k, l) = rhs_vf(sys_idx%c)%sf(j, k, & - & l) + 1._wp/dz(l)*q_prim_vf(sys_idx%c)%sf(j, k, l)*(flux_src_n_in(advxb)%sf(j, k, & + 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(advxb)%sf(j, k, & & l) - flux_src_n_in(advxb)%sf(j, k, l - 1)) end do end do @@ -1555,7 +1555,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, sys_idx%E + do i = momxb, 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 @@ -1568,9 +1568,9 @@ contains & l - 1) - flux_src_n_in(i)%sf(j, k, l)) end do if (.not. viscous) then - rhs_vf(sys_idx%E)%sf(j, k, l) = rhs_vf(sys_idx%E)%sf(j, k, & - & l) + 1._wp/dz(l)*(flux_src_n_in(sys_idx%E)%sf(j, k, & - & l - 1) - flux_src_n_in(sys_idx%E)%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 @@ -1726,7 +1726,7 @@ contains call s_finalize_pressure_relaxation_module if (.not. igr) then - do j = sys_idx%cont%beg, sys_idx%cont%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) @@ -1736,11 +1736,11 @@ contains end if end do - do j = sys_idx%adv%beg, sys_idx%adv%end + do j = eqn_idx%adv%beg, eqn_idx%adv%end nullify (q_prim_qp%vf(j)%sf) end do - do j = sys_idx%mom%beg, sys_idx%E + 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 @@ -1760,17 +1760,17 @@ contains end if if (viscous) then - do l = sys_idx%mom%beg, sys_idx%mom%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 = sys_idx%mom%beg, sys_idx%mom%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 = sys_idx%mom%beg, sys_idx%mom%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf) end do end if @@ -1781,20 +1781,20 @@ contains @:DEALLOCATE(dq_prim_dz_qp(1)%vf) do i = num_dims, 1, -1 - do l = sys_idx%mom%beg, sys_idx%mom%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 = sys_idx%mom%beg, sys_idx%mom%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 = sys_idx%mom%beg, sys_idx%mom%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 @@ -1822,9 +1822,9 @@ contains if (cyl_coord) then do i = 1, num_dims - @:DEALLOCATE(tau_re_vf(sys_idx%cont%end + i)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%cont%end + i)%sf) end do - @:DEALLOCATE(tau_re_vf(sys_idx%E)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%E)%sf) @:DEALLOCATE(tau_re_vf) end if end if @@ -1852,26 +1852,26 @@ contains end do if (viscous) then - do l = sys_idx%mom%beg, sys_idx%E + 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(sys_idx%E)%sf) + @:DEALLOCATE(flux_src_n(i)%vf(eqn_idx%E)%sf) end if if (riemann_solver == 1 .or. riemann_solver == 4) then - do l = sys_idx%adv%beg + 1, sys_idx%adv%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 = sys_idx%adv%beg + 1, sys_idx%adv%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(sys_idx%adv%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 592341be67..36a1a7dadd 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -250,28 +250,28 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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, sys_idx%B%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%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, sys_idx%B%beg) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 2) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%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 @@ -446,8 +446,8 @@ contains end do if (cont_damage) then - G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 0._wp) - G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 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]') @@ -642,7 +642,7 @@ 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, & - & sys_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & 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 & @@ -651,12 +651,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, & - & sys_idx%E) = (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, & - & sys_idx%E) = (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,12 +667,12 @@ 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, & - & sys_idx%E) = (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, & - & sys_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & 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 @@ -723,7 +723,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 flux_rsx_vf(j, k, l, & - & sys_idx%B%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,26 +734,26 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 2 flux_rs${XYZ}$_vf(j, k, l, & - & sys_idx%B%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, sys_idx%B%beg + norm_dir - 1) = flux_rs${XYZ}$_vf(j, k, l, & - & sys_idx%B%beg + norm_dir - 1) + (s_M*qR_prim_rs${XYZ}$_vf(j + 1, k, & - & l, sys_idx%psi) - s_P*qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%psi))/(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, & - & sys_idx%psi) = (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, & - & sys_idx%psi) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & sys_idx%psi)))/(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, & - & sys_idx%B%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 @@ -764,7 +764,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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 @@ -932,28 +932,28 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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, sys_idx%B%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%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, sys_idx%B%beg) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg + 2) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%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 @@ -1126,8 +1126,8 @@ contains end do if (cont_damage) then - G_L = G_L*max((1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 0._wp) - G_R = G_R*max((1._wp - qR_prim_rs${XYZ}$_vf(j, k, l, sys_idx%damage)), 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 @@ -1259,7 +1259,7 @@ 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, & - & sys_idx%E) = (s_M*(vel_R(norm_dir)*(E_R + pres_R + pres_mag%R) & + & 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 & @@ -1268,12 +1268,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, & - & sys_idx%E) = (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, & - & sys_idx%E) = (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 @@ -1284,12 +1284,12 @@ 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, & - & sys_idx%E) = (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, & - & sys_idx%E) = (s_M*vel_R(dir_idx(1))*(E_R + pres_R) - s_P*vel_L(dir_idx(1)) & + & 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 @@ -1340,7 +1340,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 1 flux_rsx_vf(j, k, l, & - & sys_idx%B%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 @@ -1351,7 +1351,7 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 0, 2 flux_rs${XYZ}$_vf(j, k, l, & - & sys_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_M*(vel_R(dir_idx(1)) & + & 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) @@ -1364,7 +1364,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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 @@ -1409,8 +1409,8 @@ 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, sys_idx%E + i) - alpha_R(i) = qR_prim_rsx_vf(j + 1, k, l, sys_idx%E + 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]') @@ -1421,8 +1421,8 @@ contains 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, sys_idx%E + i) - alpha_R(i) = qR_prim_rsy_vf(k + 1, j, l, sys_idx%E + 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 @@ -1432,8 +1432,8 @@ contains else $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rsz_vf(l, k, j, sys_idx%E + i) - alpha_R(i) = qR_prim_rsz_vf(l + 1, k, j, sys_idx%E + 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]') @@ -1486,34 +1486,34 @@ contains if (norm_dir == 1) then flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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)) @@ -1525,31 +1525,31 @@ contains #: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, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(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, & & 3)) - 0.5_wp*(vel_grad_L(3, 2) + vel_grad_R(3, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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)) @@ -1560,29 +1560,29 @@ contains #: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, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(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, & & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, & & 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(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 @@ -1614,20 +1614,20 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_L(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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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, & & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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 @@ -1637,19 +1637,19 @@ contains #: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, & & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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, & & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(2) + vel_grad_R(3, 3)*vel_R(2)) end if #:endif @@ -1658,17 +1658,17 @@ contains #: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, & & l) - 0.5_wp*(vel_grad_L(1, 1) + vel_grad_R(1, 1)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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, & & l) - 0.5_wp*(vel_grad_L(2, 2) + vel_grad_R(2, 2)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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, 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, & & l) - 0.5_wp*(vel_grad_L(3, 3) + vel_grad_R(3, 3)) - flux_src_vf(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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(3) + vel_grad_R(3, 3)*vel_R(3)) #:endif end if @@ -1818,8 +1818,8 @@ contains vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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 @@ -1838,38 +1838,38 @@ 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, sys_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & - & l, sys_idx%E + i)), 1._wp) - alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + 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, sys_idx%E + i) = min(max(0._wp, & - & qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)), 1._wp) - alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%E + i)/max(alpha_L_sum, sgm_eps) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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) @@ -1885,8 +1885,8 @@ 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, sys_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, sys_idx%E + Re_idx(i, q))/Res_gs(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) @@ -2073,7 +2073,7 @@ contains 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, sys_idx%E) = (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 @@ -2091,7 +2091,7 @@ 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, sys_idx%E) = flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) + 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. @@ -2157,8 +2157,8 @@ contains ! COLOR FUNCTION FLUX if (surface_tension) then - flux_rs${XYZ}$_vf(j, k, l, sys_idx%c) = (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%c) + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%c))*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 @@ -2166,7 +2166,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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]') @@ -2235,13 +2235,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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]') @@ -2257,8 +2257,8 @@ contains qv_R = qv_R + alpha_rho_R(i)*qvs(i) end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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 @@ -2346,10 +2346,10 @@ contains end do end if - flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = sys_idx%alf, sys_idx%alf ! 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)) @@ -2381,7 +2381,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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 @@ -2440,8 +2440,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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 @@ -2459,24 +2459,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, sys_idx%E + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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 @@ -2502,9 +2502,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, sys_idx%E + 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, sys_idx%E + Re_idx(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 @@ -2514,8 +2514,8 @@ contains end if end if - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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 @@ -2539,8 +2539,8 @@ contains if (.not. qbmm) then if (adv_n) then - nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%n) - nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%n) + 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 @@ -2550,9 +2550,9 @@ 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, sys_idx%E + num_fluids)/nbub_L + 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, & - & sys_idx%E + num_fluids)/nbub_R + & eqn_idx%E + num_fluids)/nbub_R end if else ! nb stored in 0th moment of first R0 bin in variable conversion module @@ -2723,7 +2723,7 @@ contains ! 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, & - & sys_idx%E) = 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)) & @@ -2767,7 +2767,7 @@ contains if (adv_n) then flux_rs${XYZ}$_vf(j, k, l, & - & sys_idx%n) = 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 @@ -2776,7 +2776,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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 @@ -2837,8 +2837,8 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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]') @@ -2849,42 +2849,42 @@ contains vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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, sys_idx%E + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, & - & l, sys_idx%E + 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, sys_idx%E + i) = min(max(0._wp, & - & qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i)), 1._wp) - alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E + i) = qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%E + i)/max(alpha_L_sum, sgm_eps) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, & - & sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_L = pi_inf_L + qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + 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, sys_idx%E + i)*gammas(i) - pi_inf_R = pi_inf_R + qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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 @@ -3139,7 +3139,7 @@ contains ! 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, & - & sys_idx%E) = 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)) & @@ -3161,7 +3161,7 @@ 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, sys_idx%E) = flux_rs${XYZ}$_vf(j, k, l, sys_idx%E) + 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. @@ -3194,10 +3194,10 @@ contains ! COLOR FUNCTION FLUX if (surface_tension) then - flux_rs${XYZ}$_vf(j, k, l, sys_idx%c) = xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%c)*(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, & - & sys_idx%c)*(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 @@ -3231,7 +3231,7 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux $:GPU_LOOP(parallelism='[seq]') - do i = 1, sys_idx%E + 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 @@ -3380,28 +3380,28 @@ contains vel_rms%R = sum(vel%R**2._wp) do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, sys_idx%E + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E + 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, sys_idx%E) - pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%E) + 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, sys_idx%B%beg), qL_prim_rs${XYZ}$_vf(j, k, l, & - & sys_idx%B%beg + 1)] - B%R = [Bx0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg), qR_prim_rs${XYZ}$_vf(j + 1, k, & - & l, sys_idx%B%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, sys_idx%B%beg + dir_idx(1) - 1), qL_prim_rs${XYZ}$_vf(j, & - & k, l, sys_idx%B%beg + dir_idx(2) - 1), qL_prim_rs${XYZ}$_vf(j, & - & k, l, sys_idx%B%beg + dir_idx(3) - 1)] - B%R = [qR_prim_rs${XYZ}$_vf(j + 1, k, l, sys_idx%B%beg + dir_idx(1) - 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, & - & sys_idx%B%beg + dir_idx(2) - 1), qR_prim_rs${XYZ}$_vf(j + 1, k, & - & l, sys_idx%B%beg + dir_idx(3) - 1)] + & 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 @@ -3527,14 +3527,14 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(3)) = F_hlld(4) ! Magnetic field if (n == 0) then - flux_rs${XYZ}$_vf(j, k, l, sys_idx%B%beg) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, sys_idx%B%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, sys_idx%B%beg + dir_idx(2) - 1) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, sys_idx%B%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, sys_idx%E) = 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 @@ -3981,7 +3981,7 @@ contains if (norm_dir == 1) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, sys_idx%E + do i = momxb, eqn_idx%E do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -3995,11 +3995,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = sys_idx%E, chemxe + do i = eqn_idx%E, chemxe do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - if (i == sys_idx%E .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(j, k, l) = 0._wp end if end do @@ -4027,7 +4027,7 @@ contains else if (norm_dir == 2) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, sys_idx%E + do i = momxb, eqn_idx%E do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4041,11 +4041,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = sys_idx%E, chemxe + do i = eqn_idx%E, chemxe do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end - if (i == sys_idx%E .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(k, j, l) = 0._wp end if end do @@ -4073,7 +4073,7 @@ contains else if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, sys_idx%E + do i = momxb, eqn_idx%E do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4087,11 +4087,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = sys_idx%E, chemxe + do i = eqn_idx%E, chemxe do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end - if (i == sys_idx%E .or. i >= chemxb) then + if (i == eqn_idx%E .or. i >= chemxb) then flux_src_vf(i)%sf(l, k, j) = 0._wp end if end do @@ -4270,7 +4270,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, & + 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 @@ -4280,7 +4280,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, & + 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 @@ -4390,7 +4390,7 @@ contains 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(sys_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(sys_idx%E)%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 @@ -4403,7 +4403,7 @@ contains 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(sys_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(sys_idx%E)%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 diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index 09fff2990e..e246238d4a 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -121,10 +121,10 @@ contains end do if (igr) then - E = q_prim_vf(sys_idx%E)%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(sys_idx%E)%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 diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 7eb8c9c5ae..d234e4640b 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 ! sys_idx%adv%end + do i = 1, sys_size ! eqn_idx%adv%end 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 ! sys_idx%adv%end + do i = 1, sys_size ! eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -569,7 +569,7 @@ contains call s_convert_to_mixture_variables(v_vf, j, k, l, rho, gamma, pi_inf, qv, Re) dyn_pres = 0._wp - do i = sys_idx%mom%beg, sys_idx%mom%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 @@ -581,14 +581,14 @@ contains if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + v_vf(sys_idx%B%beg)%sf(j, k, l)**2 + v_vf(sys_idx%B%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(sys_idx%B%beg)%sf(j, k, l)**2 + v_vf(sys_idx%B%beg + 1)%sf(j, k, & - & l)**2 + v_vf(sys_idx%B%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(sys_idx%E)%sf(j, k, l), 0._stp, dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres, & + 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 @@ -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. sys_idx%adv%end > 20 .and. (.not. chemistry), & - & "CBC module with AMD compiler requires sys_idx%adv%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, sys_idx%n, 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,7 +1046,7 @@ contains end if end if - $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, sys_idx%n, pi_fac, low_Mach]') + $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, eqn_idx%n, pi_fac, low_Mach]') $:GPU_UPDATE(device='[acoustic_source, num_source]') $:GPU_UPDATE(device='[sigma, surface_tension]') diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 08e217d4cb..06bb5e06cf 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -115,12 +115,12 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) + Omega(1, & + 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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_rsx_vf(j, k, l, 1) end if end do @@ -157,11 +157,11 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) + Omega(2, & + 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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 @@ -199,11 +199,11 @@ contains 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%sf(j, k, l) + Omega(3, & + 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(sys_idx%E)%sf(j, k, l) = flux_src_vf(sys_idx%E)%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 +234,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(sys_idx%c)%sf(j + 1, k, & - & l) - q_prim_vf(sys_idx%c)%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 +245,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(sys_idx%c)%sf(j, k + 1, & - & l) - q_prim_vf(sys_idx%c)%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 +257,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(sys_idx%c)%sf(j, k, & - & l + 1) - q_prim_vf(sys_idx%c)%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 diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index ea81d779e0..cd296bcc06 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, sys_idx%adv%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 = sys_idx%bub%beg, sys_idx%bub%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(sys_idx%n)%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(sys_idx%n)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%n)) end if end if if (mhd) then - do i = sys_idx%B%beg, sys_idx%B%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 = sys_idx%stress%beg, sys_idx%stress%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)) @@ -267,19 +267,19 @@ contains end if if (cont_damage) then - @:ALLOCATE(q_prim_vf(sys_idx%damage)%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(sys_idx%damage)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%damage)) end if if (hyper_cleaning) then - @:ALLOCATE(q_prim_vf(sys_idx%psi)%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(sys_idx%psi)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%psi)) end if if (model_eqns == 3) then - do i = sys_idx%int_en%beg, sys_idx%int_en%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,9 +287,9 @@ contains end if if (surface_tension) then - @:ALLOCATE(q_prim_vf(sys_idx%c)%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(sys_idx%c)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%c)) end if if (chemistry) then @@ -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, sys_idx%E + do i = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -915,18 +915,18 @@ contains if (.not. igr) then ! Deallocating the cell-average primitive variables - do i = 1, sys_idx%adv%end + do i = 1, eqn_idx%adv%end @:DEALLOCATE(q_prim_vf(i)%sf) end do if (mhd) then - do i = sys_idx%B%beg, sys_idx%B%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 = sys_idx%stress%beg, sys_idx%stress%end + do i = eqn_idx%stress%beg, eqn_idx%stress%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if @@ -938,21 +938,21 @@ contains end if if (cont_damage) then - @:DEALLOCATE(q_prim_vf(sys_idx%damage)%sf) + @:DEALLOCATE(q_prim_vf(eqn_idx%damage)%sf) end if if (hyper_cleaning) then - @:DEALLOCATE(q_prim_vf(sys_idx%psi)%sf) + @:DEALLOCATE(q_prim_vf(eqn_idx%psi)%sf) end if if (bubbles_euler) then - do i = sys_idx%bub%beg, sys_idx%bub%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 = sys_idx%int_en%beg, sys_idx%int_en%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 76a6342b89..c0df5e853a 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, sys_idx%E + do i = momxb, 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(sys_idx%E + 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(sys_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -172,7 +172,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & & k, l)*tau_Re(2, i) end do end do @@ -193,9 +193,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(sys_idx%E + 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(sys_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -269,7 +269,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do @@ -290,9 +290,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(sys_idx%E + 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(sys_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -370,7 +370,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(contxe + i)%sf(j, & & k, l)*tau_Re(2, i) end do end do @@ -389,9 +389,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(sys_idx%E + 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(sys_idx%E + i)%sf(j, k, l) + alpha_visc(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end if end do @@ -464,7 +464,7 @@ contains 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(sys_idx%E)%sf(j, k, l) = tau_Re_vf(sys_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & + tau_Re_vf(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%sf(j, k, l) - q_prim_vf(momxb + 1)%sf(j, k, & & l)*tau_Re(2, 2) end do end do @@ -494,7 +494,7 @@ contains integer :: i, j, k, l do i = 1, num_dims - iv%beg = sys_idx%mom%beg; iv%end = sys_idx%mom%end + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end $:GPU_UPDATE(device='[iv]') @@ -521,7 +521,7 @@ contains end if end do else ! Compute velocity gradients at cell centers using central finite differences - iv%beg = sys_idx%mom%beg; iv%end = sys_idx%mom%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 From a4c18bd58aa3ede8ed5c9accd441671540992a9d Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 20:50:54 -0400 Subject: [PATCH 08/17] refactor: replace fragile sys_size bounds with explicit eqn_idx references In m_rhs.fpp, replace 'sys_size - 1' with 'eqn_idx%c - 1' when surface_tension is active and remove the comment noting the fragile assumption (eqn_idx%c makes the intent explicit). In m_start_up.fpp, remove misleading '! eqn_idx%adv%end' comments on restart loops that correctly iterate over all sys_size variables. --- src/simulation/m_rhs.fpp | 4 +--- src/simulation/m_start_up.fpp | 4 ++-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index b77eeea2d2..23309d6d52 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -134,9 +134,7 @@ contains 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 = eqn_idx%adv%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 diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index d234e4640b..76df3c50ab 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 ! eqn_idx%adv%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 ! eqn_idx%adv%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) From 6e7e1480c99f7f8ab09c053caf15b5706a7e9a32 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 21:32:27 -0400 Subject: [PATCH 09/17] fix: address PR review findings from eqn-idx-refactor - Add GPU_UPDATE for bc_x/y/z%beg/end so CBC device kernels see correct BC codes (was broken: old code extracted to scalars + updated, new code accessed struct members that were never synced to device) - Add matching @:DEALLOCATE/@deallocate for qbmm_idx%rs/vs/ps/ms/moms in s_finalize_global_parameters_module for all three targets - Remove GPU_DECLARE(create='[qbmm_idx]'): struct has allocatable members and is never accessed directly on device; members are always copied to local arrays before GPU use - Remove redundant eqn_idx%n from secondary GPU_UPDATE (already covered by full eqn_idx struct update in s_initialize_global_parameters_module) - Remove stale claude-code-review.yml from repo root (live copy is in .github/workflows/) --- claude-code-review.yml | 315 ----------------------- src/post_process/m_global_parameters.fpp | 5 + src/pre_process/m_global_parameters.fpp | 5 + src/simulation/m_global_parameters.fpp | 6 +- src/simulation/m_start_up.fpp | 3 +- 5 files changed, 17 insertions(+), 317 deletions(-) delete mode 100644 claude-code-review.yml diff --git a/claude-code-review.yml b/claude-code-review.yml deleted file mode 100644 index 8493c7a77c..0000000000 --- a/claude-code-review.yml +++ /dev/null @@ -1,315 +0,0 @@ -name: Claude Code Review - -on: - pull_request_target: - types: [opened, ready_for_review, reopened, labeled] - issue_comment: - types: [created] - -jobs: - claude-review: - if: > - ( - github.event_name == 'pull_request_target' && - ( - github.event.action == 'opened' || - github.event.action == 'ready_for_review' || - github.event.action == 'reopened' || - ( - github.event.action == 'labeled' && - github.event.label.name == 'claude-full-review' - ) - ) - ) || - ( - github.event_name == 'issue_comment' && - github.event.issue.pull_request != null && - contains(github.event.comment.body, '@claude full review') - ) - runs-on: ubuntu-latest - permissions: - contents: read - pull-requests: write - issues: write - actions: read - - steps: - - name: Install dependencies - shell: bash - run: | - set -euo pipefail - sudo apt-get update - sudo apt-get install -y unzip jq - - - name: Determine PR number - id: mode - shell: bash - run: | - set -euo pipefail - - if [[ "${{ github.event_name }}" == "pull_request_target" ]]; then - PR_NUMBER="${{ github.event.pull_request.number }}" - elif [[ "${{ github.event_name }}" == "issue_comment" ]]; then - PR_NUMBER="${{ github.event.issue.number }}" - else - echo "Unsupported event" - exit 1 - fi - - echo "pr_number=$PR_NUMBER" >> "$GITHUB_OUTPUT" - - - name: Checkout base repo - uses: actions/checkout@v4 - with: - fetch-depth: 0 - - - name: Resolve review state - id: state - shell: bash - env: - GH_TOKEN: ${{ github.token }} - run: | - set -euo pipefail - - PR_NUMBER="${{ steps.mode.outputs.pr_number }}" - REPO="${{ github.repository }}" - - mkdir -p .claude-review/context - - CURRENT_HEAD_SHA="$(gh pr view "$PR_NUMBER" --repo "$REPO" --json headRefOid --jq .headRefOid)" - echo "current_head_sha=$CURRENT_HEAD_SHA" >> "$GITHUB_OUTPUT" - - LAST_COMMENT_B64="$( - gh api --paginate "repos/$REPO/issues/$PR_NUMBER/comments?per_page=100" \ - --jq '.[] | select(.body | contains(" - - - Always include the hidden marker exactly once at the end of the file. - - If there are no findings, write nothing. - - - name: Publish review comment - shell: bash - env: - GH_TOKEN: ${{ github.token }} - run: | - set -euo pipefail - - PR_NUMBER="${{ steps.mode.outputs.pr_number }}" - REPO="${{ github.repository }}" - COMMENT_ID="${{ steps.state.outputs.existing_comment_id }}" - OUTPUT_FILE=".claude-review/output.md" - - if [[ ! -f "$OUTPUT_FILE" ]]; then - echo "No output file; nothing to publish." - exit 0 - fi - - if [[ ! -s "$OUTPUT_FILE" ]] || [[ -z "$(tr -d '[:space:]' < "$OUTPUT_FILE")" ]]; then - echo "Review output is empty; not posting a comment." - exit 0 - fi - - BODY_JSON="$(jq -Rs '{body: .}' < "$OUTPUT_FILE")" - - if [[ -n "${COMMENT_ID:-}" ]]; then - gh api \ - --method PATCH \ - "repos/$REPO/issues/comments/$COMMENT_ID" \ - --input - <<< "$BODY_JSON" >/dev/null - echo "Updated existing primary review comment: $COMMENT_ID" - else - gh api \ - --method POST \ - "repos/$REPO/issues/$PR_NUMBER/comments" \ - --input - <<< "$BODY_JSON" >/dev/null - echo "Created new primary review comment." - fi - - - name: Fallback job summary on failure - if: failure() - shell: bash - run: | - set -euo pipefail - if [[ -f .claude-review/output.md ]] && [[ -s .claude-review/output.md ]]; then - { - echo "## Claude Code Review" - echo - cat .claude-review/output.md - } >> "$GITHUB_STEP_SUMMARY" - fi diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 17e60a8194..630b1a794c 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -919,6 +919,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/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 0a6e6b6494..7137145d5c 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -894,6 +894,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/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index f04e2ef37b..e5c6d7ed3c 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -256,7 +256,6 @@ module m_global_parameters integer :: tensor_size !< Number of elements in the full tensor plus one !> @} $:GPU_DECLARE(create='[sys_size, eqn_idx, b_size, tensor_size]') - $:GPU_DECLARE(create='[qbmm_idx]') ! 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) @@ -1308,6 +1307,11 @@ 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) @:deallocate(qbmm_idx%moms) + end if + deallocate (proc_coords) if (parallel_io) then deallocate (start_idx) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 76df3c50ab..2a8f7e28a1 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1046,12 +1046,13 @@ contains end if end if - $:GPU_UPDATE(device='[adv_n, adap_dt, adap_dt_tol, adap_dt_max_iters, eqn_idx%n, 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]') From 6737414789ef3618929515528290dc1adb15e17c Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 9 Apr 2026 22:10:59 -0400 Subject: [PATCH 10/17] fix: use then/end if with @:DEALLOCATE macro for qbmm_idx%moms Single-line 'if (qbmm) @:DEALLOCATE(...)' is invalid because the macro expands to multiple statements. Use explicit then/end if block instead. --- src/simulation/m_global_parameters.fpp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index e5c6d7ed3c..889c7c9a5c 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -1309,7 +1309,9 @@ contains if (bubbles_euler) then @:DEALLOCATE(qbmm_idx%rs, qbmm_idx%vs, qbmm_idx%ps, qbmm_idx%ms) - if (qbmm) @:deallocate(qbmm_idx%moms) + if (qbmm) then + @:DEALLOCATE(qbmm_idx%moms) + end if end if deallocate (proc_coords) From 5bb8b8dc395364a1e86cba4076f2a54b05bf9486 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 08:27:36 -0400 Subject: [PATCH 11/17] fix: update QPVF_IDX_VARS in case.py to use eqn_idx references E_idx, stress_idx%beg, c_idx, B_idx%beg/end were renamed as part of the eqn_idx refactor but QPVF_IDX_VARS in case.py (used to generate Fortran index expressions for case-optimization builds) was not updated, causing pre_process build failures in case-opt CI jobs. --- toolchain/mfc/case.py | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 48de3fa5cb..925058478d 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -21,18 +21,18 @@ 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", + "pres": "eqn_idx%E", "alpha": "advxb", - "tau_e": "stress_idx%beg", + "tau_e": "eqn_idx%stress%beg", "Y": "chemxb", - "cf_val": "c_idx", - "Bx": "B_idx%beg", - "By": "B_idx%end-1", - "Bz": "B_idx%end", + "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) From 8c93ebce4152f86776a14e7bb094c44492b6de25 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 08:40:32 -0400 Subject: [PATCH 12/17] refactor: replace shorthand contxb/momxb/advxb/chemxb with eqn_idx references in QPVF_IDX_VARS --- toolchain/mfc/case.py | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/toolchain/mfc/case.py b/toolchain/mfc/case.py index 925058478d..65c49f8304 100644 --- a/toolchain/mfc/case.py +++ b/toolchain/mfc/case.py @@ -19,12 +19,12 @@ def _suggest_similar_params(unknown_key: str, valid_keys: list, n: int = 3) -> l QPVF_IDX_VARS = { - "alpha_rho": "contxb", - "vel": "momxb", + "alpha_rho": "eqn_idx%cont%beg", + "vel": "eqn_idx%mom%beg", "pres": "eqn_idx%E", - "alpha": "advxb", + "alpha": "eqn_idx%adv%beg", "tau_e": "eqn_idx%stress%beg", - "Y": "chemxb", + "Y": "eqn_idx%species%beg", "cf_val": "eqn_idx%c", "Bx": "eqn_idx%B%beg", "By": "eqn_idx%B%end-1", From 9d45f6c18c46a52a720aef414739fd144e05f150 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 10:32:44 -0400 Subject: [PATCH 13/17] refactor: replace shorthand index variables with eqn_idx references throughout src/ --- src/common/include/1dHardcodedIC.fpp | 22 +- src/common/include/2dHardcodedIC.fpp | 129 ++-- src/common/include/3dHardcodedIC.fpp | 56 +- src/common/include/ExtrusionHardcodedIC.fpp | 12 +- src/common/m_boundary_common.fpp | 92 +-- src/common/m_chemistry.fpp | 127 ++-- src/common/m_phase_change.fpp | 101 +-- src/common/m_variables_conversion.fpp | 120 ++-- src/post_process/m_global_parameters.fpp | 24 - src/post_process/m_start_up.fpp | 4 +- src/pre_process/m_assign_variables.fpp | 22 +- src/pre_process/m_data_output.fpp | 23 +- src/pre_process/m_global_parameters.fpp | 27 +- src/pre_process/m_perturbation.fpp | 15 +- src/simulation/m_acoustic_src.fpp | 8 +- src/simulation/m_body_forces.fpp | 20 +- src/simulation/m_bubbles_EE.fpp | 17 +- src/simulation/m_bubbles_EL.fpp | 10 +- src/simulation/m_cbc.fpp | 144 +++-- src/simulation/m_compute_cbc.fpp | 36 +- src/simulation/m_data_output.fpp | 14 +- src/simulation/m_derived_variables.fpp | 97 +-- src/simulation/m_global_parameters.fpp | 27 +- src/simulation/m_hyperelastic.fpp | 7 +- src/simulation/m_hypoelastic.fpp | 176 ++--- src/simulation/m_ibm.fpp | 64 +- src/simulation/m_igr.fpp | 534 +++++++++------- src/simulation/m_muscl.fpp | 32 +- src/simulation/m_pressure_relaxation.fpp | 44 +- src/simulation/m_qbmm.fpp | 67 +- src/simulation/m_rhs.fpp | 183 +++--- src/simulation/m_riemann_solvers.fpp | 675 +++++++++++--------- src/simulation/m_sim_helpers.fpp | 4 +- src/simulation/m_start_up.fpp | 6 +- src/simulation/m_surface_tension.fpp | 9 +- src/simulation/m_time_steppers.fpp | 4 +- src/simulation/m_viscous.fpp | 48 +- 37 files changed, 1547 insertions(+), 1453 deletions(-) diff --git a/src/common/include/1dHardcodedIC.fpp b/src/common/include/1dHardcodedIC.fpp index c522b230f2..3a382caaed 100644 --- a/src/common/include/1dHardcodedIC.fpp +++ b/src/common/include/1dHardcodedIC.fpp @@ -7,8 +7,8 @@ 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(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i)) @@ -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(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(advxb)%sf(i, 0, 0) = 1.0_wp + 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 5df3a9125f..a1fc9d297a 100644 --- a/src/common/include/2dHardcodedIC.fpp +++ b/src/common/include/2dHardcodedIC.fpp @@ -21,10 +21,10 @@ 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(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) @@ -36,16 +36,16 @@ 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(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(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(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 @@ -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(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(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(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(eqn_idx%E)%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,16 +89,16 @@ 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(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(eqn_idx%E)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if @@ -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(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(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%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(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(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%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,31 +145,31 @@ 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(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(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(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(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 @@ -186,27 +186,27 @@ ! 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(eqn_idx%B%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi) @@ -247,17 +247,17 @@ 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(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(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 @@ -273,13 +273,13 @@ 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 @@ -289,7 +289,7 @@ if (patch_id == 2) then 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 @@ -298,11 +298,12 @@ if (patch_id == 2) then 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 f96a130532..6f4be25f56 100644 --- a/src/common/include/3dHardcodedIC.fpp +++ b/src/common/include/3dHardcodedIC.fpp @@ -84,16 +84,16 @@ 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(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(eqn_idx%E)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if @@ -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(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(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%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,16 +126,16 @@ 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(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am @@ -152,16 +152,16 @@ 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(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am @@ -175,8 +175,8 @@ if (patch_id == 1) then 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 6b58ca2c00..c374d8710c 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 @@ -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 @@ -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 @@ -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 @@ -483,11 +483,11 @@ 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 = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, l, -j) = q_prim_vf(i)%sf(k, l, j - 1) @@ -517,11 +517,11 @@ 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 = eqn_idx%E, sys_size q_prim_vf(i)%sf(k, l, p + j) = q_prim_vf(i)%sf(k, l, p - (j - 1)) @@ -687,25 +687,25 @@ 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 = 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 = 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)) @@ -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) diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index b1b3e1ee89..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. eqn_idx%E = \rho E cons. contxb = \rho (1-fluid model) cons. momxb + i = \rho u_i - energy = q_cons_vf(eqn_idx%E)%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,8 +96,8 @@ 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) @@ -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 @@ -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,25 +297,28 @@ 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 @@ -316,8 +328,9 @@ contains 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 @@ -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,8 +414,9 @@ 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 @@ -408,8 +424,9 @@ contains 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_phase_change.fpp b/src/common/m_phase_change.fpp index 3fc9e0bd9c..7f9131550d 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -104,29 +104,29 @@ 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 @@ -140,17 +140,17 @@ contains 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 a6142f422b..7788ac4cb1 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -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, & @@ -546,21 +546,21 @@ contains 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(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 @@ -595,7 +595,8 @@ contains ! 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 @@ -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) @@ -689,16 +690,16 @@ contains 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 @@ -709,7 +710,7 @@ contains 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 @@ -724,7 +725,7 @@ contains 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 @@ -732,7 +733,7 @@ contains if (hypoelasticity) then 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(eqn_idx%E)%sf(j, k, l) = qK_prim_vf(eqn_idx%E)%sf(j, k, l) - ((qK_prim_vf(i)%sf(j, k, & @@ -755,7 +756,7 @@ contains 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 @@ -836,7 +837,7 @@ contains 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') @@ -853,21 +854,22 @@ contains 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(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 + 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 @@ -879,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 @@ -887,15 +889,15 @@ 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 @@ -933,9 +935,9 @@ contains ! 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, & + 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 + contxb - 1)%sf(j, k, l)*qvs(i) + & l) + pi_infs(i)) + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i) end do end if @@ -976,14 +978,14 @@ contains 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(eqn_idx%damage)%sf(j, k, l)), 0._wp) - do i = strxb, strxe + do i = eqn_idx%stress%beg, eqn_idx%stress%end ! adding elastic contribution if (G > verysmall) then 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, & @@ -1026,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 @@ -1073,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 + 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 @@ -1105,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) @@ -1121,13 +1123,15 @@ 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) @@ -1137,25 +1141,25 @@ contains 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 - eqn_idx%E) end do else ! Could be bubbles_euler! $:GPU_LOOP(parallelism='[seq]') - do i = advxb, advxe + 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 @@ -1182,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 @@ -1214,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_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 630b1a794c..49366baac3 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -262,17 +262,7 @@ 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 !> @{ @@ -751,22 +741,8 @@ contains z_output_idx%end = 0 end if - momxb = eqn_idx%mom%beg - momxe = eqn_idx%mom%end - advxb = eqn_idx%adv%beg - advxe = eqn_idx%adv%end - contxb = eqn_idx%cont%beg - contxe = eqn_idx%cont%end - bubxb = eqn_idx%bub%beg - bubxe = eqn_idx%bub%end - strxb = eqn_idx%stress%beg - strxe = eqn_idx%stress%end - intxb = eqn_idx%int_en%beg - intxe = eqn_idx%int_en%end xibeg = eqn_idx%xi%beg xiend = eqn_idx%xi%end - chemxb = eqn_idx%species%beg - chemxe = eqn_idx%species%end #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index bd120ade8c..03487663b1 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -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) @@ -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) diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index b3924d52fa..cb37b30652 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -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 @@ -152,8 +152,8 @@ contains 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(eqn_idx%E)%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,14 +161,14 @@ 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 @@ -446,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 @@ -455,8 +455,8 @@ 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 diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index ead7d8f1a3..ebe244bd30 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,10 +176,11 @@ 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 >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) .or. ((i >= eqn_idx%adv%beg) & - & .and. (i <= eqn_idx%adv%end)) .or. ((i >= chemxb) .and. (i <= chemxe))) then + & .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 == eqn_idx%mom%beg) then ! u write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)/rho @@ -207,7 +208,7 @@ contains end if 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(eqn_idx%n)%sf(j, 0, 0) @@ -618,22 +619,22 @@ contains write (iu, '(A3,A20,A20)') "#", "Conservative", "Primitive" write (iu, '(A)') " " - do i = contxb, contxe - write (temp, '(I0)') i - contxb + 1 + 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 (iu, '(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 if (eqn_idx%E /= 0) write (iu, '(I3,A20,A20)') eqn_idx%E, "\rho U", "p" - do i = advxb, advxe - write (temp, '(I0)') i - contxb + 1 + 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 (iu, '(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 diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 7137145d5c..34e1f844f6 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -180,18 +180,7 @@ 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 :: xibeg, xiend integer, allocatable, dimension(:,:,:) :: logic_grid type(pres_field) :: pb type(pres_field) :: mv @@ -788,22 +777,8 @@ contains sys_size = eqn_idx%species%end end if - momxb = eqn_idx%mom%beg - momxe = eqn_idx%mom%end - advxb = eqn_idx%adv%beg - advxe = eqn_idx%adv%end - contxb = eqn_idx%cont%beg - contxe = eqn_idx%cont%end - bubxb = eqn_idx%bub%beg - bubxe = eqn_idx%bub%end - strxb = eqn_idx%stress%beg - strxe = eqn_idx%stress%end - intxb = eqn_idx%int_en%beg - intxe = eqn_idx%int_en%end xibeg = eqn_idx%xi%beg xiend = eqn_idx%xi%end - chemxb = eqn_idx%species%beg - chemxe = eqn_idx%species%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) diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 0f47a1581a..6c3b74ad3b 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -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/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 55136ec77f..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 @@ -315,12 +315,12 @@ 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + e_src(j, k, l) end do diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index d649782326..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, eqn_idx%E + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 1abba408d6..a15156405b 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -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 @@ -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 @@ -304,7 +304,8 @@ contains do q = 0, n do i = 0, m 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(advxb)%sf(i, q, l) = rhs_vf(advxb)%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 856d041c42..b44eb617b1 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -279,7 +279,7 @@ 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(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, & @@ -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(eqn_idx%E)%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 @@ -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 diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 7d5788fede..d703a3c1e3 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -545,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, & @@ -578,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 @@ -605,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 @@ -623,21 +623,21 @@ contains pres = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E) $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E + 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) @@ -669,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 @@ -680,7 +680,7 @@ contains dpres_ds = 0._wp $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E + do i = 1, eqn_idx%adv%end - eqn_idx%E dadv_ds(i) = 0._wp end do @@ -694,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, eqn_idx%E)*fd_coef_${XYZ}$ (j, cbc_loc) + dpres_ds $:GPU_LOOP(parallelism='[seq]') - do i = 1, advxe - eqn_idx%E + 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 @@ -737,22 +738,25 @@ contains ! 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 = eqn_idx%E, advxe - 1 + 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}$%beg == BC_CHAR_NR_SUB_OUTFLOW) & @@ -761,12 +765,12 @@ contains & 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}$%beg == BC_CHAR_FF_SUB_OUTFLOW) & @@ -788,20 +792,20 @@ contains ! 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 @@ -813,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 - eqn_idx%E - 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 - eqn_idx%E - 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 @@ -850,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 @@ -881,8 +885,8 @@ contains & /(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, eqn_idx%E) = flux_rs${XYZ}$_vf_l(0, k, r, & @@ -892,12 +896,12 @@ contains 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, & @@ -905,12 +909,12 @@ contains end do else $: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) = 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 @@ -975,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 @@ -997,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 @@ -1005,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 @@ -1020,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 @@ -1048,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 @@ -1071,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 @@ -1079,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 @@ -1094,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 @@ -1122,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 @@ -1144,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 @@ -1152,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 @@ -1167,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 @@ -1209,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 @@ -1217,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 @@ -1232,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 @@ -1259,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 @@ -1267,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 @@ -1282,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 @@ -1310,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 @@ -1318,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 @@ -1333,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 713f20d2d8..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 = eqn_idx%E, 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 77b7a1b083..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 @@ -628,7 +629,8 @@ contains do k = 0, n do l = 0, p 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 >= chemxb) .and. (i <= chemxe))) then + & .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 @@ -1142,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 @@ -1254,7 +1256,7 @@ contains 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 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 889c7c9a5c..caf863ff67 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -427,17 +427,7 @@ 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 @@ -1183,25 +1173,10 @@ contains grid_geometry = 3 end if - momxb = eqn_idx%mom%beg - momxe = eqn_idx%mom%end - advxb = eqn_idx%adv%beg - advxe = eqn_idx%adv%end - contxb = eqn_idx%cont%beg - contxe = eqn_idx%cont%end - bubxb = eqn_idx%bub%beg - bubxe = eqn_idx%bub%end - strxb = eqn_idx%stress%beg - strxe = eqn_idx%stress%end - intxb = eqn_idx%int_en%beg - intxe = eqn_idx%int_en%end xibeg = eqn_idx%xi%beg xiend = eqn_idx%xi%end - chemxb = eqn_idx%species%beg - chemxe = eqn_idx%species%end - $:GPU_UPDATE(device='[momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, & - & eqn_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, adap_dt_tol, adap_dt_max_iters]') + $: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, xibeg, xiend, tensor_size]') $:GPU_UPDATE(device='[cfl_target, m, n, p]') diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e8793517a9..a7cbf8003b 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -178,7 +178,8 @@ contains ! 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,7 +211,7 @@ 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) @@ -239,7 +240,7 @@ 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) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 4ab774f4da..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,7 +190,7 @@ 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] @@ -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 diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 9e942cff5b..68f6615e3e 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,7 +165,7 @@ contains ! set the Moving IBM interior conservative variables - $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[eqn_idx%E, momxb]', collapse=3) + $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[eqn_idx%E, eqn_idx%mom%beg]', collapse=3) do l = 0, p do k = 0, n do j = 0, m @@ -174,13 +174,13 @@ contains 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,7 +226,7 @@ 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 @@ -296,16 +296,16 @@ 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 @@ -324,13 +324,13 @@ contains 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 @@ -782,14 +784,14 @@ contains 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 @@ -800,20 +802,20 @@ contains $: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 @@ -958,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 130c98a0d6..317e789c38 100644 --- a/src/simulation/m_igr.fpp +++ b/src/simulation/m_igr.fpp @@ -343,7 +343,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(eqn_idx%mom%beg)%sf(j + q, k, l) F_L = F_L + coeff_L(q)*jac(j + q, k, l) end do @@ -354,7 +354,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(eqn_idx%mom%beg)%sf(j + q, k, l) F_R = F_R + coeff_R(q)*jac(j + q, k, l) end do @@ -369,13 +369,14 @@ 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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) + rhs_vf(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, & + & l) - real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j)), kind=stp) $:GPU_ATOMIC(atomic='update') rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & & l) - real(0.5_wp*dt*vel_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) @@ -445,10 +446,12 @@ 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(eqn_idx%mom%beg)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - 1._wp*q_cons_vf(eqn_idx%mom%beg)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -477,10 +480,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)) + dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k - 1, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k - 1, & + & l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -535,7 +540,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(eqn_idx%mom%beg + i - 1)%sf(j + q, k, l) end do end do @@ -557,7 +562,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(eqn_idx%mom%beg + i - 1)%sf(j + q, k, l) end do end do @@ -602,56 +607,56 @@ 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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & @@ -689,34 +694,36 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -726,12 +733,12 @@ contains & *(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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -757,34 +764,36 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -794,12 +803,12 @@ contains & *(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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -843,12 +852,15 @@ 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(eqn_idx%mom%beg)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + 1 + q, k, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j - 1 + q, k, & + & l)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') @@ -879,12 +891,15 @@ 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(eqn_idx%mom%beg)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k - 1, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k + 1, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + q, & + & k + 1, l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +927,15 @@ 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(eqn_idx%mom%beg)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k, & + & l - 1)/rho_sf_small(-1)) + if (q == 0) dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k, & + & l - 1)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + q, k, & + & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + q, k, & + & l - 1)/rho_sf_small(-1)) if (q == 0) then $:GPU_LOOP(parallelism='[seq]') do i = 1, num_dims @@ -972,7 +990,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(eqn_idx%mom%beg + i - 1)%sf(j + q, k, l) end do end do @@ -994,7 +1012,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(eqn_idx%mom%beg + i - 1)%sf(j + q, k, l) end do end do @@ -1040,84 +1058,84 @@ 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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & @@ -1156,39 +1174,41 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -1198,17 +1218,17 @@ contains & *(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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -1234,39 +1254,41 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & + & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -1276,17 +1298,17 @@ contains & *(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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -1333,10 +1355,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, 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(eqn_idx%mom%beg)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k + q, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +1382,12 @@ 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(eqn_idx%mom%beg)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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)) @@ -1405,7 +1431,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(eqn_idx%mom%beg + i - 1)%sf(j, k + q, l) end do end do @@ -1427,7 +1453,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(eqn_idx%mom%beg + i - 1)%sf(j, k + q, l) end do end do @@ -1473,56 +1499,56 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & @@ -1564,34 +1590,35 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & + & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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) @@ -1601,12 +1628,12 @@ contains & - 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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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) @@ -1631,32 +1658,33 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & + & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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') @@ -1664,11 +1692,11 @@ contains & 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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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') @@ -1712,10 +1740,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, 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(eqn_idx%mom%beg)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k + q, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +1767,15 @@ 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(eqn_idx%mom%beg)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) + dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k - 1 + q, & + & l)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k + 1 + q, & + & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +1799,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(eqn_idx%mom%beg + 1)%sf(j, k + q, & + & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k + q, & + & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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)) @@ -1814,7 +1847,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(eqn_idx%mom%beg + i - 1)%sf(j, k + q, l) end do end do @@ -1836,7 +1869,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(eqn_idx%mom%beg + i - 1)%sf(j, k + q, l) end do end do @@ -1882,84 +1915,84 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k + 1, l) = rhs_vf(momxb)%sf(j, k + 1, & + rhs_vf(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & @@ -2001,39 +2034,40 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & + & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2043,17 +2077,17 @@ contains & - 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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2079,39 +2113,40 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & + & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2121,17 +2156,17 @@ contains & + 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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2177,10 +2212,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, 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(eqn_idx%mom%beg)%sf(j + 1, k, & + & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k, & + & l + q)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + 1, k, & + & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +2239,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(eqn_idx%mom%beg + 1)%sf(j, k + 1, & + & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k - 1, & + & l + q)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k + 1, & + & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 +2265,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(eqn_idx%mom%beg)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%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(2) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, & + & l - 1 + q)/rho_sf_small(-1)) + dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k, & + & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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)) @@ -2279,7 +2319,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(eqn_idx%mom%beg + i - 1)%sf(j, k, l + q) end do end do @@ -2301,7 +2341,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(eqn_idx%mom%beg + i - 1)%sf(j, k, l + q) end do end do @@ -2347,84 +2387,84 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(momxb)%sf(j, k, l + 1) = rhs_vf(momxb)%sf(j, k, & + rhs_vf(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, & @@ -2466,39 +2506,39 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l + 1) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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)), & - & kind=stp) + rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2508,17 +2548,17 @@ contains & - 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2544,39 +2584,39 @@ 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l + 1) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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)), & - & kind=stp) + rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & + & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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) @@ -2586,17 +2626,17 @@ contains & + 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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) 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 e30032717e..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 @@ -289,7 +292,7 @@ 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 @@ -297,7 +300,8 @@ contains $: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 fcc1c0c96f..9f0fceecdf 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -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 @@ -560,7 +563,7 @@ contains do q = 0, n do i = 0, m 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 = bubxb + 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) @@ -766,7 +769,7 @@ contains do id1 = is1_qbmm%beg, is1_qbmm%end 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(contxb)%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 23309d6d52..00ed29e7f9 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -215,7 +215,7 @@ contains 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 @@ -317,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)) @@ -443,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 @@ -557,11 +557,11 @@ 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 + 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 @@ -657,7 +657,7 @@ 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) @@ -679,7 +679,7 @@ contains 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) @@ -695,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)) @@ -894,12 +894,12 @@ contains & q_loop) + pi_infs(1))/gammas(1) 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(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, & @@ -944,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) + 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(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, & + 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 @@ -990,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) + 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(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, & + 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 @@ -1039,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) @@ -1086,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) + 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(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, & + 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 @@ -1126,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, & @@ -1148,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() @@ -1162,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) @@ -1194,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, & @@ -1216,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() @@ -1234,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() @@ -1251,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) @@ -1275,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, & @@ -1297,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() @@ -1311,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) @@ -1361,8 +1364,8 @@ contains do k = 0, n do j = 0, m 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(advxb)%sf(j, k, & - & l) - flux_src_n_in(advxb)%sf(j - 1, k, l)) + & 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 @@ -1376,7 +1379,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + 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 @@ -1384,7 +1387,7 @@ 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 @@ -1407,8 +1410,8 @@ contains do k = 0, n do j = 0, m 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(advxb)%sf(j, k, & - & l) - flux_src_n_in(advxb)%sf(j, k - 1, l)) + & 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 @@ -1431,7 +1434,7 @@ contains do l = 0, p do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + 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, eqn_idx%E + 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, eqn_idx%E + 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,7 +1472,7 @@ 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 @@ -1494,7 +1497,7 @@ contains do k = 1, n do j = 0, m $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + 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, eqn_idx%E + 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, eqn_idx%E + 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 @@ -1538,8 +1541,8 @@ contains do k = 0, n do j = 0, m 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(advxb)%sf(j, k, & - & l) - flux_src_n_in(advxb)%sf(j, k, l - 1)) + & 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 @@ -1553,7 +1556,7 @@ contains do j = 0, m if (surface_tension .or. viscous) then $:GPU_LOOP(parallelism='[seq]') - do i = momxb, eqn_idx%E + 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 @@ -1561,7 +1564,7 @@ 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 @@ -1582,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 diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 36a1a7dadd..ccbd611ae9 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,8 +242,8 @@ 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 @@ -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) @@ -451,15 +451,15 @@ contains 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 @@ -679,9 +681,9 @@ contains ! 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) @@ -757,7 +759,7 @@ contains & = 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) @@ -768,22 +770,22 @@ contains 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 @@ -797,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 @@ -915,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 @@ -924,8 +934,8 @@ 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 @@ -1023,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) @@ -1130,15 +1140,15 @@ contains 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 @@ -1184,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))) & @@ -1206,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]') @@ -1217,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) @@ -1246,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 @@ -1296,9 +1308,9 @@ contains ! 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 @@ -1306,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, & @@ -1316,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) @@ -1357,7 +1369,7 @@ contains & - 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) @@ -1368,22 +1380,22 @@ contains 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 @@ -1415,8 +1427,8 @@ contains $: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]') @@ -1426,8 +1438,8 @@ contains 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]') @@ -1438,8 +1450,8 @@ contains $: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 @@ -1464,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 @@ -1484,19 +1496,19 @@ 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(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(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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & @@ -1504,13 +1516,14 @@ contains & 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(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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & @@ -1523,31 +1536,32 @@ 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(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(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(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(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(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, & @@ -1558,28 +1572,29 @@ 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(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(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(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(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(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, & @@ -1592,40 +1607,40 @@ 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(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(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(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)) @@ -1635,20 +1650,20 @@ 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(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(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(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 @@ -1656,17 +1671,17 @@ 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) - 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(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(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(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)) @@ -1812,8 +1827,8 @@ 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 @@ -1872,8 +1887,8 @@ contains 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 @@ -1900,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]') @@ -1911,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) @@ -1946,8 +1961,8 @@ contains 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 @@ -2056,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)) @@ -2066,7 +2081,7 @@ 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 @@ -2081,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)) & @@ -2096,7 +2111,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)*s_S + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S end do @@ -2121,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 @@ -2170,15 +2187,16 @@ contains 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 @@ -2189,10 +2207,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 @@ -2220,15 +2240,15 @@ 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 @@ -2318,7 +2338,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)) @@ -2328,21 +2348,22 @@ 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 @@ -2362,12 +2383,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, & @@ -2386,7 +2407,7 @@ contains 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)) & @@ -2394,7 +2415,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 @@ -2406,13 +2427,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 @@ -2448,8 +2470,8 @@ 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 @@ -2556,8 +2578,8 @@ contains 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]') @@ -2680,7 +2702,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)) @@ -2688,7 +2710,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) @@ -2712,13 +2734,14 @@ 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)) @@ -2731,7 +2754,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)) @@ -2748,11 +2771,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, & @@ -2761,7 +2784,7 @@ 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 @@ -2781,7 +2804,7 @@ contains 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)) & @@ -2789,7 +2812,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 @@ -2802,13 +2825,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 @@ -2843,8 +2867,8 @@ 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 @@ -2912,9 +2936,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) @@ -2973,9 +2997,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 @@ -2985,7 +3009,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) @@ -3021,8 +3045,8 @@ contains 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 @@ -3118,7 +3142,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)) @@ -3128,13 +3152,14 @@ 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)) @@ -3151,8 +3176,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)) & @@ -3167,17 +3192,18 @@ contains ! 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)) @@ -3211,11 +3237,11 @@ contains 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) @@ -3236,7 +3262,7 @@ contains 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)) & @@ -3244,7 +3270,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 @@ -3257,13 +3283,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 @@ -3277,17 +3304,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 @@ -3365,15 +3400,15 @@ 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) @@ -3522,9 +3557,9 @@ 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, eqn_idx%B%beg) = F_hlld(5) @@ -3537,11 +3572,11 @@ contains 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 @@ -3587,7 +3622,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)) @@ -3604,7 +3639,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 @@ -3622,7 +3657,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 @@ -3695,7 +3730,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) @@ -3706,7 +3741,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) @@ -3717,7 +3752,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) @@ -3744,7 +3779,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) @@ -3755,7 +3790,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) @@ -3766,7 +3801,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) @@ -3795,7 +3830,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) @@ -3805,7 +3840,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) @@ -3816,7 +3851,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) @@ -3842,7 +3877,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) @@ -3852,7 +3887,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) @@ -3863,7 +3898,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) @@ -3891,7 +3926,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) @@ -3900,7 +3935,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) @@ -3909,7 +3944,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) @@ -3934,7 +3969,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) @@ -3944,7 +3979,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) @@ -3954,7 +3989,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) @@ -3981,7 +4016,7 @@ contains if (norm_dir == 1) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + 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 @@ -3995,11 +4030,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, 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 == eqn_idx%E .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 @@ -4027,7 +4062,7 @@ contains else if (norm_dir == 2) then if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + 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 @@ -4041,11 +4076,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, 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 == eqn_idx%E .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 @@ -4073,7 +4108,7 @@ contains else if (viscous .or. (surface_tension) .or. dummy) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = momxb, eqn_idx%E + 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 @@ -4087,11 +4122,11 @@ contains if (chem_params%diffusion) then $:GPU_PARALLEL_LOOP(collapse=4) - do i = eqn_idx%E, 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 == eqn_idx%E .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 @@ -4268,8 +4303,8 @@ 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(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 @@ -4278,8 +4313,8 @@ 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(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 @@ -4387,8 +4422,9 @@ 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(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) @@ -4400,8 +4436,9 @@ 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(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) @@ -4509,7 +4546,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 @@ -4517,7 +4554,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 @@ -4559,7 +4596,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 @@ -4567,7 +4604,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 @@ -4595,7 +4632,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 @@ -4603,7 +4640,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 e246238d4a..78cefed09b 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 diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 2a8f7e28a1..49fea9653a 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -575,7 +575,7 @@ contains 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 @@ -592,8 +592,8 @@ contains & 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 diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 06bb5e06cf..9a4d0c6425 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -113,7 +113,8 @@ 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(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) @@ -155,7 +156,8 @@ 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(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) @@ -197,7 +199,8 @@ 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(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) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index cd296bcc06..c43ed187f7 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -293,7 +293,7 @@ contains 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, eqn_idx%E + do i = eqn_idx%mom%beg, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index c0df5e853a..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, eqn_idx%E + do i = eqn_idx%mom%beg, eqn_idx%E tau_Re_vf(i)%sf(j, k, l) = 0._wp end do 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(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%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 @@ -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(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%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 @@ -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(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%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 @@ -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(eqn_idx%E)%sf(j, k, l) = tau_Re_vf(eqn_idx%E)%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 @@ -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 From bb715b11d28d261ac97aa98b41bb58f37c21b8c1 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 11:19:35 -0400 Subject: [PATCH 14/17] refactor: replace xibeg/xiend shorthands with eqn_idx%xi%beg/end references --- src/common/m_boundary_common.fpp | 12 +++++----- src/common/m_variables_conversion.fpp | 4 ++-- src/post_process/m_global_parameters.fpp | 5 ---- src/post_process/m_start_up.fpp | 4 ++-- src/pre_process/m_assign_variables.fpp | 2 +- src/pre_process/m_global_parameters.fpp | 4 ---- src/simulation/m_global_parameters.fpp | 8 +------ src/simulation/m_hyperelastic.fpp | 24 +++++++++---------- src/simulation/m_riemann_solvers.fpp | 30 +++++++++++++----------- src/simulation/m_sim_helpers.fpp | 2 +- src/simulation/m_time_steppers.fpp | 4 ++-- 11 files changed, 43 insertions(+), 56 deletions(-) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index c374d8710c..3f881c544a 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 7788ac4cb1..2417da1adf 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -749,7 +749,7 @@ 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 @@ -1002,7 +1002,7 @@ 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 diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 49366baac3..9dec6f9434 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -262,8 +262,6 @@ module m_global_parameters logical :: surface_tension !> @} - integer :: xibeg, xiend - !> @name Lagrangian bubbles !> @{ logical :: bubbles_lagrange @@ -741,9 +739,6 @@ contains z_output_idx%end = 0 end if - xibeg = eqn_idx%xi%beg - xiend = eqn_idx%xi%end - #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*nnode)) diff --git a/src/post_process/m_start_up.fpp b/src/post_process/m_start_up.fpp index 03487663b1..48fe35abc1 100644 --- a/src/post_process/m_start_up.fpp +++ b/src/post_process/m_start_up.fpp @@ -492,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 diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index cb37b30652..5e250310b7 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -400,7 +400,7 @@ 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 diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 34e1f844f6..4105e7aa91 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -180,7 +180,6 @@ module m_global_parameters logical :: surface_tension !> @} - integer :: xibeg, xiend integer, allocatable, dimension(:,:,:) :: logic_grid type(pres_field) :: pb type(pres_field) :: mv @@ -777,9 +776,6 @@ contains sys_size = eqn_idx%species%end end if - xibeg = eqn_idx%xi%beg - xiend = eqn_idx%xi%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) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index caf863ff67..9107a0869c 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -427,9 +427,6 @@ module m_global_parameters $:GPU_DECLARE(create='[sigma, surface_tension]') !> @} - integer :: xibeg, xiend - $: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]') @@ -1173,11 +1170,8 @@ contains grid_geometry = 3 end if - xibeg = eqn_idx%xi%beg - xiend = eqn_idx%xi%end - $: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, xibeg, xiend, tensor_size]') + $:GPU_UPDATE(device='[b_size, tensor_size]') $:GPU_UPDATE(device='[cfl_target, m, n, p]') diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index a7cbf8003b..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) @@ -174,7 +174,7 @@ contains end if ! STEP 5b: updating the pressure field 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(xiend + 1)%sf(j, k, l)/gamma + & 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 @@ -214,7 +214,7 @@ contains 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 @@ -243,7 +243,7 @@ contains 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_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index ccbd611ae9..33661b54d7 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1944,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]') @@ -1956,8 +1956,8 @@ 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 @@ -2166,9 +2166,10 @@ 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 @@ -3027,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 @@ -3040,8 +3041,8 @@ 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 @@ -3231,9 +3232,10 @@ 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 diff --git a/src/simulation/m_sim_helpers.fpp b/src/simulation/m_sim_helpers.fpp index 78cefed09b..4a0978919e 100644 --- a/src/simulation/m_sim_helpers.fpp +++ b/src/simulation/m_sim_helpers.fpp @@ -130,7 +130,7 @@ contains ! 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_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index c43ed187f7..e452c4a9fe 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -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)) @@ -932,7 +932,7 @@ contains 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 From 982e43422ce4a5267c01d3b4d4bbaa31b0229961 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 16:06:16 -0400 Subject: [PATCH 15/17] fix: remove struct-member copyin from GPU loop; fix I2 overflow and uppercase keywords in indices.dat --- src/pre_process/m_data_output.fpp | 4 ++-- src/simulation/m_ibm.fpp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index ebe244bd30..6b37933e89 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -612,7 +612,7 @@ contains s_write_data_files => s_write_parallel_data_files end if - open (newunit=iu, FILE='indices.dat', STATUS='unknown') + open (newunit=iu, file='indices.dat', status='unknown') write (iu, '(A)') "Warning: The creation of file is currently experimental." write (iu, '(A)') "This file may contain errors and not support all features." @@ -672,7 +672,7 @@ contains integer, intent(in) :: beg, end character(*), intent(in) :: label - if (beg /= 0) write (iu, '("[",I2,",",I2,"]",A)') beg, end, label + if (beg /= 0) write (iu, '("[",I0,",",I0,"]",A)') beg, end, label end subroutine write_range diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 68f6615e3e..d4d20b9b3f 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -165,7 +165,7 @@ contains ! set the Moving IBM interior conservative variables - $:GPU_PARALLEL_LOOP(private='[i, j, k, patch_id, rho]', copyin='[eqn_idx%E, eqn_idx%mom%beg]', 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 From 076e423d9a827be9df9860a3a8396e553678b0f3 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 18:59:23 -0400 Subject: [PATCH 16/17] fix: use lightweight idx_bounds_info in eqn_idx_info for GPU compatibility eqn_idx_info previously used int_bounds_info (which carries ~290 bytes of BC payload per member) for its 9 range fields. When the full struct was ! declare target'd, OpenMP runtimes on Cray ftn and nvfortran failed to deep-copy the nested int_bounds_info members correctly, causing wrong results on gpu-omp builds (all 2D tests) and crashes on case-optimized gpu-omp builds. Introduce idx_bounds_info with just beg/end integers and use it in eqn_idx_info. This reduces the struct from ~2.6KB to ~80 bytes and eliminates the nested arrays that broke OpenMP target offload. --- src/common/m_derived_types.fpp | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 34935ccb16..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 @@ -127,15 +133,15 @@ module m_derived_types !> 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(int_bounds_info) :: cont !< Partial densities (continuity equations) - type(int_bounds_info) :: mom !< Momentum components - type(int_bounds_info) :: adv !< Volume fractions (advection equations) - type(int_bounds_info) :: bub !< Bubble equation range (beg/end only) - type(int_bounds_info) :: stress !< Stress tensor components - type(int_bounds_info) :: xi !< Reference map equations - type(int_bounds_info) :: B !< Magnetic field components - type(int_bounds_info) :: int_en !< Internal energy equations - type(int_bounds_info) :: species !< Chemistry species equations + 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) From 2f3050205e11d0c69ceea4bc06047287f8b8492e Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 10 Apr 2026 21:00:38 -0400 Subject: [PATCH 17/17] fix: use scalar proxies for eqn_idx fields in m_igr GPU atomics nvfortran's OpenMP target offload does not support derived-type member indexing (e.g. rhs_vf(eqn_idx%mom%beg)%sf) on the LHS of atomic updates. Extract igr_momxb, igr_E_idx, igr_advxb as module-level scalars, GPU_DECLARE and GPU_UPDATE them from eqn_idx at init, and use them throughout m_igr GPU kernels. This mirrors the pre-refactor pattern of momxb/E_idx/advxb being plain GPU-resident integers. --- src/simulation/m_igr.fpp | 712 +++++++++++++++++++-------------------- 1 file changed, 347 insertions(+), 365 deletions(-) diff --git a/src/simulation/m_igr.fpp b/src/simulation/m_igr.fpp index 317e789c38..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(eqn_idx%mom%beg)%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(eqn_idx%mom%beg)%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,16 @@ contains #:for LR in ['L', 'R'] $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%sf(j, k, & - & l) - real(0.5_wp*dt*F_${LR}$*(1._wp/dx(j)), kind=stp) + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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_${LR}$*F_${LR}$*(1._wp/dx(j)), kind=stp) #:endfor end do @@ -446,12 +456,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(1._wp*q_cons_vf(eqn_idx%mom%beg)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - 1._wp*q_cons_vf(eqn_idx%mom%beg)%sf(j - 1 + q, k, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1 + q, k, & + 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]') @@ -480,12 +489,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k - 1, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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]') @@ -532,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(eqn_idx%E + 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 @@ -540,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(eqn_idx%mom%beg + 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 @@ -554,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(eqn_idx%E + 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 @@ -562,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(eqn_idx%mom%beg + 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 @@ -607,59 +614,59 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -667,12 +674,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(eqn_idx%E)%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, & @@ -694,56 +701,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -764,56 +769,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -852,15 +855,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1 + q, k, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1 + q, k, & - & l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + 1 + q, k, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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]') @@ -891,15 +891,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k - 1, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k + 1, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + q, & - & k + 1, l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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 @@ -927,14 +924,12 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j + q, k, & - & l - 1)/rho_sf_small(-1)) - if (q == 0) dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + q, k, & - & l - 1)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + q, k, & - & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + q, k, & + 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]') @@ -982,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(eqn_idx%E + 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 @@ -990,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(eqn_idx%mom%beg + 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 @@ -1004,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(eqn_idx%E + 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 @@ -1012,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(eqn_idx%mom%beg + 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 @@ -1058,87 +1053,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1146,12 +1141,12 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(eqn_idx%E)%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, & @@ -1174,66 +1169,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1254,66 +1247,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j + 1, k, & - & l) - real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real((0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%mom%beg)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j + 1, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j + 1, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1355,11 +1346,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k + q, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1, k + q, & + 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 @@ -1382,11 +1372,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j, k - 1 + q, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k - 1 + q, & + 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 @@ -1423,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(eqn_idx%E + 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 @@ -1431,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(eqn_idx%mom%beg + 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 @@ -1445,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(eqn_idx%E + 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 @@ -1453,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(eqn_idx%mom%beg + 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 @@ -1499,59 +1488,59 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1560,13 +1549,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(eqn_idx%E)%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 @@ -1590,55 +1579,54 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & - & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -1658,49 +1646,48 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & - & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -1740,11 +1727,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k + q, & - & l)/rho_sf_small(-1)) - dvel_small(2) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j + 1, k + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j - 1, k + q, & + 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 @@ -1767,14 +1753,13 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j, k - 1 + q, & + 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(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k - 1 + q, & - & l)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k + 1 + q, & - & l)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k - 1 + q, & + 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 @@ -1799,11 +1784,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + q, & - & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg + 2)%sf(j, k + q, & - & l + 1)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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)) @@ -1839,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(eqn_idx%E + 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 @@ -1847,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(eqn_idx%mom%beg + 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 @@ -1861,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(eqn_idx%E + 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 @@ -1869,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(eqn_idx%mom%beg + 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 @@ -1915,87 +1900,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -2004,13 +1989,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(eqn_idx%E)%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 @@ -2034,65 +2019,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & - & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2113,65 +2097,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, & - & k + 1, l) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(2)*(1._wp/dy(k)), kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k + 1, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k + 1, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -2212,11 +2195,10 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j + 1, k, & - & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, k, & - & l + q)/rho_sf_small(-1)) - dvel_small(3) = (1/(2._wp*dx(j)))*(q_cons_vf(eqn_idx%mom%beg + 2)%sf(j + 1, k, & - & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j - 1, k, & + 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 @@ -2239,11 +2221,11 @@ contains rho_sf_small(i) = rho_L end do - dvel_small(2) = (1/(2._wp*dy(k)))*(q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k + 1, & - & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k - 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(eqn_idx%mom%beg + 2)%sf(j, k + 1, & - & l + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, k - 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 @@ -2265,14 +2247,14 @@ contains end do rho_sf_small(i) = rho_L end do - dvel_small(1) = (1/(2._wp*dz(l)))*(q_cons_vf(eqn_idx%mom%beg)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, k, & + 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(eqn_idx%mom%beg + 2)%sf(j, k, & - & l + 1 + q)/rho_sf_small(1) - q_cons_vf(eqn_idx%mom%beg + 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)) @@ -2311,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(eqn_idx%E + 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 @@ -2319,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(eqn_idx%mom%beg + 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 @@ -2333,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(eqn_idx%E + 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 @@ -2341,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(eqn_idx%mom%beg + 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 @@ -2387,87 +2369,87 @@ contains end do $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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 @@ -2476,13 +2458,13 @@ contains $:GPU_LOOP(parallelism='[seq]') do q = vidxb + 1, vidxe - E_L = E_L + coeff_L(q)*q_cons_vf(eqn_idx%E)%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(eqn_idx%E)%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 @@ -2506,64 +2488,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l)*vel_L(3)*(1._wp/dz(l)), 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(3)*(1._wp/dz(l)), & + & kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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) @@ -2584,64 +2566,64 @@ contains $:GPU_LOOP(parallelism='[seq]') do i = 1, num_fluids - 1 $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l + 1) - real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + 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(eqn_idx%adv%beg + i - 1)%sf(j, k, l) = rhs_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l) + real(0.5_wp*dt*q_cons_vf(eqn_idx%adv%beg + i - 1)%sf(j, k, & - & l)*vel_R(3)*(1._wp/dz(l)), 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(3)*(1._wp/dz(l)), & + & kind=stp) end do end if $:GPU_ATOMIC(atomic='update') - rhs_vf(eqn_idx%mom%beg + 2)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l + 1) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l + 1) = rhs_vf(eqn_idx%E)%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(eqn_idx%mom%beg + 2)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%mom%beg)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg)%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(eqn_idx%mom%beg + 1)%sf(j, k, l) = rhs_vf(eqn_idx%mom%beg + 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(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%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