diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index e146c15af4..5b3d2d812d 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -22,7 +22,7 @@ module m_boundary_common type(scalar_field), dimension(:, :), allocatable :: bc_buffers !$acc declare create(bc_buffers) - real(wp) :: bcxb, bcxe, bcyb, bcye, bczb, bcze + type(boundary_bounds) :: bc_bound #ifdef MFC_MPI integer, dimension(1:3, -1:1) :: MPI_BC_TYPE_TYPE, MPI_BC_BUFFER_TYPE @@ -34,7 +34,7 @@ module m_boundary_common s_populate_capillary_buffers, & s_finalize_boundary_common_module - public :: bc_buffers, bcxb, bcxe, bcyb, bcye, bczb, bcze + public :: bc_buffers, bc_bound #ifdef MFC_MPI public :: MPI_BC_TYPE_TYPE, MPI_BC_BUFFER_TYPE @@ -44,22 +44,22 @@ contains impure subroutine s_initialize_boundary_common_module() - bcxb = bc_x%beg; bcxe = bc_x%end; bcyb = bc_y%beg; bcye = bc_y%end; bczb = bc_z%beg; bcze = bc_z%end + bc_bound%xb = bc_x%beg; bc_bound%xe = bc_x%end; bc_bound%yb = bc_y%beg; bc_bound%ye = bc_y%end; bc_bound%zb = bc_z%beg; bc_bound%ze = bc_z%end @:ALLOCATE(bc_buffers(1:num_dims, -1:1)) #ifndef MFC_POST_PROCESS if (bc_io) then - @:ALLOCATE(bc_buffers(1, -1)%sf(1:sys_size, 0:n, 0:p)) - @:ALLOCATE(bc_buffers(1, 1)%sf(1:sys_size, 0:n, 0:p)) + @:ALLOCATE(bc_buffers(1, -1)%sf(1:eqn_idx%sys_size, 0:n, 0:p)) + @:ALLOCATE(bc_buffers(1, 1)%sf(1:eqn_idx%sys_size, 0:n, 0:p)) @:ACC_SETUP_SFs(bc_buffers(1,-1), bc_buffers(1,1)) if (n > 0) then - @:ALLOCATE(bc_buffers(2,-1)%sf(-buff_size:m+buff_size,1:sys_size,0:p)) - @:ALLOCATE(bc_buffers(2,1)%sf(-buff_size:m+buff_size,1:sys_size,0:p)) + @:ALLOCATE(bc_buffers(2,-1)%sf(-buff_size:m+buff_size,1:eqn_idx%sys_size,0:p)) + @:ALLOCATE(bc_buffers(2,1)%sf(-buff_size:m+buff_size,1:eqn_idx%sys_size,0:p)) @:ACC_SETUP_SFs(bc_buffers(2,-1), bc_buffers(2,1)) if (p > 0) then - @:ALLOCATE(bc_buffers(3,-1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size)) - @:ALLOCATE(bc_buffers(3,1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:sys_size)) + @:ALLOCATE(bc_buffers(3,-1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:eqn_idx%sys_size)) + @:ALLOCATE(bc_buffers(3,1)%sf(-buff_size:m+buff_size,-buff_size:n+buff_size,1:eqn_idx%sys_size)) @:ACC_SETUP_SFs(bc_buffers(3,-1), bc_buffers(3,1)) end if end if @@ -71,16 +71,17 @@ contains !> The purpose of this procedure is to populate the buffers !! of the primitive variables, depending on the selected !! boundary conditions. - impure subroutine s_populate_variables_buffers(q_prim_vf, pb, mv, bc_type) + impure subroutine s_populate_variables_buffers(q_prim_vf, pb, mv, bc_type, bc_bound) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type + type(boundary_bounds), intent(in) :: bc_bound integer :: k, l ! Population of Buffers in x-direction - if (bcxb >= 0) then + if (bc_bound%xb >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 1, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -104,7 +105,7 @@ contains end do end if - if (bcxe >= 0) then + if (bc_bound%xe >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 1, 1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -132,7 +133,7 @@ contains if (n == 0) return - if (bcyb >= 0) then + if (bc_bound%yb >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 2, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -142,7 +143,7 @@ contains case (BC_CHAR_SUP_OUTFLOW:BC_GHOST_EXTRAP) call s_ghost_cell_extrapolation(q_prim_vf, pb, mv, 2, -1, k, l) case (BC_AXIS) - call s_axis(q_prim_vf, pb, mv, k, l) + call s_axis(q_prim_vf, pb, mv, 2, -1, k, l) case (BC_REFLECTIVE) call s_symmetry(q_prim_vf, pb, mv, 2, -1, k, l) case (BC_PERIODIC) @@ -158,7 +159,7 @@ contains end do end if - if (bcye >= 0) then + if (bc_bound%ye >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 2, 1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -186,7 +187,7 @@ contains if (p == 0) return - if (bczb >= 0) then + if (bc_bound%zb >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 3, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -210,7 +211,7 @@ contains end do end if - if (bcze >= 0) then + if (bc_bound%ze >= 0) then call s_mpi_sendrecv_variables_buffers(q_prim_vf, pb, mv, 3, 1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -243,7 +244,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -256,14 +257,14 @@ contains if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !bc_x%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(0, k, l) end do end do else !< bc_x%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m, k, l) @@ -272,14 +273,14 @@ contains end if elseif (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, -j, l) = & q_prim_vf(i)%sf(k, 0, l) end do end do else !< bc_y%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, n + j, l) = & q_prim_vf(i)%sf(k, n, l) @@ -288,14 +289,14 @@ contains end if elseif (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, 0) end do end do else !< bc_z%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p) @@ -312,7 +313,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -330,7 +331,7 @@ contains q_prim_vf(momxb)%sf(-j, k, l) = & -q_prim_vf(momxb)%sf(j - 1, k, l) - do i = momxb + 1, sys_size + do i = momxb + 1, eqn_idx%sys_size q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(j - 1, k, l) end do @@ -371,7 +372,7 @@ contains q_prim_vf(momxb)%sf(m + j, k, l) = & -q_prim_vf(momxb)%sf(m - (j - 1), k, l) - do i = momxb + 1, sys_size + do i = momxb + 1, eqn_idx%sys_size q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m - (j - 1), k, l) end do @@ -413,7 +414,7 @@ contains q_prim_vf(momxb + 1)%sf(k, -j, l) = & -q_prim_vf(momxb + 1)%sf(k, j - 1, l) - do i = momxb + 2, sys_size + do i = momxb + 2, eqn_idx%sys_size q_prim_vf(i)%sf(k, -j, l) = & q_prim_vf(i)%sf(k, j - 1, l) end do @@ -453,7 +454,7 @@ contains q_prim_vf(momxb + 1)%sf(k, n + j, l) = & -q_prim_vf(momxb + 1)%sf(k, n - (j - 1), l) - do i = momxb + 2, sys_size + do i = momxb + 2, eqn_idx%sys_size q_prim_vf(i)%sf(k, n + j, l) = & q_prim_vf(i)%sf(k, n - (j - 1), l) end do @@ -495,7 +496,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, eqn_idx%sys_size q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, j - 1) end do @@ -535,7 +536,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, eqn_idx%sys_size q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p - (j - 1)) end do @@ -576,7 +577,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -585,7 +586,7 @@ contains if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !< bc_x%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(m - (j - 1), k, l) @@ -605,7 +606,7 @@ contains end do end if else !< bc_x%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(j - 1, k, l) @@ -627,7 +628,7 @@ contains end if elseif (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, -j, l) = & q_prim_vf(i)%sf(k, n - (j - 1), l) @@ -647,7 +648,7 @@ contains end do end if else !< bc_y%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, n + j, l) = & q_prim_vf(i)%sf(k, j - 1, l) @@ -669,7 +670,7 @@ contains end if elseif (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, p - (j - 1)) @@ -689,7 +690,7 @@ contains end do end if else !< bc_z%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, j - 1) @@ -713,14 +714,15 @@ contains end subroutine s_periodic - pure subroutine s_axis(q_prim_vf, pb, mv, k, l) + pure subroutine s_axis(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_axis #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv + integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l integer :: j, q, i @@ -738,7 +740,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, eqn_idx%sys_size q_prim_vf(i)%sf(k, -j, l) = & q_prim_vf(i)%sf(k, j - 1, l + ((p + 1)/2)) end do @@ -754,7 +756,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, eqn_idx%sys_size q_prim_vf(i)%sf(k, -j, l) = & q_prim_vf(i)%sf(k, j - 1, l - ((p + 1)/2)) end do @@ -782,7 +784,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -795,7 +797,7 @@ contains if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !< bc_x%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(-j, k, l) = & @@ -807,7 +809,7 @@ contains end do end do else !< bc_x%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(m + j, k, l) = & @@ -821,7 +823,7 @@ contains end if elseif (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb + 1) then q_prim_vf(i)%sf(k, -j, l) = & @@ -833,7 +835,7 @@ contains end do end do else !< bc_y%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb + 1) then q_prim_vf(i)%sf(k, n + j, l) = & @@ -847,7 +849,7 @@ contains end if elseif (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxe) then q_prim_vf(i)%sf(k, l, -j) = & @@ -859,7 +861,7 @@ contains end do end do else !< bc_z%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxe) then q_prim_vf(i)%sf(k, l, p + j) = & @@ -881,7 +883,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -894,7 +896,7 @@ contains if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !< bc_x%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(-j, k, l) = & @@ -912,7 +914,7 @@ contains end do end do else !< bc_x%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(m + j, k, l) = & @@ -932,7 +934,7 @@ contains end if elseif (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(k, -j, l) = & @@ -950,7 +952,7 @@ contains end do end do else !< bc_y%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(k, n + j, l) = & @@ -970,7 +972,7 @@ contains end if elseif (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(k, l, -j) = & @@ -988,7 +990,7 @@ contains end do end do else !< bc_z%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(k, l, p + j) = & @@ -1016,7 +1018,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l @@ -1028,14 +1030,14 @@ contains #else if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !bc_x%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(-j, k, l) = & bc_buffers(1, -1)%sf(i, k, l) end do end do else !< bc_x%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(m + j, k, l) = & bc_buffers(1, 1)%sf(i, k, l) @@ -1044,14 +1046,14 @@ contains end if elseif (bc_dir == 2) then !< y-direction if (bc_loc == -1) then !< bc_y%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, -j, l) = & bc_buffers(2, -1)%sf(k, i, l) end do end do else !< bc_y%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, n + j, l) = & bc_buffers(2, 1)%sf(k, i, l) @@ -1060,14 +1062,14 @@ contains end if elseif (bc_dir == 3) then !< z-direction if (bc_loc == -1) then !< bc_z%beg - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, -j) = & bc_buffers(3, -1)%sf(k, l, i) end do end do else !< bc_z%end - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = 1, buff_size q_prim_vf(i)%sf(k, l, p + j) = & bc_buffers(3, 1)%sf(k, l, i) @@ -1155,15 +1157,16 @@ contains end subroutine s_qbmm_extrapolation - impure subroutine s_populate_capillary_buffers(c_divs, bc_type) + impure subroutine s_populate_capillary_buffers(c_divs, bc_type, bc_bound) type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type + type(boundary_bounds), intent(in) :: bc_bound integer :: k, l !< x-direction - if (bcxb >= 0) then + if (bc_bound%xb >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 1, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -1181,7 +1184,7 @@ contains end do end if - if (bcxe >= 0) then + if (bc_bound%xe >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 1, 1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -1202,7 +1205,7 @@ contains if (n == 0) return !< y-direction - if (bcyb >= 0) then + if (bc_bound%yb >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 2, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -1220,7 +1223,7 @@ contains end do end if - if (bcye >= 0) then + if (bc_bound%ye >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 2, 1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -1241,7 +1244,7 @@ contains if (p == 0) return !< z-direction - if (bczb >= 0) then + if (bc_bound%zb >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 3, -1) else !$acc parallel loop collapse(2) gang vector default(present) @@ -1259,7 +1262,7 @@ contains end do end if - if (bcze >= 0) then + if (bc_bound%ze >= 0) then call s_mpi_sendrecv_capilary_variables_buffers(c_divs, 3, 1) else !$acc parallel loop collapse(2) gang vector default(present) diff --git a/src/common/m_chemistry.fpp b/src/common/m_chemistry.fpp index d61c42b1af..196faa6580 100644 --- a/src/common/m_chemistry.fpp +++ b/src/common/m_chemistry.fpp @@ -25,7 +25,7 @@ contains ! conservative variables. type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf type(int_bounds_info), dimension(1:3), intent(in) :: bounds integer :: x, y, z, eqn @@ -42,10 +42,10 @@ contains end do ! e = E - 1/2*|u|^2 - ! cons. E_idx = \rho E + ! cons. eqn_idx%E = \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) + energy = q_cons_vf(eqn_idx%E)%sf(x, y, z)/q_cons_vf(contxb)%sf(x, y, z) !$acc loop seq do eqn = momxb, momxe energy = energy - & @@ -62,7 +62,7 @@ contains subroutine s_compute_T_from_primitives(q_T_sf, q_prim_vf, bounds) type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(int_bounds_info), dimension(1:3), intent(in) :: bounds integer :: x, y, z, i @@ -78,7 +78,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 @@ -87,9 +87,9 @@ contains subroutine s_compute_chemistry_reaction_flux(rhs_vf, q_cons_qp, q_T_sf, q_prim_qp, bounds) - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_qp, q_prim_qp + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_qp, q_prim_qp type(int_bounds_info), dimension(1:3), intent(in) :: bounds integer :: x, y, z diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 59156d1c12..5e5f8416db 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -135,6 +135,37 @@ module m_derived_types integer, dimension(:, :), allocatable :: moms !< Moment indices for qbmm integer, dimension(:, :, :), allocatable :: fullmom !< Moment indices for qbmm end type bub_bounds_info + + !> @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 + !> @{ + type system_of_equations + integer :: sys_size !< Size of the system of equations + type(int_bounds_info) :: cont !< Indexes of first & last continuity eqns. + type(int_bounds_info) :: mom !< Indexes of first & last momentum eqns. + integer :: E !< Index of energy equation + integer :: n !< Index of number density + type(int_bounds_info) :: adv !< Indexes of first & last advection eqns. + type(int_bounds_info) :: internalEnergies !< Indexes of first & last internal energy eqns. + type(bub_bounds_info) :: bub !< Indexes of first & last bubble variable eqns. + integer :: alf !< Index of void fraction + integer :: gamma !< Index of specific heat ratio func. eqn. + integer :: pi_inf !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: B !< Indexes of first and last magnetic field eqns. + type(int_bounds_info) :: stress !< Indexes of first and last shear stress eqns. + type(int_bounds_info) :: xi !< 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 !< Indexes of first & last concentration eqns. + integer :: c !< Index of color function + integer :: damage !< Index of damage state variable (D) for continuum damage model + integer, dimension(3) :: dir + real(wp), dimension(3) :: dir_flg + integer, dimension(3) :: dir_tau !!used for hypoelasticity=true + integer, dimension(2) :: Re_size + integer, allocatable, dimension(:, :) :: Re + end type system_of_equations + !> @} !> Defines parameters for a Model Patch type ic_model_parameters @@ -345,6 +376,11 @@ module m_derived_types type(vec3_dt), allocatable, dimension(:) :: var end type mpi_io_airfoil_ib_var + !> Derived type for boundary flags + type boundary_bounds + real(wp) :: xb, xe, yb, ye, zb, ze + end type boundary_bounds + !> Derived type annexing integral regions type integral_parameters real(wp) :: xmin !< Min. boundary first coordinate direction @@ -391,6 +427,22 @@ module m_derived_types real(wp), dimension(:, :), allocatable :: xyz_to_r_ratios !< List of [xyz]/r for mom source term vector end type source_spatial_type + !> @brief Type for storing point data + type point_data + real(wp), dimension(:), allocatable :: alpha_rho !< Partial densities + real(wp), dimension(:), allocatable :: alpha !< Volume fractions + real(wp) :: pressure !< Pressure + real(wp), dimension(3) :: vel !< Velocity + real(wp) :: c !< Color function (for surface tension) + real(wp), dimension(:), allocatable :: r !< Bubble radii + real(wp), dimension(:), allocatable :: v !< Bubble radial velocities + real(wp), dimension(:), allocatable :: pb !< Bubble pressures + real(wp), dimension(:), allocatable :: mv !< Mass of vapor + real(wp), dimension(:), allocatable :: nmom !< Moments for QBMM + real(wp), dimension(:), allocatable :: presb !< Node pressures for bubbles + real(wp), dimension(:), allocatable :: massv !< Node masses for bubbles + end type point_data + !> Ghost Point for Immersed Boundaries type ghost_point integer, dimension(3) :: loc !< Physical location of the ghost point @@ -400,6 +452,7 @@ module m_derived_types integer :: ib_patch_id !< ID of the IB Patch the ghost point is part of logical :: slip integer, dimension(3) :: DB + type(point_data) :: ip end type ghost_point !> Species parameters diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index b439ce1c6d..96a5524c46 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -57,36 +57,36 @@ contains if (qbmm .and. .not. polytropic) then if (n > 0) then if (p > 0) then - halo_size = -1 + buff_size*(sys_size + 2*nb*4)* & + halo_size = -1 + buff_size*(eqn_idx%sys_size + 2*nb*4)* & & (m + 2*buff_size + 1)* & & (n + 2*buff_size + 1)* & & (p + 2*buff_size + 1)/ & & (min(m, n, p) + 2*buff_size + 1) else - halo_size = -1 + buff_size*(sys_size + 2*nb*4)* & + halo_size = -1 + buff_size*(eqn_idx%sys_size + 2*nb*4)* & & (max(m, n) + 2*buff_size + 1) end if else - halo_size = -1 + buff_size*(sys_size + 2*nb*4) + halo_size = -1 + buff_size*(eqn_idx%sys_size + 2*nb*4) end if else if (n > 0) then if (p > 0) then - halo_size = -1 + buff_size*sys_size* & + halo_size = -1 + buff_size*eqn_idx%sys_size* & & (m + 2*buff_size + 1)* & & (n + 2*buff_size + 1)* & & (p + 2*buff_size + 1)/ & & (min(m, n, p) + 2*buff_size + 1) else - halo_size = -1 + buff_size*sys_size* & + halo_size = -1 + buff_size*eqn_idx%sys_size* & & (max(m, n) + 2*buff_size + 1) end if else - halo_size = -1 + buff_size*sys_size + halo_size = -1 + buff_size*eqn_idx%sys_size end if end if - v_size = sys_size + v_size = eqn_idx%sys_size allocate (buff_send(0:halo_size)) @@ -136,7 +136,7 @@ contains impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, levelset, levelset_norm, beta) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf type(integer_field), & @@ -166,12 +166,12 @@ contains integer :: alt_sys if (present(beta)) then - alt_sys = sys_size + 1 + alt_sys = eqn_idx%sys_size + 1 else - alt_sys = sys_size + alt_sys = eqn_idx%sys_size end if - do i = 1, sys_size + do i = 1, eqn_idx%sys_size MPI_IO_DATA%var(i)%sf => q_cons_vf(i)%sf(0:m, 0:n, 0:p) end do @@ -184,8 +184,8 @@ contains if (qbmm .and. .not. polytropic) then do i = 1, nb do j = 1, nnode - MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb%sf(0:m, 0:n, 0:p, j, i) - MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv%sf(0:m, 0:n, 0:p, j, i) + MPI_IO_DATA%var(eqn_idx%sys_size + (i - 1)*nnode + j)%sf => pb%sf(0:m, 0:n, 0:p, j, i) + MPI_IO_DATA%var(eqn_idx%sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv%sf(0:m, 0:n, 0:p, j, i) end do end do end if @@ -195,8 +195,8 @@ contains if (qbmm .and. .not. polytropic) then do i = 1, nb do j = 1, nnode - MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb_ts(1)%sf(0:m, 0:n, 0:p, j, i) - MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv_ts(1)%sf(0:m, 0:n, 0:p, j, i) + MPI_IO_DATA%var(eqn_idx%sys_size + (i - 1)*nnode + j)%sf => pb_ts(1)%sf(0:m, 0:n, 0:p, j, i) + MPI_IO_DATA%var(eqn_idx%sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv_ts(1)%sf(0:m, 0:n, 0:p, j, i) end do end do end if @@ -219,7 +219,7 @@ contains #ifndef MFC_POST_PROCESS if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*4 call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, & MPI_ORDER_FORTRAN, mpi_p, MPI_IO_DATA%view(i), ierr) call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr) @@ -375,17 +375,21 @@ contains !! @param Rc_min_glb Global minimum Rc stability criterion impure subroutine s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, & vcfl_max_loc, & + ccfl_max_loc, & Rc_min_loc, & icfl_max_glb, & vcfl_max_glb, & + ccfl_max_glb, & Rc_min_glb) real(wp), intent(in) :: icfl_max_loc real(wp), intent(in) :: vcfl_max_loc + real(wp), intent(in) :: ccfl_max_loc real(wp), intent(in) :: Rc_min_loc real(wp), intent(out) :: icfl_max_glb real(wp), intent(out) :: vcfl_max_glb + real(wp), intent(out) :: ccfl_max_glb real(wp), intent(out) :: Rc_min_glb #ifdef MFC_SIMULATION @@ -616,7 +620,7 @@ contains mpi_dir, & pbc_loc) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: mpi_dir, pbc_loc @@ -643,15 +647,15 @@ contains #ifdef MFC_SIMULATION if (qbmm .and. .not. polytropic) then buffer_counts = (/ & - buff_size*(sys_size + 2*nb*4)*(n + 1)*(p + 1), & - buff_size*(sys_size + 2*nb*4)*(m + 2*buff_size + 1)*(p + 1), & + buff_size*(eqn_idx%sys_size + 2*nb*4)*(n + 1)*(p + 1), & + buff_size*(eqn_idx%sys_size + 2*nb*4)*(m + 2*buff_size + 1)*(p + 1), & buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1) & /) else #endif buffer_counts = (/ & - buff_size*sys_size*(n + 1)*(p + 1), & - buff_size*sys_size*(m + 2*buff_size + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(m + 2*buff_size + 1)*(p + 1), & buff_size*v_size*(m + 2*buff_size + 1)*(n + 2*buff_size + 1) & /) #ifdef MFC_SIMULATION @@ -696,7 +700,7 @@ contains do l = 0, p do k = 0, n do j = 0, buff_size - 1 - do i = 1, sys_size + do i = 1, eqn_idx%sys_size r = (i - 1) + v_size*(j + buff_size*(k + (n + 1)*l)) buff_send(r) = q_cons_vf(i)%sf(j + pack_offset, k, l) end do @@ -710,11 +714,11 @@ contains do l = 0, p do k = 0, n do j = 0, buff_size - 1 - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do q = 1, nb r = (i - 1) + (q - 1)*4 + v_size* & (j + buff_size*(k + (n + 1)*l)) - buff_send(r) = pb(j + pack_offset, k, l, i - sys_size, q) + buff_send(r) = pb(j + pack_offset, k, l, i - eqn_idx%sys_size, q) end do end do end do @@ -725,11 +729,11 @@ contains do l = 0, p do k = 0, n do j = 0, buff_size - 1 - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do q = 1, nb r = (i - 1) + (q - 1)*4 + nb*4 + v_size* & (j + buff_size*(k + (n + 1)*l)) - buff_send(r) = mv(j + pack_offset, k, l, i - sys_size, q) + buff_send(r) = mv(j + pack_offset, k, l, i - eqn_idx%sys_size, q) end do end do end do @@ -739,7 +743,7 @@ contains #endif #:elif mpi_dir == 2 !$acc parallel loop collapse(4) gang vector default(present) private(r) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, buff_size - 1 do j = -buff_size, m + buff_size @@ -755,7 +759,7 @@ contains #ifdef MFC_SIMULATION if (qbmm .and. .not. polytropic) then !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, p do k = 0, buff_size - 1 do j = -buff_size, m + buff_size @@ -763,7 +767,7 @@ contains r = (i - 1) + (q - 1)*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & (k + buff_size*l)) - buff_send(r) = pb(j, k + pack_offset, l, i - sys_size, q) + buff_send(r) = pb(j, k + pack_offset, l, i - eqn_idx%sys_size, q) end do end do end do @@ -771,7 +775,7 @@ contains end do !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, p do k = 0, buff_size - 1 do j = -buff_size, m + buff_size @@ -779,7 +783,7 @@ contains r = (i - 1) + (q - 1)*4 + nb*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & (k + buff_size*l)) - buff_send(r) = mv(j, k + pack_offset, l, i - sys_size, q) + buff_send(r) = mv(j, k + pack_offset, l, i - eqn_idx%sys_size, q) end do end do end do @@ -789,7 +793,7 @@ contains #endif #:else !$acc parallel loop collapse(4) gang vector default(present) private(r) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, buff_size - 1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -805,7 +809,7 @@ contains #ifdef MFC_SIMULATION if (qbmm .and. .not. polytropic) then !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, buff_size - 1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -813,7 +817,7 @@ contains r = (i - 1) + (q - 1)*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + (n + 2*buff_size + 1)*l)) - buff_send(r) = pb(j, k, l + pack_offset, i - sys_size, q) + buff_send(r) = pb(j, k, l + pack_offset, i - eqn_idx%sys_size, q) end do end do end do @@ -821,7 +825,7 @@ contains end do !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, buff_size - 1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -829,7 +833,7 @@ contains r = (i - 1) + (q - 1)*4 + nb*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + (n + 2*buff_size + 1)*l)) - buff_send(r) = mv(j, k, l + pack_offset, i - sys_size, q) + buff_send(r) = mv(j, k, l + pack_offset, i - eqn_idx%sys_size, q) end do end do end do @@ -894,7 +898,7 @@ contains do l = 0, p do k = 0, n do j = -buff_size, -1 - do i = 1, sys_size + do i = 1, eqn_idx%sys_size r = (i - 1) + v_size* & (j + buff_size*((k + 1) + (n + 1)*l)) q_cons_vf(i)%sf(j + unpack_offset, k, l) = buff_recv(r) @@ -915,11 +919,11 @@ contains do l = 0, p do k = 0, n do j = -buff_size, -1 - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do q = 1, nb r = (i - 1) + (q - 1)*4 + v_size* & (j + buff_size*((k + 1) + (n + 1)*l)) - pb(j + unpack_offset, k, l, i - sys_size, q) = buff_recv(r) + pb(j + unpack_offset, k, l, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -930,11 +934,11 @@ contains do l = 0, p do k = 0, n do j = -buff_size, -1 - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do q = 1, nb r = (i - 1) + (q - 1)*4 + nb*4 + v_size* & (j + buff_size*((k + 1) + (n + 1)*l)) - mv(j + unpack_offset, k, l, i - sys_size, q) = buff_recv(r) + mv(j + unpack_offset, k, l, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -944,7 +948,7 @@ contains #endif #:elif mpi_dir == 2 !$acc parallel loop collapse(4) gang vector default(present) private(r) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = -buff_size, -1 do j = -buff_size, m + buff_size @@ -966,7 +970,7 @@ contains #ifdef MFC_SIMULATION if (qbmm .and. .not. polytropic) then !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, p do k = -buff_size, -1 do j = -buff_size, m + buff_size @@ -974,7 +978,7 @@ contains r = (i - 1) + (q - 1)*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + buff_size*l)) - pb(j, k + unpack_offset, l, i - sys_size, q) = buff_recv(r) + pb(j, k + unpack_offset, l, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -982,7 +986,7 @@ contains end do !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = 0, p do k = -buff_size, -1 do j = -buff_size, m + buff_size @@ -990,7 +994,7 @@ contains r = (i - 1) + (q - 1)*4 + nb*4 + v_size* & ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + buff_size*l)) - mv(j, k + unpack_offset, l, i - sys_size, q) = buff_recv(r) + mv(j, k + unpack_offset, l, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -1001,7 +1005,7 @@ contains #:else ! Unpacking buffer from bc_z%beg !$acc parallel loop collapse(4) gang vector default(present) private(r) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = -buff_size, -1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -1024,7 +1028,7 @@ contains #ifdef MFC_SIMULATION if (qbmm .and. .not. polytropic) then !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = -buff_size, -1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -1033,7 +1037,7 @@ contains ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + (n + 2*buff_size + 1)* & (l + buff_size))) - pb(j, k, l + unpack_offset, i - sys_size, q) = buff_recv(r) + pb(j, k, l + unpack_offset, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -1041,7 +1045,7 @@ contains end do !$acc parallel loop collapse(5) gang vector default(present) private(r) - do i = sys_size + 1, sys_size + 4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 4 do l = -buff_size, -1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size @@ -1050,7 +1054,7 @@ contains ((j + buff_size) + (m + 2*buff_size + 1)* & ((k + buff_size) + (n + 2*buff_size + 1)* & (l + buff_size))) - mv(j, k, l + unpack_offset, i - sys_size, q) = buff_recv(r) + mv(j, k, l + unpack_offset, i - eqn_idx%sys_size, q) = buff_recv(r) end do end do end do @@ -1174,8 +1178,7 @@ contains #:endif end if #:endfor - p_send => buff_send(0) - p_recv => buff_recv(0) + ! Send/Recv #ifdef MFC_SIMULATION #:for rdma_mpi in [False, True] diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index b520d700ba..815636dade 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -48,7 +48,7 @@ contains !! some parameter. It replaces the procedure pointer, which CCE !! is breaking on. impure subroutine s_relaxation_solver(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf ! This is empty because in current master the procedure pointer ! was never assigned @:ASSERT(.false., "s_relaxation_solver called but it currently does nothing") @@ -80,7 +80,7 @@ contains !! @param q_cons_vf Cell-average conservative variables pure subroutine s_infinite_relaxation_k(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp) :: pS, pSOV, pSSL !< equilibrium pressure for mixture, overheated vapor, and subcooled liquid real(wp) :: TS, TSOV, TSSL, TSatOV, TSatSL !< equilibrium temperature for mixture, overheated vapor, and subcooled liquid. Saturation Temperatures at overheated vapor and subcooled liquid real(wp) :: rhoe, dynE, rhos !< total internal energy, kinetic energy, and total entropy @@ -139,7 +139,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 @@ -293,7 +293,7 @@ contains integer, intent(in) :: j, k, l, MFL real(wp), intent(out) :: pS real(wp), dimension(num_fluids), intent(out) :: p_infpT - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf real(wp), intent(in) :: rhoe real(wp), intent(out) :: TS real(wp) :: gp, gpp, hp, pO, mCP, mQ !< variables for the Newton Solver @@ -397,7 +397,7 @@ contains real(wp), intent(inout) :: pS real(wp), dimension(num_fluids), intent(in) :: p_infpT real(wp), intent(in) :: rhoe - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp), intent(inout) :: TS real(wp), dimension(num_fluids) :: p_infpTg !< stiffness for the participating fluids for pTg-equilibrium @@ -521,7 +521,7 @@ contains !> @name variables for the correction of the reacting partial densities !> @{ real(wp), intent(out) :: MCT - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp), intent(inout) :: rM integer, intent(in) :: j, k, l !> @} @@ -586,7 +586,7 @@ contains real(wp), dimension(2, 2), intent(out) :: Jac integer, intent(in) :: k, l real(wp), intent(in) :: mCPD, mCVGP, mCVGP2, pS - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf real(wp), dimension(2, 2), intent(out) :: TJac real(wp) :: ml, mT, TS, dFdT, dTdm, dTdp ! mass of the reacting fluid, total reacting mass, and auxiliary variables @@ -690,7 +690,7 @@ contains integer, intent(in) :: j, k, l real(wp), intent(in) :: mCPD, mCVGP, mQD - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf real(wp), intent(in) :: pS, rhoe real(wp), dimension(2), intent(out) :: R2D diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 6b506b77cd..b8ec9abfbb 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -82,7 +82,7 @@ contains subroutine s_convert_to_mixture_variables(q_vf, i, j, k, & rho, gamma, pi_inf, qv, Re_K, G_K, G) - type(scalar_field), dimension(sys_size), intent(in) :: q_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_vf integer, intent(in) :: i, j, k real(wp), intent(out), target :: rho, gamma, pi_inf, qv real(wp), optional, dimension(2), intent(out) :: Re_K @@ -159,7 +159,7 @@ contains if (hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0._wp - do s = stress_idx%beg, stress_idx%end + do s = eqn_idx%stress%beg, eqn_idx%stress%end if (G > 0) then E_e = E_e + ((stress/rho)**2._wp)/(4._wp*G) ! Double for shear stresses @@ -208,7 +208,7 @@ contains subroutine s_convert_mixture_to_mixture_variables(q_vf, i, j, k, & rho, gamma, pi_inf, qv) - type(scalar_field), dimension(sys_size), intent(in) :: q_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_vf integer, intent(in) :: i, j, k real(wp), intent(out), target :: rho @@ -219,8 +219,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 nill for now. For future adjustment ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated @@ -250,7 +250,7 @@ contains subroutine s_convert_species_to_mixture_variables_bubbles(q_vf, j, k, l, & rho, gamma, pi_inf, qv, Re_K) - type(scalar_field), dimension(sys_size), intent(in) :: q_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_vf integer, intent(in) :: j, k, l @@ -289,8 +289,8 @@ contains if (model_eqns == 4) then rho = q_vf(1)%sf(j, k, l) - gamma = fluid_pp(1)%gamma !qK_vf(gamma_idx)%sf(i,j,k) - pi_inf = fluid_pp(1)%pi_inf !qK_vf(pi_inf_idx)%sf(i,j,k) + gamma = fluid_pp(1)%gamma !qK_vf(eqn_idx%gamma)%sf(i,j,k) + pi_inf = fluid_pp(1)%pi_inf !qK_vf(eqn_idx%pi_inf)%sf(i,j,k) qv = fluid_pp(1)%qv else if ((model_eqns == 2) .and. bubbles_euler) then rho = 0._wp; gamma = 0._wp; pi_inf = 0._wp; qv = 0._wp @@ -298,8 +298,8 @@ contains if (mpp_lim .and. (num_fluids > 2)) then do i = 1, num_fluids rho = rho + q_vf(i)%sf(j, k, l) - gamma = gamma + q_vf(i + E_idx)%sf(j, k, l)*fluid_pp(i)%gamma - pi_inf = pi_inf + q_vf(i + E_idx)%sf(j, k, l)*fluid_pp(i)%pi_inf + gamma = gamma + q_vf(i + eqn_idx%E)%sf(j, k, l)*fluid_pp(i)%gamma + pi_inf = pi_inf + q_vf(i + eqn_idx%E)%sf(j, k, l)*fluid_pp(i)%pi_inf qv = qv + q_vf(i)%sf(j, k, l)*fluid_pp(i)%qv end do else if (num_fluids == 2) then @@ -311,8 +311,8 @@ contains !TODO: This may need fixing for hypo + bubbles_euler do i = 1, num_fluids - 1 !leave out bubble part of mixture rho = rho + q_vf(i)%sf(j, k, l) - gamma = gamma + q_vf(i + E_idx)%sf(j, k, l)*fluid_pp(i)%gamma - pi_inf = pi_inf + q_vf(i + E_idx)%sf(j, k, l)*fluid_pp(i)%pi_inf + gamma = gamma + q_vf(i + eqn_idx%E)%sf(j, k, l)*fluid_pp(i)%gamma + pi_inf = pi_inf + q_vf(i + eqn_idx%E)%sf(j, k, l)*fluid_pp(i)%pi_inf qv = qv + q_vf(i)%sf(j, k, l)*fluid_pp(i)%qv end do ! rho = qK_vf(1)%sf(j,k,l) @@ -332,10 +332,10 @@ contains if (num_fluids == 1) then ! need to consider case with num_fluids >= 2 do i = 1, 2 - Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0._wp + Re_K(i) = dflt_real; if (eqn_idx%Re_size(i) > 0) Re_K(i) = 0._wp - do q = 1, Re_size(i) - Re_K(i) = (1 - alpha_K(Re_idx(i, q)))/fluid_pp(Re_idx(i, q))%Re(i) & + do q = 1, eqn_idx%Re_size(i) + Re_K(i) = (1 - alpha_K(eqn_idx%Re(i, q)))/fluid_pp(eqn_idx%Re(i, q))%Re(i) & + Re_K(i) end do @@ -372,7 +372,7 @@ contains subroutine s_convert_species_to_mixture_variables(q_vf, k, l, r, rho, & gamma, pi_inf, qv, Re_K, G_K, G) - type(scalar_field), dimension(sys_size), intent(in) :: q_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_vf integer, intent(in) :: k, l, r @@ -424,10 +424,10 @@ contains ! Computing the shear and bulk Reynolds numbers from species analogs do i = 1, 2 - Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0._wp + Re_K(i) = dflt_real; if (eqn_idx%Re_size(i) > 0) Re_K(i) = 0._wp - do j = 1, Re_size(i) - Re_K(i) = alpha_K(Re_idx(i, j))/fluid_pp(Re_idx(i, j))%Re(i) & + do j = 1, eqn_idx%Re_size(i) + Re_K(i) = alpha_K(eqn_idx%Re(i, j))/fluid_pp(eqn_idx%Re(i, j))%Re(i) & + Re_K(i) end do @@ -521,10 +521,10 @@ contains do i = 1, 2 Re_K(i) = dflt_real - if (Re_size(i) > 0) Re_K(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_K(i) = 0._wp - do j = 1, Re_size(i) - Re_K(i) = alpha_K(Re_idx(i, j))/Res(i, j) & + do j = 1, eqn_idx%Re_size(i) + Re_K(i) = alpha_K(eqn_idx%Re(i, j))/Res(i, j) & + Re_K(i) end do @@ -587,10 +587,10 @@ contains do i = 1, 2 Re_K(i) = dflt_real - if (Re_size(i) > 0) Re_K(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_K(i) = 0._wp - do j = 1, Re_size(i) - Re_K(i) = (1._wp - alpha_K(Re_idx(i, j)))/Res(i, j) & + do j = 1, eqn_idx%Re_size(i) + Re_K(i) = (1._wp - alpha_K(eqn_idx%Re(i, j)))/Res(i, j) & + Re_K(i) end do @@ -647,14 +647,14 @@ contains #ifdef MFC_SIMULATION if (viscous) then - @:ALLOCATE(Res(1:2, 1:maxval(Re_size))) + @:ALLOCATE(Res(1:2, 1:maxval(eqn_idx%Re_size))) do i = 1, 2 - do j = 1, Re_size(i) - Res(i, j) = fluid_pp(Re_idx(i, j))%Re(i) + do j = 1, eqn_idx%Re_size(i) + Res(i, j) = fluid_pp(eqn_idx%Re(i, j))%Re(i) end do end do - !$acc update device(Res, Re_idx, Re_size) + !$acc update device(Res, eqn_idx%Re, eqn_idx%Re_size) end if #endif @@ -666,7 +666,7 @@ contains #endif do i = 1, nb - bubrs(i) = bub_idx%rs(i) + bubrs(i) = eqn_idx%bub%rs(i) end do !$acc update device(bubrs) end if @@ -735,7 +735,7 @@ contains !Initialize mv at the quadrature nodes based on the initialized moments and sigma pure subroutine s_initialize_mv(qK_cons_vf, mv) - type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: qK_cons_vf real(wp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(inout) :: mv @@ -767,7 +767,7 @@ contains !Initialize pb at the quadrature nodes using isothermal relations (Preston model) pure subroutine s_initialize_pb(qK_cons_vf, mv, pb) - type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: qK_cons_vf real(wp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(in) :: mv real(wp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(inout) :: pb @@ -811,9 +811,9 @@ contains qK_prim_vf, & ibounds) - type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: qK_cons_vf type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(inout) :: qK_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: qK_prim_vf type(int_bounds_info), dimension(1:3), intent(in) :: ibounds real(wp), dimension(num_fluids) :: alpha_K, alpha_rho_K @@ -911,12 +911,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(eqn_idx%B%beg)%sf(j, k, l) + B(3) = qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l) else - B(1) = qK_cons_vf(B_idx%beg)%sf(j, k, l) - B(2) = qK_cons_vf(B_idx%beg + 1)%sf(j, k, l) - B(3) = qK_cons_vf(B_idx%beg + 2)%sf(j, k, l) + B(1) = qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l) + B(2) = qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l) + B(3) = qK_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l) end if B2 = B(1)**2 + B(2)**2 + B(3)**2 @@ -932,7 +932,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 !$acc loop seq @@ -965,7 +965,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 !$acc loop seq @@ -975,7 +975,7 @@ contains qK_prim_vf(1)%sf(j, k, l) = D/Ga ! Hard-coded for single-component for now !$acc loop seq - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do @@ -1033,20 +1033,20 @@ contains if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + qK_cons_vf(B_idx%beg)%sf(j, k, l)**2 + qK_cons_vf(B_idx%beg + 1)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(Bx0**2 + qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(qK_cons_vf(B_idx%beg)%sf(j, k, l)**2 + qK_cons_vf(B_idx%beg + 1)%sf(j, k, l)**2 + qK_cons_vf(B_idx%beg + 2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(qK_cons_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + qK_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2 + qK_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2) end if else pres_mag = 0._wp end if - call s_compute_pressure(qK_cons_vf(E_idx)%sf(j, k, l), & - qK_cons_vf(alf_idx)%sf(j, k, l), & + 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 @@ -1058,7 +1058,7 @@ contains nRtmp(i) = qK_cons_vf(bubrs(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) @@ -1076,8 +1076,8 @@ contains 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 @@ -1091,7 +1091,7 @@ contains if (mhd) then !$acc loop seq - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do end if @@ -1108,12 +1108,12 @@ contains do i = strxb, strxe ! subtracting elastic contribution for pressure calculation if (G_K > verysmall) then - if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(damage_idx)%sf(j, k, l)), 0._wp) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp) + 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(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 @@ -1133,10 +1133,10 @@ contains end do if (surface_tension) then - qK_prim_vf(c_idx)%sf(j, k, l) = qK_cons_vf(c_idx)%sf(j, k, l) + qK_prim_vf(eqn_idx%c)%sf(j, k, l) = qK_cons_vf(eqn_idx%c)%sf(j, k, l) end if - if (cont_damage) qK_prim_vf(damage_idx)%sf(j, k, l) = qK_cons_vf(damage_idx)%sf(j, k, l) + if (cont_damage) qK_prim_vf(eqn_idx%damage)%sf(j, k, l) = qK_cons_vf(eqn_idx%damage)%sf(j, k, l) end do end do @@ -1156,8 +1156,8 @@ contains impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & q_cons_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, @@ -1201,7 +1201,7 @@ contains rho, gamma, pi_inf, qv, Re_K, G, fluid_pp(:)%G) ! Transferring the advection equation(s) variable(s) - do i = adv_idx%beg, adv_idx%end + do i = eqn_idx%adv%beg, eqn_idx%adv%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do @@ -1209,12 +1209,12 @@ contains if (n == 0) then B(1) = Bx0 - B(2) = q_prim_vf(B_idx%beg)%sf(j, k, l) - B(3) = q_prim_vf(B_idx%beg + 1)%sf(j, k, l) + B(2) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) + B(3) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l) else - B(1) = q_prim_vf(B_idx%beg)%sf(j, k, l) - B(2) = q_prim_vf(B_idx%beg + 1)%sf(j, k, l) - B(3) = q_prim_vf(B_idx%beg + 2)%sf(j, k, l) + B(1) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l) + B(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l) + B(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l) end if v2 = 0._wp @@ -1225,10 +1225,10 @@ 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 + 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 @@ -1247,14 +1247,14 @@ contains - 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) & + 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 + 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 @@ -1285,35 +1285,35 @@ 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) = & + q_cons_vf(eqn_idx%E)%sf(j, k, l) = & dyn_pres + rho*e_mix else ! Computing the energy from the pressure if (mhd) then if (n == 0) then - pres_mag = 0.5_wp*(Bx0**2 + q_prim_vf(B_idx%beg)%sf(j, k, l)**2 + q_prim_vf(B_idx%beg + 1)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(Bx0**2 + q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(q_prim_vf(B_idx%beg)%sf(j, k, l)**2 + q_prim_vf(B_idx%beg + 1)%sf(j, k, l)**2 + q_prim_vf(B_idx%beg + 2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2 + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2) end if - q_cons_vf(E_idx)%sf(j, k, l) = & - gamma*q_prim_vf(E_idx)%sf(j, k, l) + dyn_pres + pres_mag & + 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 elseif ((model_eqns /= 4) .and. (bubbles_euler .neqv. .true.)) then ! E = Gamma*P + \rho u u /2 + \pi_inf + (\alpha\rho qv) - q_cons_vf(E_idx)%sf(j, k, l) = & - gamma*q_prim_vf(E_idx)%sf(j, k, l) + dyn_pres + pi_inf & + 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 ! \tilde{E} = dyn_pres + (1-\alf)(\Gamma p_l + \Pi_inf) - 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 !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 @@ -1321,26 +1321,26 @@ contains if (model_eqns == 3) then do i = 1, num_fluids ! internal energy calculation for each of the fluids - q_cons_vf(i + internalEnergies_idx%beg - 1)%sf(j, k, l) = & - q_cons_vf(i + adv_idx%beg - 1)%sf(j, k, l)* & - (fluid_pp(i)%gamma*q_prim_vf(E_idx)%sf(j, k, l) + & + q_cons_vf(i + eqn_idx%internalEnergies%beg - 1)%sf(j, k, l) = & + q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)* & + (fluid_pp(i)%gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + & fluid_pp(i)%pi_inf) + & - q_cons_vf(i + cont_idx%beg - 1)%sf(j, k, l)*fluid_pp(i)%qv + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*fluid_pp(i)%qv end do end if if (bubbles_euler) then ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3} do i = 1, nb - Rtmp(i) = q_prim_vf(bub_idx%rs(i))%sf(j, k, l) + Rtmp(i) = q_prim_vf(eqn_idx%bub%rs(i))%sf(j, k, l) end do if (.not. qbmm) then if (adv_n) then - q_cons_vf(n_idx)%sf(j, k, l) = q_prim_vf(n_idx)%sf(j, k, l) - nbub = q_prim_vf(n_idx)%sf(j, k, l) + q_cons_vf(eqn_idx%n)%sf(j, k, l) = q_prim_vf(eqn_idx%n)%sf(j, k, l) + nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l) else - call s_comp_n_from_prim(q_prim_vf(alf_idx)%sf(j, k, l), Rtmp, nbub, weight) + call s_comp_n_from_prim(q_prim_vf(eqn_idx%alf)%sf(j, k, l), Rtmp, nbub, weight) end if else !Initialize R3 averaging over R0 and R directions @@ -1350,18 +1350,18 @@ 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 if (j == 0 .and. k == 0 .and. l == 0) print *, 'In convert, nbub:', nbub - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub end do end if if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l) end do end if @@ -1378,13 +1378,13 @@ contains do i = strxb, strxe ! adding elastic contribution if (G > verysmall) 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(eqn_idx%damage)%sf(j, k, l)), 0._wp) - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%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_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_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 @@ -1400,10 +1400,10 @@ 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) + if (cont_damage) q_cons_vf(eqn_idx%damage)%sf(j, k, l) = q_prim_vf(eqn_idx%damage)%sf(j, k, l) end do end do @@ -1478,7 +1478,7 @@ contains !$acc loop 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 !$acc loop seq do i = 1, num_vels @@ -1491,7 +1491,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, & @@ -1526,25 +1526,25 @@ contains ! mass flux, this should be \alpha_i \rho_i u_i !$acc loop seq do i = 1, contxe - FK_vf(j, k, l, i) = alpha_rho_K(i)*vel_K(dir_idx(1)) + FK_vf(j, k, l, i) = alpha_rho_K(i)*vel_K(eqn_idx%dir(1)) end do !$acc loop 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, contxe + eqn_idx%dir(i)) = & + rho_K*vel_K(eqn_idx%dir(1)) & + *vel_K(eqn_idx%dir(i)) & + + pres_K*eqn_idx%dir_flg(eqn_idx%dir(i)) end do ! energy flux, u(E+p) - FK_vf(j, k, l, E_idx) = vel_K(dir_idx(1))*(E_K + pres_K) + FK_vf(j, k, l, eqn_idx%E) = vel_K(eqn_idx%dir(1))*(E_K + pres_K) ! Species advection Flux, \rho*u*Y if (chemistry) then !$acc loop 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 + chemxb) = vel_K(eqn_idx%dir(1))*(rho_K*Y_K(i)) end do end if @@ -1552,19 +1552,19 @@ contains !$acc loop 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! !$acc loop 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(eqn_idx%dir(1))*alpha_K(i - eqn_idx%E) end do !$acc loop seq do i = advxb, advxe - FK_src_vf(j, k, l, i) = vel_K(dir_idx(1)) + FK_src_vf(j, k, l, i) = vel_K(eqn_idx%dir(1)) end do end if diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 45a2baa728..e652922a64 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -80,7 +80,7 @@ impure subroutine s_read_serial_data_files(t_step) !! Generic string used to store the location of a particular file character(LEN= & - int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< + int(floor(log10(real(eqn_idx%sys_size, wp)))) + 1) :: file_num !< !! Used to store the variable position, in character form, of the !! currently manipulated conservative variable file @@ -201,7 +201,7 @@ impure subroutine s_read_serial_data_files(t_step) end if ! Reading the Conservative Variables Data Files - do i = 1, sys_size + do i = 1, eqn_idx%sys_size ! Checking whether the data file associated with the variable ! position of currently manipulated conservative variable exists @@ -242,7 +242,7 @@ impure subroutine s_read_serial_data_files(t_step) ! Checking whether the data file associated with the variable ! position of currently manipulated conservative variable exists - write (file_num, '(I0)') sys_size + 1 + write (file_num, '(I0)') eqn_idx%sys_size + 1 file_loc = trim(t_step_dir)//'/q_cons_vf'// & trim(file_num)//'.dat' inquire (FILE=trim(file_loc), EXIST=file_check) @@ -292,12 +292,12 @@ impure subroutine s_read_parallel_data_files(t_step) integer :: i - integer :: alt_sys !Altered sys_size for lagrangian solver + integer :: alt_sys !Altered eqn_idx%sys_size for lagrangian solver if (bubbles_lagrange) then - alt_sys = sys_size + 1 + alt_sys = eqn_idx%sys_size + 1 else - alt_sys = sys_size + alt_sys = eqn_idx%sys_size end if allocate (x_cb_glb(-1:m_glb)) @@ -395,18 +395,18 @@ impure subroutine s_read_parallel_data_files(t_step) WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Read the data for each variable if (bubbles_euler .or. elasticity .or. mhd) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & mpi_p, status, ierr) end do else - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -475,7 +475,7 @@ impure subroutine s_read_parallel_data_files(t_step) ! Read the data for each variable if (bubbles_euler .or. elasticity) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -487,7 +487,7 @@ impure subroutine s_read_parallel_data_files(t_step) mpi_p, status, ierr) end do else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -501,14 +501,14 @@ impure subroutine s_read_parallel_data_files(t_step) end if if (bubbles_lagrange) then !Lagrangian solver - var_MOK = int(sys_size + 1, MPI_OFFSET_KIND) + var_MOK = int(eqn_idx%sys_size + 1, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(sys_size + 1), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(eqn_idx%sys_size + 1), & 'native', mpi_info_int, ierr) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(sys_size + 1)%sf, data_size, & + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(eqn_idx%sys_size + 1)%sf, data_size, & mpi_p, status, ierr) end if @@ -817,7 +817,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(-j, 0:n, 0:p) = & q_particle%sf(0, 0:n, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(-j, 0:n, 0:p) = q_cons_vf(i)%sf(0, 0:n, 0:p) end do end if @@ -833,18 +833,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(j - 1, 0:n, 0:p) else ! Density or partial densities - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_cons_vf(i)%sf(-j, 0:n, 0:p) = & q_cons_vf(i)%sf(j - 1, 0:n, 0:p) end do ! x-component of momentum - q_cons_vf(mom_idx%beg)%sf(-j, 0:n, 0:p) = & - -q_cons_vf(mom_idx%beg)%sf(j - 1, 0:n, 0:p) + q_cons_vf(eqn_idx%mom%beg)%sf(-j, 0:n, 0:p) = & + -q_cons_vf(eqn_idx%mom%beg)%sf(j - 1, 0:n, 0:p) ! Remaining momentum component(s), if any, as well as the ! energy and the variable(s) from advection equation(s) - do i = mom_idx%beg + 1, sys_size + do i = eqn_idx%mom%beg + 1, eqn_idx%sys_size q_cons_vf(i)%sf(-j, 0:n, 0:p) = & q_cons_vf(i)%sf(j - 1, 0:n, 0:p) end do @@ -860,7 +860,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(-j, 0:n, 0:p) = & q_particle%sf((m + 1) - j, 0:n, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(-j, 0:n, 0:p) = & q_cons_vf(i)%sf((m + 1) - j, 0:n, 0:p) end do @@ -887,7 +887,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(m + j, 0:n, 0:p) = & q_particle%sf(m, 0:n, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(m + j, 0:n, 0:p) = & q_cons_vf(i)%sf(m, 0:n, 0:p) end do @@ -905,18 +905,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) else ! Density or partial densities - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_cons_vf(i)%sf(m + j, 0:n, 0:p) = & q_cons_vf(i)%sf((m + 1) - j, 0:n, 0:p) end do ! x-component of momentum - q_cons_vf(mom_idx%beg)%sf(m + j, 0:n, 0:p) = & - -q_cons_vf(mom_idx%beg)%sf((m + 1) - j, 0:n, 0:p) + q_cons_vf(eqn_idx%mom%beg)%sf(m + j, 0:n, 0:p) = & + -q_cons_vf(eqn_idx%mom%beg)%sf((m + 1) - j, 0:n, 0:p) ! Remaining momentum component(s), if any, as well as the ! energy and the variable(s) from advection equation(s) - do i = mom_idx%beg + 1, sys_size + do i = eqn_idx%mom%beg + 1, eqn_idx%sys_size q_cons_vf(i)%sf(m + j, 0:n, 0:p) = & q_cons_vf(i)%sf((m + 1) - j, 0:n, 0:p) end do @@ -932,7 +932,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(m + j, 0:n, 0:p) = & q_particle%sf(j - 1, 0:n, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(m + j, 0:n, 0:p) = & q_cons_vf(i)%sf(j - 1, 0:n, 0:p) end do @@ -965,7 +965,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) if (present(q_particle)) then q_particle%sf(:, -j, 0:p) = q_particle%sf(:, 0, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, -j, 0:p) = q_cons_vf(i)%sf(:, 0, 0:p) end do end if @@ -981,18 +981,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, -j, k) = & q_particle%sf(:, j - 1, k + ((p + 1)/2)) else - do i = 1, mom_idx%beg + do i = 1, eqn_idx%mom%beg q_cons_vf(i)%sf(:, -j, k) = & q_cons_vf(i)%sf(:, j - 1, k + ((p + 1)/2)) end do - q_cons_vf(mom_idx%beg + 1)%sf(:, -j, k) = & - -q_cons_vf(mom_idx%beg + 1)%sf(:, j - 1, k + ((p + 1)/2)) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, -j, k) = & + -q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, j - 1, k + ((p + 1)/2)) - q_cons_vf(mom_idx%end)%sf(:, -j, k) = & - -q_cons_vf(mom_idx%end)%sf(:, j - 1, k + ((p + 1)/2)) + q_cons_vf(eqn_idx%mom%end)%sf(:, -j, k) = & + -q_cons_vf(eqn_idx%mom%end)%sf(:, j - 1, k + ((p + 1)/2)) - do i = E_idx, sys_size + do i = eqn_idx%E, eqn_idx%sys_size q_cons_vf(i)%sf(:, -j, k) = & q_cons_vf(i)%sf(:, j - 1, k + ((p + 1)/2)) end do @@ -1002,18 +1002,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, -j, k) = & q_particle%sf(:, j - 1, k - ((p + 1)/2)) else - do i = 1, mom_idx%beg + do i = 1, eqn_idx%mom%beg q_cons_vf(i)%sf(:, -j, k) = & q_cons_vf(i)%sf(:, j - 1, k - ((p + 1)/2)) end do - q_cons_vf(mom_idx%beg + 1)%sf(:, -j, k) = & - -q_cons_vf(mom_idx%beg + 1)%sf(:, j - 1, k - ((p + 1)/2)) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, -j, k) = & + -q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, j - 1, k - ((p + 1)/2)) - q_cons_vf(mom_idx%end)%sf(:, -j, k) = & - -q_cons_vf(mom_idx%end)%sf(:, j - 1, k - ((p + 1)/2)) + q_cons_vf(eqn_idx%mom%end)%sf(:, -j, k) = & + -q_cons_vf(eqn_idx%mom%end)%sf(:, j - 1, k - ((p + 1)/2)) - do i = E_idx, sys_size + do i = eqn_idx%E, eqn_idx%sys_size q_cons_vf(i)%sf(:, -j, k) = & q_cons_vf(i)%sf(:, j - 1, k - ((p + 1)/2)) end do @@ -1031,18 +1031,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, j - 1, 0:p) else ! Density or partial densities and x-momentum component - do i = 1, mom_idx%beg + do i = 1, eqn_idx%mom%beg q_cons_vf(i)%sf(:, -j, 0:p) = & q_cons_vf(i)%sf(:, j - 1, 0:p) end do ! y-component of momentum - q_cons_vf(mom_idx%beg + 1)%sf(:, -j, 0:p) = & - -q_cons_vf(mom_idx%beg + 1)%sf(:, j - 1, 0:p) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, -j, 0:p) = & + -q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, j - 1, 0:p) ! Remaining z-momentum component, if any, as well as the ! energy and variable(s) from advection equation(s) - do i = mom_idx%beg + 2, sys_size + do i = eqn_idx%mom%beg + 2, eqn_idx%sys_size q_cons_vf(i)%sf(:, -j, 0:p) = & q_cons_vf(i)%sf(:, j - 1, 0:p) end do @@ -1058,7 +1058,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, -j, 0:p) = & q_particle%sf(:, (n + 1) - j, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, -j, 0:p) = & q_cons_vf(i)%sf(:, (n + 1) - j, 0:p) end do @@ -1085,7 +1085,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, n + j, 0:p) = & q_particle%sf(:, n, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, n + j, 0:p) = & q_cons_vf(i)%sf(:, n, 0:p) end do @@ -1101,18 +1101,18 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, (n + 1) - j, 0:p) else ! Density or partial densities and x-momentum component - do i = 1, mom_idx%beg + do i = 1, eqn_idx%mom%beg q_cons_vf(i)%sf(:, n + j, 0:p) = & q_cons_vf(i)%sf(:, (n + 1) - j, 0:p) end do ! y-component of momentum - q_cons_vf(mom_idx%beg + 1)%sf(:, n + j, 0:p) = & - -q_cons_vf(mom_idx%beg + 1)%sf(:, (n + 1) - j, 0:p) + q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, n + j, 0:p) = & + -q_cons_vf(eqn_idx%mom%beg + 1)%sf(:, (n + 1) - j, 0:p) ! Remaining z-momentum component, if any, as well as the ! energy and variable(s) from advection equation(s) - do i = mom_idx%beg + 2, sys_size + do i = eqn_idx%mom%beg + 2, eqn_idx%sys_size q_cons_vf(i)%sf(:, n + j, 0:p) = & q_cons_vf(i)%sf(:, (n + 1) - j, 0:p) end do @@ -1128,7 +1128,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, n + j, 0:p) = & q_particle%sf(:, j - 1, 0:p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, n + j, 0:p) = & q_cons_vf(i)%sf(:, j - 1, 0:p) end do @@ -1161,7 +1161,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) if (present(q_particle)) then q_particle%sf(:, :, -j) = q_particle%sf(:, :, 0) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, -j) = q_cons_vf(i)%sf(:, :, 0) end do end if @@ -1177,17 +1177,17 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) else ! Density or the partial densities and the momentum ! components in x- and y-directions - do i = 1, mom_idx%beg + 1 + do i = 1, eqn_idx%mom%beg + 1 q_cons_vf(i)%sf(:, :, -j) = & q_cons_vf(i)%sf(:, :, j - 1) end do ! z-component of momentum - q_cons_vf(mom_idx%end)%sf(:, :, -j) = & - -q_cons_vf(mom_idx%end)%sf(:, :, j - 1) + q_cons_vf(eqn_idx%mom%end)%sf(:, :, -j) = & + -q_cons_vf(eqn_idx%mom%end)%sf(:, :, j - 1) ! Energy and advection equation(s) variable(s) - do i = E_idx, sys_size + do i = eqn_idx%E, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, -j) = & q_cons_vf(i)%sf(:, :, j - 1) end do @@ -1203,7 +1203,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, :, -j) = & q_particle%sf(:, :, (p + 1) - j) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, -j) = & q_cons_vf(i)%sf(:, :, (p + 1) - j) end do @@ -1231,7 +1231,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, :, p + j) = & q_particle%sf(:, :, p) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, p + j) = & q_cons_vf(i)%sf(:, :, p) end do @@ -1248,17 +1248,17 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) else ! Density or the partial densities and the momentum ! components in x- and y-directions - do i = 1, mom_idx%beg + 1 + do i = 1, eqn_idx%mom%beg + 1 q_cons_vf(i)%sf(:, :, p + j) = & q_cons_vf(i)%sf(:, :, (p + 1) - j) end do ! z-component of momentum - q_cons_vf(mom_idx%end)%sf(:, :, p + j) = & - -q_cons_vf(mom_idx%end)%sf(:, :, (p + 1) - j) + q_cons_vf(eqn_idx%mom%end)%sf(:, :, p + j) = & + -q_cons_vf(eqn_idx%mom%end)%sf(:, :, (p + 1) - j) ! Energy and advection equation(s) variable(s) - do i = E_idx, sys_size + do i = eqn_idx%E, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, p + j) = & q_cons_vf(i)%sf(:, :, (p + 1) - j) end do @@ -1274,7 +1274,7 @@ impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) q_particle%sf(:, :, p + j) = & q_particle%sf(:, :, j - 1) else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf(:, :, p + j) = & q_cons_vf(i)%sf(:, :, j - 1) end do @@ -1311,8 +1311,8 @@ impure subroutine s_initialize_data_input_module ! Allocating the parts of the conservative and primitive variables ! that do not require the direct knowledge of the dimensionality of ! the simulation - allocate (q_cons_vf(1:sys_size)) - allocate (q_prim_vf(1:sys_size)) + allocate (q_cons_vf(1:eqn_idx%sys_size)) + allocate (q_prim_vf(1:eqn_idx%sys_size)) if (bubbles_lagrange) allocate (q_particle(1)) ! Allocating the parts of the conservative and primitive variables @@ -1325,7 +1325,7 @@ impure subroutine s_initialize_data_input_module ! Simulation is 3D if (p > 0) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size allocate (q_cons_vf(i)%sf(-buff_size:m + buff_size, & -buff_size:n + buff_size, & -buff_size:p + buff_size)) @@ -1355,7 +1355,7 @@ impure subroutine s_initialize_data_input_module ! Simulation is 2D else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size allocate (q_cons_vf(i)%sf(-buff_size:m + buff_size, & -buff_size:n + buff_size, & 0:0)) @@ -1386,7 +1386,7 @@ impure subroutine s_initialize_data_input_module ! Simulation is 1D else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size allocate (q_cons_vf(i)%sf(-buff_size:m + buff_size, & 0:0, & 0:0)) @@ -1423,7 +1423,7 @@ impure subroutine s_finalize_data_input_module integer :: i !< Generic loop iterator ! Deallocating the conservative and primitive variables - do i = 1, sys_size + do i = 1, eqn_idx%sys_size deallocate (q_cons_vf(i)%sf) deallocate (q_prim_vf(i)%sf) end do diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 382f8387ae..a2ed7a304c 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -323,17 +323,17 @@ contains if (relativity .and. (rho_wrt .or. cons_vars_wrt)) dbvars = dbvars + 1 ! Momentum - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (mom_wrt(i) .or. cons_vars_wrt) dbvars = dbvars + 1 end do ! Velocity - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (vel_wrt(i) .or. prim_vars_wrt) dbvars = dbvars + 1 end do ! Flux limiter function - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (flux_wrt(i)) dbvars = dbvars + 1 end do @@ -1193,7 +1193,7 @@ contains end subroutine s_write_lag_bubbles_results impure subroutine s_write_intf_data_file(q_prim_vf) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(IN) :: q_prim_vf integer :: i, j, k, l, cent !< Generic loop iterators integer :: counter, root !< number of data points extracted to fit shape to SH perturbations real(wp), parameter :: pi = 4._wp*tan(1._wp) @@ -1207,8 +1207,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 @@ -1228,10 +1228,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,7 +1283,7 @@ contains end subroutine s_write_intf_data_file impure subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(IN) :: q_prim_vf, q_cons_vf real(wp) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et real(wp) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H real(wp), dimension(num_vels) :: vel @@ -1313,18 +1313,18 @@ contains rho = 0_wp gamma = 0_wp pi_inf = 0_wp - pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*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)*(fluid_pp(2)%gamma*pres)*dV do s = 1, num_vels vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - Egk = Egk + 0.5_wp*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV - Elk = Elk + 0.5_wp*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + Egk = Egk + 0.5_wp*q_prim_vf(eqn_idx%E + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5_wp*q_prim_vf(eqn_idx%E + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV if (abs(vel(s)) > maxvel) then maxvel = abs(vel(s)) end if end do - do l = 1, adv_idx%end - E_idx - adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + do l = 1, eqn_idx%adv%end - eqn_idx%E + adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) gamma = gamma + adv(l)*fluid_pp(l)%gamma pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) @@ -1343,7 +1343,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 0deffe61ba..4b87217635 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -174,7 +174,7 @@ contains pure subroutine s_derive_sound_speed(q_prim_vf, q_sf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_prim_vf real(wp), & @@ -197,16 +197,16 @@ contains ! Compute mixture sound speed 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) + & + 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 = ((fluid_pp(1)%gamma + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + & + blkmod1 = ((fluid_pp(1)%gamma + 1._wp)*q_prim_vf(eqn_idx%E)%sf(i, j, k) + & fluid_pp(1)%pi_inf)/fluid_pp(1)%gamma - blkmod2 = ((fluid_pp(2)%gamma + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + & + blkmod2 = ((fluid_pp(2)%gamma + 1._wp)*q_prim_vf(eqn_idx%E)%sf(i, j, k) + & fluid_pp(2)%pi_inf)/fluid_pp(2)%gamma - 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))) + 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 @@ -232,7 +232,7 @@ contains integer, intent(in) :: i - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf real(wp), dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & @@ -246,40 +246,40 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end if (i == 1) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j - 1, k, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j - 1, k, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j + 2, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j + 2, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j + 1, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if elseif (i == 2) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k - 1, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k - 1, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j, k + 2, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 2, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k + 1, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if else - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then - top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l - 1) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + if (q_prim_vf(eqn_idx%cont%end + i)%sf(j, k, l) >= 0._wp) then + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l - 1) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) else - top = q_prim_vf(adv_idx%beg)%sf(j, k, l + 2) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - bottom = q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - & - q_prim_vf(adv_idx%beg)%sf(j, k, l) + top = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 2) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) + bottom = q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l + 1) - & + q_prim_vf(eqn_idx%adv%beg)%sf(j, k, l) end if end if @@ -377,7 +377,7 @@ contains integer, intent(in) :: i type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_prim_vf real(wp), & @@ -401,15 +401,15 @@ contains 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) & + q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, l) & - fd_coeff_z(r, l)* & - q_prim_vf(mom_idx%beg + 1)%sf(j, k, r + l)) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, r + l)) else q_sf(j, k, l) = & q_sf(j, k, l) + fd_coeff_y(r, k)* & - q_prim_vf(mom_idx%end)%sf(j, r + k, l) & + q_prim_vf(eqn_idx%mom%end)%sf(j, r + k, l) & - fd_coeff_z(r, l)* & - q_prim_vf(mom_idx%beg + 1)%sf(j, k, r + l) + q_prim_vf(eqn_idx%mom%beg + 1)%sf(j, k, r + l) end if end do @@ -429,15 +429,15 @@ contains 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) & + q_prim_vf(eqn_idx%mom%beg)%sf(j, k, r + l) & - fd_coeff_x(r, j)* & - q_prim_vf(mom_idx%end)%sf(r + j, k, l) + q_prim_vf(eqn_idx%mom%end)%sf(r + j, k, l) else q_sf(j, k, l) = & q_sf(j, k, l) + fd_coeff_z(r, l)* & - q_prim_vf(mom_idx%beg)%sf(j, k, r + l) & + q_prim_vf(eqn_idx%mom%beg)%sf(j, k, r + l) & - fd_coeff_x(r, j)* & - q_prim_vf(mom_idx%end)%sf(r + j, k, l) + q_prim_vf(eqn_idx%mom%end)%sf(r + j, k, l) end if end do @@ -456,9 +456,9 @@ contains 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) & + q_prim_vf(eqn_idx%mom%beg + 1)%sf(r + j, k, l) & - fd_coeff_y(r, k)* & - q_prim_vf(mom_idx%beg)%sf(j, r + k, l) + q_prim_vf(eqn_idx%mom%beg)%sf(j, r + k, l) end do end do @@ -476,7 +476,7 @@ contains !! @param q_sf Q_M pure subroutine s_derive_qm(q_prim_vf, q_sf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_prim_vf real(wp), & @@ -504,17 +504,17 @@ contains 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) + q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(r + j, k, l) ! d()/dy q_jacobian_sf(jj, 2) = & q_jacobian_sf(jj, 2) + & fd_coeff_y(r, k)* & - q_prim_vf(mom_idx%beg + jj - 1)%sf(j, r + k, l) + q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, r + k, l) ! d()/dz q_jacobian_sf(jj, 3) = & q_jacobian_sf(jj, 3) + & fd_coeff_z(r, l)* & - q_prim_vf(mom_idx%beg + jj - 1)%sf(j, k, r + l) + q_prim_vf(eqn_idx%mom%beg + jj - 1)%sf(j, k, r + l) end do end do @@ -564,7 +564,7 @@ contains impure subroutine s_derive_numerical_schlieren_function(q_cons_vf, q_sf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf real(wp), & @@ -667,10 +667,10 @@ contains q_sf(j, k, l) = 0._wp - do i = 1, adv_idx%end - E_idx + 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 + E_idx)%sf(j, k, l)* & + 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 2c93cca230..9ed1995723 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -101,7 +101,7 @@ module m_global_parameters logical :: relax !< phase change integer :: relax_model !< Phase change relaxation model logical :: mpp_lim !< Maximum volume fraction limiter - integer :: sys_size !< Number of unknowns in the system of equations + ! integer :: eqn_idx%sys_size !< Number of unknowns in the system of equations integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: mixture_err !< Mixture error limiter logical :: alt_soundspeed !< Alternate sound speed @@ -120,23 +120,25 @@ module m_global_parameters !> @name Annotations of the structure, i.e. the organization, of the state vectors !> @{ - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of energy equation - integer :: n_idx !< Index of number density - 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 - !> @} + ! type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. + ! type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. + ! integer :: E_idx !< Index of energy equation + ! integer :: n_idx !< Index of number density + ! type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. + ! type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. + ! type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. + ! integer :: 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 + ! !> @} + + type(system_of_equations) :: eqn_idx ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). ! Stands for "InDices With BUFFer". @@ -479,16 +481,16 @@ contains ! Annotating structure of the state and flux vectors belonging ! to the system of equations defined by the selected number of ! spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + eqn_idx%sys_size = eqn_idx%adv%end ! Volume Fraction Model (5-equation model) else if (model_eqns == 2) then @@ -496,20 +498,20 @@ 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 volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + 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 - sys_size = adv_idx%end + eqn_idx%sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (qbmm) then @@ -518,35 +520,35 @@ contains if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = eqn_idx%sys_size + 1 if (qbmm) then - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = eqn_idx%sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = eqn_idx%sys_size + 2*nb end if end if - sys_size = bub_idx%end + eqn_idx%sys_size = eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + n = eqn_idx%bub%end + 1 + eqn_idx%sys_size = n end if - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + allocate (eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) allocate (weight(nb), R0(nb), V0(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) + allocate (eqn_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 + eqn_idx%bub%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%rs(i) = bub_idx%moms(i, 2) - bub_idx%vs(i) = bub_idx%moms(i, 3) + eqn_idx%bub%rs(i) = eqn_idx%bub%moms(i, 2) + eqn_idx%bub%vs(i) = eqn_idx%bub%moms(i, 3) end do else do i = 1, nb @@ -556,12 +558,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do end if @@ -587,13 +589,13 @@ contains end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = eqn_idx%sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = eqn_idx%sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = eqn_idx%sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + eqn_idx%sys_size = eqn_idx%B%end end if ! Volume Fraction Model (6-equation model) @@ -602,39 +604,39 @@ 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 volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - alf_idx = 1 ! dummy, cannot actually have a void fraction + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%internalEnergies%beg = eqn_idx%adv%end + 1 + eqn_idx%internalEnergies%end = eqn_idx%adv%end + num_fluids + eqn_idx%sys_size = eqn_idx%internalEnergies%end + eqn_idx%alf = 1 ! dummy, cannot actually have a void fraction else if (model_eqns == 4) then - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 !num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg !one volume advection equation - alf_idx = adv_idx%end - sys_size = alf_idx !adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 !num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg !one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + eqn_idx%sys_size = eqn_idx%alf !adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = eqn_idx%sys_size + 1 + eqn_idx%bub%end = eqn_idx%sys_size + 2*nb if (polytropic .neqv. .true.) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = eqn_idx%sys_size + 4*nb end if - sys_size = bub_idx%end + eqn_idx%sys_size = eqn_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + allocate (eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) allocate (weight(nb), R0(nb), V0(nb)) do i = 1, nb @@ -644,12 +646,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do @@ -674,24 +676,24 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = eqn_idx%sys_size + 1 + eqn_idx%stress%end = eqn_idx%sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + eqn_idx%sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2, 1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1, 1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2, 1:2) = shear_indices((/1, 3/)) @@ -703,36 +705,36 @@ contains end if if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%xi%beg = eqn_idx%sys_size + 1 + eqn_idx%xi%end = eqn_idx%sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + eqn_idx%sys_size = eqn_idx%xi%end + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = eqn_idx%sys_size + 1 + eqn_idx%sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = eqn_idx%sys_size + 1 + eqn_idx%sys_size = eqn_idx%damage else - damage_idx = dflt_int + eqn_idx%damage = dflt_int end if end if if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = eqn_idx%sys_size + 1 + eqn_idx%species%end = eqn_idx%sys_size + num_species + eqn_idx%sys_size = eqn_idx%species%end else - species_idx%beg = 1 - species_idx%end = 1 + eqn_idx%species%beg = 1 + eqn_idx%species%end = 1 end if if (output_partial_domain) then @@ -744,35 +746,35 @@ 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 = 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%internalEnergies%beg + intxe = eqn_idx%internalEnergies%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 (bubbles_lagrange) then - allocate (MPI_IO_DATA%view(1:sys_size + 1)) - allocate (MPI_IO_DATA%var(1:sys_size + 1)) - do i = 1, sys_size + 1 + allocate (MPI_IO_DATA%view(1:eqn_idx%sys_size + 1)) + allocate (MPI_IO_DATA%var(1:eqn_idx%sys_size + 1)) + do i = 1, eqn_idx%sys_size + 1 allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p)) MPI_IO_DATA%var(i)%sf => null() end do else - allocate (MPI_IO_DATA%view(1:sys_size)) - allocate (MPI_IO_DATA%var(1:sys_size)) - do i = 1, sys_size + allocate (MPI_IO_DATA%view(1:eqn_idx%sys_size)) + allocate (MPI_IO_DATA%var(1:eqn_idx%sys_size)) + do i = 1, eqn_idx%sys_size allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p)) MPI_IO_DATA%var(i)%sf => null() end do @@ -949,11 +951,11 @@ contains if (parallel_io) then deallocate (start_idx) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size MPI_IO_DATA%var(i)%sf => null() end do - if (bubbles_lagrange) MPI_IO_DATA%var(sys_size + 1)%sf => null() + if (bubbles_lagrange) MPI_IO_DATA%var(eqn_idx%sys_size + 1)%sf => null() deallocate (MPI_IO_DATA%var) deallocate (MPI_IO_DATA%view) diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 2e693488f1..677961445b 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -66,14 +66,14 @@ contains if (p > 0) then allocate (q_cons_buffer_in(0:buff_size* & - sys_size* & + eqn_idx%sys_size* & (m + 2*buff_size + 1)* & (n + 2*buff_size + 1)* & (p + 2*buff_size + 1)/ & (min(m, n, p) & + 2*buff_size + 1) - 1)) allocate (q_cons_buffer_out(0:buff_size* & - sys_size* & + eqn_idx%sys_size* & (m + 2*buff_size + 1)* & (n + 2*buff_size + 1)* & (p + 2*buff_size + 1)/ & @@ -84,11 +84,11 @@ contains else allocate (q_cons_buffer_in(0:buff_size* & - sys_size* & + eqn_idx%sys_size* & (max(m, n) & + 2*buff_size + 1) - 1)) allocate (q_cons_buffer_out(0:buff_size* & - sys_size* & + eqn_idx%sys_size* & (max(m, n) & + 2*buff_size + 1) - 1)) @@ -97,8 +97,8 @@ contains ! Simulation is 1D else - allocate (q_cons_buffer_in(0:buff_size*sys_size - 1)) - allocate (q_cons_buffer_out(0:buff_size*sys_size - 1)) + allocate (q_cons_buffer_in(0:buff_size*eqn_idx%sys_size - 1)) + allocate (q_cons_buffer_out(0:buff_size*eqn_idx%sys_size - 1)) end if @@ -850,7 +850,7 @@ contains sweep_coord, q_particle) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_cons_vf character(LEN=3), intent(in) :: pbc_loc @@ -877,10 +877,10 @@ contains do l = 0, p do k = 0, n do j = m - buff_size + 1, m - do i = 1, sys_size - r = sys_size*(j - m + buff_size - 1) & - + sys_size*buff_size*k + (i - 1) & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j - m + buff_size - 1) & + + eqn_idx%sys_size*buff_size*k + (i - 1) & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & q_particle%sf(j, k, l) @@ -895,10 +895,10 @@ contains ! Sending/receiving the data to/from bc_x%end/bc_x%beg call MPI_SENDRECV(q_cons_buffer_out(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%end, 0, & q_cons_buffer_in(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -910,10 +910,10 @@ contains do l = 0, p do k = 0, n do j = 0, buff_size - 1 - do i = 1, sys_size - r = (i - 1) + sys_size*j & - + sys_size*buff_size*k & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = (i - 1) + eqn_idx%sys_size*j & + + eqn_idx%sys_size*buff_size*k & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & q_particle%sf(j, k, l) @@ -928,10 +928,10 @@ contains ! Sending/receiving the data to/from bc_x%beg/bc_x%beg call MPI_SENDRECV(q_cons_buffer_out(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%beg, 1, & q_cons_buffer_in(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -942,10 +942,10 @@ contains do l = 0, p do k = 0, n do j = -buff_size, -1 - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*buff_size*k + (i - 1) & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*buff_size*k + (i - 1) & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) else @@ -971,10 +971,10 @@ contains do l = 0, p do k = 0, n do j = 0, buff_size - 1 - do i = 1, sys_size - r = (i - 1) + sys_size*j & - + sys_size*buff_size*k & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = (i - 1) + eqn_idx%sys_size*j & + + eqn_idx%sys_size*buff_size*k & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & q_particle%sf(j, k, l) @@ -988,10 +988,10 @@ contains end do call MPI_SENDRECV(q_cons_buffer_out(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%beg, 1, & q_cons_buffer_in(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1003,10 +1003,10 @@ contains do l = 0, p do k = 0, n do j = m - buff_size + 1, m - do i = 1, sys_size - r = sys_size*(j - m + buff_size - 1) & - + sys_size*buff_size*k + (i - 1) & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j - m + buff_size - 1) & + + eqn_idx%sys_size*buff_size*k + (i - 1) & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & q_particle%sf(j, k, l) @@ -1020,10 +1020,10 @@ contains end do call MPI_SENDRECV(q_cons_buffer_out(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%end, 0, & q_cons_buffer_in(0), & - buff_size*sys_size*(n + 1)*(p + 1), & + buff_size*eqn_idx%sys_size*(n + 1)*(p + 1), & mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1034,10 +1034,10 @@ contains do l = 0, p do k = 0, n do j = m + 1, m + buff_size - do i = 1, sys_size - r = (i - 1) + sys_size*(j - m - 1) & - + sys_size*buff_size*k & - + sys_size*buff_size*(n + 1)*l + do i = 1, eqn_idx%sys_size + r = (i - 1) + eqn_idx%sys_size*(j - m - 1) & + + eqn_idx%sys_size*buff_size*k & + + eqn_idx%sys_size*buff_size*(n + 1)*l if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) else @@ -1071,11 +1071,11 @@ contains do l = 0, p do k = n - buff_size + 1, n do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k - n + buff_size - 1) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & buff_size*l if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1091,10 +1091,10 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (p + 1), mpi_p, & bc_y%end, 0, q_cons_buffer_in(0), & - buff_size*sys_size* & + buff_size*eqn_idx%sys_size* & (m + 2*buff_size + 1)*(p + 1), & mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1107,10 +1107,10 @@ contains do l = 0, p do k = 0, buff_size - 1 do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)*k & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)*k & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & buff_size*l + (i - 1) if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1126,10 +1126,10 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (p + 1), mpi_p, & bc_y%beg, 1, q_cons_buffer_in(0), & - buff_size*sys_size* & + buff_size*eqn_idx%sys_size* & (m + 2*buff_size + 1)*(p + 1), & mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1141,10 +1141,10 @@ contains do l = 0, p do k = -buff_size, -1 do j = -buff_size, m + buff_size - do i = 1, sys_size - r = (i - 1) + sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & - (k + buff_size) + sys_size* & + do i = 1, eqn_idx%sys_size + r = (i - 1) + eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & + (k + buff_size) + eqn_idx%sys_size* & (m + 2*buff_size + 1)*buff_size*l if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) @@ -1171,10 +1171,10 @@ contains do l = 0, p do k = 0, buff_size - 1 do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)*k & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)*k & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & buff_size*l + (i - 1) if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1190,10 +1190,10 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (p + 1), mpi_p, & bc_y%beg, 1, q_cons_buffer_in(0), & - buff_size*sys_size* & + buff_size*eqn_idx%sys_size* & (m + 2*buff_size + 1)*(p + 1), & mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1206,11 +1206,11 @@ contains do l = 0, p do k = n - buff_size + 1, n do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k - n + buff_size - 1) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & buff_size*l if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1226,10 +1226,10 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (p + 1), mpi_p, & bc_y%end, 0, q_cons_buffer_in(0), & - buff_size*sys_size* & + buff_size*eqn_idx%sys_size* & (m + 2*buff_size + 1)*(p + 1), & mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1241,10 +1241,10 @@ contains do l = 0, p do k = n + 1, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = (i - 1) + sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & - (k - n - 1) + sys_size* & + do i = 1, eqn_idx%sys_size + r = (i - 1) + eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & + (k - n - 1) + eqn_idx%sys_size* & (m + 2*buff_size + 1)*buff_size*l if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) @@ -1279,10 +1279,10 @@ contains do l = p - buff_size + 1, p do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & - (k + buff_size) + sys_size* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & + (k + buff_size) + eqn_idx%sys_size* & (m + 2*buff_size + 1)* & (n + 2*buff_size + 1)* & (l - p + buff_size - 1) + (i - 1) @@ -1300,11 +1300,11 @@ contains ! Sending/receiving the data to/from bc_z%end/bc_z%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%end, 0, & q_cons_buffer_in(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1317,11 +1317,11 @@ contains do l = 0, buff_size - 1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k + buff_size) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1337,11 +1337,11 @@ contains ! Sending/receiving the data to/from bc_z%beg/bc_z%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%beg, 1, & q_cons_buffer_in(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1353,11 +1353,11 @@ contains do l = -buff_size, -1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k + buff_size) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1)*(l + buff_size) if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) @@ -1384,11 +1384,11 @@ contains do l = 0, buff_size - 1 do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k + buff_size) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1)*l if (present(q_particle)) then q_cons_buffer_out(r) = & @@ -1404,11 +1404,11 @@ contains ! Sending/receiving the data to/from bc_z%beg/bc_z%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%beg, 1, & q_cons_buffer_in(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1421,10 +1421,10 @@ contains do l = p - buff_size + 1, p do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & - (k + buff_size) + sys_size* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & + (k + buff_size) + eqn_idx%sys_size* & (m + 2*buff_size + 1)* & (n + 2*buff_size + 1)* & (l - p + buff_size - 1) + (i - 1) @@ -1442,11 +1442,11 @@ contains ! Sending/receiving the data to/from bc_z%end/bc_z%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%end, 0, & q_cons_buffer_in(0), buff_size* & - sys_size*(m + 2*buff_size + 1)* & + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & @@ -1458,11 +1458,11 @@ contains do l = p + 1, p + buff_size do k = -buff_size, n + buff_size do j = -buff_size, m + buff_size - do i = 1, sys_size - r = sys_size*(j + buff_size) & - + sys_size*(m + 2*buff_size + 1)* & + do i = 1, eqn_idx%sys_size + r = eqn_idx%sys_size*(j + buff_size) & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (k + buff_size) + (i - 1) & - + sys_size*(m + 2*buff_size + 1)* & + + eqn_idx%sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1)*(l - p - 1) if (present(q_particle)) then q_particle%sf(j, k, l) = q_cons_buffer_in(r) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index e7435f6ad6..3b5844bb0f 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -299,9 +299,9 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) end if ! Adding the momentum to the formatted database file - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (mom_wrt(i) .or. cons_vars_wrt) then - q_sf = q_cons_vf(i + cont_idx%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + q_sf = q_cons_vf(i + eqn_idx%cont%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'mom', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -311,9 +311,9 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) end do ! Adding the velocity to the formatted database file - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (vel_wrt(i) .or. prim_vars_wrt) then - q_sf = q_prim_vf(i + cont_idx%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + q_sf = q_prim_vf(i + eqn_idx%cont%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'vel', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -345,7 +345,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) end if ! Adding the flux limiter function to the formatted database file - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg if (flux_wrt(i)) then call s_derive_flux_limiter(i, q_prim_vf, q_sf) @@ -359,7 +359,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the energy to the formatted database file 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) @@ -369,21 +369,21 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the magnetic field to the formatted database file if (mhd .and. prim_vars_wrt) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end q_sf = q_prim_vf(i)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) ! 1D: output By, Bz if (n == 0) then - if (i == B_idx%beg) then + if (i == eqn_idx%B%beg) then write (varname, '(A)') 'By' else write (varname, '(A)') 'Bz' end if ! 2D/3D: output Bx, By, Bz else - if (i == B_idx%beg) then + if (i == eqn_idx%B%beg) then write (varname, '(A)') 'Bx' - elseif (i == B_idx%beg + 1) then + elseif (i == eqn_idx%B%beg + 1) then write (varname, '(A)') 'By' else write (varname, '(A)') 'Bz' @@ -397,9 +397,9 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the elastic shear stresses to the formatted database file if (elasticity) then - do i = 1, stress_idx%end - stress_idx%beg + 1 + do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 if (prim_vars_wrt) then - q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + q_sf = q_prim_vf(i - 1 + eqn_idx%stress%beg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'tau', i call s_write_variable_to_formatted_database_file(varname, t_step) end if @@ -419,7 +419,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) end if if (cont_damage) then - q_sf = q_cons_vf(damage_idx)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + q_sf = q_cons_vf(eqn_idx%damage)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A)') 'damage_state' call s_write_variable_to_formatted_database_file(varname, t_step) @@ -428,7 +428,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the pressure to the formatted database file 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) @@ -443,7 +443,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) 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) @@ -455,7 +455,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) if (alpha_wrt(num_fluids) & .or. & (cons_vars_wrt .or. prim_vars_wrt)) then - q_sf = q_cons_vf(adv_idx%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + q_sf = q_cons_vf(eqn_idx%adv%end)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'alpha', num_fluids call s_write_variable_to_formatted_database_file(varname, t_step) @@ -518,11 +518,11 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) do k = -offset_z%beg, p + offset_z%end do j = -offset_y%beg, n + offset_y%end do i = -offset_x%beg, m + offset_x%end - do l = 1, adv_idx%end - E_idx - adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + do l = 1, eqn_idx%adv%end - eqn_idx%E + adv(l) = q_prim_vf(eqn_idx%E + l)%sf(i, j, k) end do - pres = q_prim_vf(E_idx)%sf(i, j, k) + pres = q_prim_vf(eqn_idx%E)%sf(i, j, k) H = ((gamma_sf(i, j, k) + 1._wp)*pres + & pi_inf_sf(i, j, k))/rho_sf(i, j, k) @@ -586,7 +586,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the color function to formatted database file 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(:) = ' ' @@ -595,9 +595,9 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the volume fraction(s) to the formatted database file if (bubbles_euler) then - do i = adv_idx%beg, adv_idx%end + do i = eqn_idx%adv%beg, eqn_idx%adv%end q_sf = q_cons_vf(i)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) - write (varname, '(A,I0)') 'alpha', i - E_idx + write (varname, '(A,I0)') 'alpha', i - eqn_idx%E call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' end do @@ -607,7 +607,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) 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(eqn_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(:) = ' ' @@ -615,7 +615,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) !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(eqn_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(:) = ' ' @@ -623,7 +623,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) 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(eqn_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(:) = ' ' @@ -631,7 +631,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) !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(eqn_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(:) = ' ' @@ -640,7 +640,7 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) ! 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/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index e4bf547999..ca97af56e2 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -22,7 +22,7 @@ q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp ! Pressure - 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 @@ -35,15 +35,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/2._wp) + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/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 @@ -56,18 +56,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 @@ -90,14 +90,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 @@ -110,7 +110,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 @@ -125,7 +125,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 @@ -140,22 +140,22 @@ 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(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi) + q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi) case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1] if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then q_prim_vf(contxb)%sf(i, j, 0) = 0.01 - q_prim_vf(E_idx)%sf(i, j, 0) = 1.0 + q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0 elseif (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 default diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index e0018598a7..e69a08d781 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -33,14 +33,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(*)|) @@ -51,7 +51,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 diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 11eb62f9e6..b21aa9a8a4 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -45,12 +45,12 @@ module m_assign_variables subroutine s_assign_patch_xxxxx_primitive_variables(patch_id, j, k, l, & eta, q_prim_vf, patch_id_fp) - import :: scalar_field, sys_size, n, m, p, wp + import :: scalar_field, system_of_equations, n, m, p, wp integer, intent(in) :: patch_id integer, intent(in) :: j, k, l real(wp), intent(in) :: eta - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(:), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp end subroutine s_assign_patch_xxxxx_primitive_variables @@ -108,7 +108,7 @@ contains integer, intent(in) :: patch_id integer, intent(in) :: j, k, l real(wp), intent(in) :: eta - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(:), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp real(wp) :: Ys(1:num_species) @@ -127,7 +127,7 @@ contains + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho ! Velocity - do i = 1, E_idx - mom_idx%beg + do i = 1, eqn_idx%E - eqn_idx%mom%beg q_prim_vf(i + 1)%sf(j, k, l) = & 1._wp/q_prim_vf(1)%sf(j, k, l)* & (eta*patch_icpp(patch_id)%rho & @@ -137,20 +137,20 @@ contains end do ! Specific heat ratio function - q_prim_vf(gamma_idx)%sf(j, k, l) = & + 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 ! Pressure - q_prim_vf(E_idx)%sf(j, k, l) = & - 1._wp/q_prim_vf(gamma_idx)%sf(j, k, l)* & + 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) ! Liquid stiffness function - q_prim_vf(pi_inf_idx)%sf(j, k, l) = & + 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 @@ -193,7 +193,7 @@ contains pure subroutine s_perturb_primitive(j, k, l, q_prim_vf) integer, intent(in) :: j, k, l - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(:), intent(inout) :: q_prim_vf integer :: i real(wp) :: pres_mag, loc, n_tait, B_tait, p0 @@ -209,12 +209,12 @@ contains B_tait = B_tait*(n_tait - 1._wp)/n_tait 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 - fluid_pp(1)%pv)/(q_prim_vf(E_idx)%sf(j, k, l)*p0 - fluid_pp(1)%pv))**(1/3._wp) + 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 - fluid_pp(1)%pv)/(q_prim_vf(eqn_idx%E)%sf(j, k, l)*p0 - fluid_pp(1)%pv))**(1/3._wp) end do end if @@ -235,32 +235,32 @@ 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 (deno == 0._wp) then velH = 0._wp else - velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno + velH = (q_prim_vf(eqn_idx%E)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, l))/deno velH = sqrt(velH) velH = velH*deno end if - do i = cont_idx%beg, cont_idx%end + do i = eqn_idx%cont%beg, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = rhoH end do - do i = mom_idx%beg, mom_idx%end + do i = eqn_idx%mom%beg, eqn_idx%mom%end q_prim_vf(i)%sf(j, k, l) = velH end do - q_prim_vf(alf_idx)%sf(j, k, l) = vfH + q_prim_vf(eqn_idx%alf)%sf(j, k, l) = vfH end subroutine s_perturb_primitive @@ -282,7 +282,7 @@ contains integer, intent(in) :: j, k, l real(wp), intent(in) :: eta integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(:), intent(inout) :: q_prim_vf ! Density, the specific heat ratio function and the liquid stiffness ! function, respectively, obtained from the combination of primitive @@ -303,7 +303,7 @@ contains real(wp) :: Ys(1:num_species) - real(wp), dimension(sys_size) :: orig_prim_vf !< + real(wp), dimension(eqn_idx%sys_size) :: orig_prim_vf !< !! Vector to hold original values of cell for smoothing purposes integer :: i !< Generic loop iterator @@ -313,19 +313,19 @@ contains smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id ! Transferring original primitive variables - do i = 1, sys_size + do i = 1, eqn_idx%sys_size orig_prim_vf(i) = q_prim_vf(i)%sf(j, k, l) end do if (mpp_lim .and. bubbles_euler) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & + 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 @@ -341,26 +341,26 @@ contains ! Computing Mixture Variables of Current Patch ! Volume fraction(s) - do i = adv_idx%beg, adv_idx%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha(i - eqn_idx%E) end do if (mpp_lim .and. bubbles_euler) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & + 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 ! Partial densities if (model_eqns /= 4) then - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = patch_icpp(patch_id)%alpha_rho(i) end do end if @@ -378,25 +378,25 @@ contains if (model_eqns /= 4) then ! Partial densities - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha_rho(i) end do end if ! Volume fraction(s) - do i = adv_idx%beg, adv_idx%end - q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - E_idx) + do i = eqn_idx%adv%beg, eqn_idx%adv%end + q_prim_vf(i)%sf(j, k, l) = patch_icpp(smooth_patch_id)%alpha(i - eqn_idx%E) end do if (mpp_lim .and. bubbles_euler) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & + 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 @@ -409,26 +409,26 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = muR - q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + sigR**2 - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV - q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(eqn_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + sigR**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = 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**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(eqn_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**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(eqn_idx%bub%rs(i))%sf(j, k, l) = muR + q_prim_vf(eqn_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(eqn_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(eqn_idx%bub%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if end do @@ -437,9 +437,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(eqn_idx%bub%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 @@ -453,44 +453,44 @@ contains patch_icpp(smooth_patch_id)%qv) ! Pressure - q_prim_vf(E_idx)%sf(j, k, l) = & + q_prim_vf(eqn_idx%E)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%pres & - + (1._wp - eta)*orig_prim_vf(E_idx)) + + (1._wp - eta)*orig_prim_vf(eqn_idx%E)) ! Volume fractions \alpha - do i = adv_idx%beg, adv_idx%end + 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 - E_idx) & + eta*patch_icpp(patch_id)%alpha(i - eqn_idx%E) & + (1._wp - eta)*orig_prim_vf(i) end do if (mhd) then if (n == 0) then ! 1D: By, Bz - q_prim_vf(B_idx%beg)%sf(j, k, l) = & + q_prim_vf(eqn_idx%B%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) = & + + (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(B_idx%beg + 1) + + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz - q_prim_vf(B_idx%beg)%sf(j, k, l) = & + q_prim_vf(eqn_idx%B%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) = & + + (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(B_idx%beg + 1) - q_prim_vf(B_idx%beg + 2)%sf(j, k, l) = & + + (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(B_idx%beg + 2) + + (1._wp - eta)*orig_prim_vf(eqn_idx%B%beg + 2) end if end if ! Elastic Shear Stress 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) = & + 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 + stress_idx%beg - 1)) + + (1._wp - eta)*orig_prim_vf(i + eqn_idx%stress%beg - 1)) end do end if @@ -522,12 +522,12 @@ contains if (mpp_lim .and. bubbles_euler) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & + 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 @@ -535,7 +535,7 @@ contains ! Partial densities \alpha \rho if (model_eqns /= 4) then !mixture density is an input - do i = 1, cont_idx%end + do i = 1, eqn_idx%cont%end q_prim_vf(i)%sf(j, k, l) = & eta*patch_icpp(patch_id)%alpha_rho(i) & + (1._wp - eta)*orig_prim_vf(i) @@ -548,8 +548,8 @@ contains ! \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(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 ! Density and the specific heat ratio and liquid stiffness functions @@ -558,10 +558,10 @@ contains rho, gamma, pi_inf, qv) ! Velocity - do i = 1, E_idx - mom_idx%beg - q_prim_vf(i + cont_idx%end)%sf(j, k, l) = & + 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 + cont_idx%end)) + + (1._wp - eta)*orig_prim_vf(i + eqn_idx%cont%end)) end do ! Species Concentrations @@ -594,15 +594,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, l) = & + q_prim_vf(1 + eqn_idx%cont%end)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) & - + (1._wp - eta)*orig_prim_vf(1 + cont_idx%end)) + + (1._wp - eta)*orig_prim_vf(1 + eqn_idx%cont%end)) end if ! Set partial pressures to mixture pressure for the 6-eqn model if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end - q_prim_vf(i)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) + do i = eqn_idx%internalEnergies%beg, eqn_idx%internalEnergies%end + q_prim_vf(i)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, l) end do end if @@ -614,33 +614,33 @@ 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**2 - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV - q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = muR + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(eqn_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + sigR**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = 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**2 + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 1))%sf(j, k, l) = muV + q_prim_vf(eqn_idx%bub%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(eqn_idx%bub%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV + q_prim_vf(eqn_idx%bub%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 end if else - ! q_prim_vf(bub_idx%rs(i))%sf(j,k,l) = & + ! q_prim_vf(eqn_idx%bub%rs(i))%sf(j,k,l) = & ! (eta * R0(i)*patch_icpp(patch_id)%r0 & - ! + (1._wp-eta)*orig_prim_vf(bub_idx%rs(i))) - ! q_prim_vf(bub_idx%vs(i))%sf(j,k,l) = & + ! + (1._wp-eta)*orig_prim_vf(eqn_idx%bub%rs(i))) + ! q_prim_vf(eqn_idx%bub%vs(i))%sf(j,k,l) = & ! (eta * V0(i)*patch_icpp(patch_id)%v0 & - ! + (1._wp-eta)*orig_prim_vf(bub_idx%vs(i))) - q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = muR - q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muV + ! + (1._wp-eta)*orig_prim_vf(eqn_idx%bub%vs(i))) + q_prim_vf(eqn_idx%bub%rs(i))%sf(j, k, l) = muR + q_prim_vf(eqn_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(eqn_idx%bub%ps(i))%sf(j, k, l) = patch_icpp(patch_id)%p0 + q_prim_vf(eqn_idx%bub%ms(i))%sf(j, k, l) = patch_icpp(patch_id)%m0 end if end if @@ -650,39 +650,39 @@ 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(eqn_idx%bub%rs(i))%sf(j, k, l))**3._wp end do - q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*R3bar) + q_prim_vf(eqn_idx%n)%sf(j, k, l) = 3*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4*pi*R3bar) end if end if if (mpp_lim .and. bubbles_euler) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0._wp - do i = adv_idx%beg, adv_idx%end - 1 + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do - do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & + do i = eqn_idx%adv%beg, eqn_idx%adv%end - 1 + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(eqn_idx%alf)%sf) & /alf_sum%sf end do end if if (bubbles_euler .and. (.not. polytropic) .and. (.not. qbmm)) then do i = 1, nb - if (f_is_default(q_prim_vf(bub_idx%ps(i))%sf(j, k, l))) then - q_prim_vf(bub_idx%ps(i))%sf(j, k, l) = pb0(i) + if (f_is_default(q_prim_vf(eqn_idx%bub%ps(i))%sf(j, k, l))) then + q_prim_vf(eqn_idx%bub%ps(i))%sf(j, k, l) = pb0(i) ! print *, 'setting to pb0' end if - if (f_is_default(q_prim_vf(bub_idx%ms(i))%sf(j, k, l))) then - q_prim_vf(bub_idx%ms(i))%sf(j, k, l) = mass_v0(i) + if (f_is_default(q_prim_vf(eqn_idx%bub%ms(i))%sf(j, k, l))) then + q_prim_vf(eqn_idx%bub%ms(i))%sf(j, k, l) = mass_v0(i) end if end do end if if (surface_tension) then - q_prim_vf(c_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + & + q_prim_vf(eqn_idx%c)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + & (1._wp - eta)*patch_icpp(smooth_patch_id)%cf_val end if diff --git a/src/pre_process/m_boundary_conditions.fpp b/src/pre_process/m_boundary_conditions.fpp index 4fc2e5ff03..f2474a9172 100644 --- a/src/pre_process/m_boundary_conditions.fpp +++ b/src/pre_process/m_boundary_conditions.fpp @@ -232,7 +232,7 @@ contains impure subroutine s_apply_boundary_patches(q_prim_vf, bc_type) - type(scalar_field), dimension(sys_size) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type integer :: i @@ -266,7 +266,7 @@ contains impure subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath) - type(scalar_field), dimension(sys_size) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type character(LEN=*), intent(in) :: step_dirpath @@ -306,7 +306,7 @@ contains impure subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type) - type(scalar_field), dimension(sys_size) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type integer :: dir, loc @@ -366,12 +366,12 @@ contains impure subroutine s_pack_boundary_condition_buffers(q_prim_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf integer :: i, j, k do k = 0, p do j = 0, n - do i = 1, sys_size + do i = 1, eqn_idx%sys_size bc_buffers(1, -1)%sf(i, j, k) = q_prim_vf(i)%sf(0, j, k) bc_buffers(1, 1)%sf(i, j, k) = q_prim_vf(i)%sf(m, j, k) end do @@ -380,7 +380,7 @@ contains if (n > 0) then do k = 0, p - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do i = 0, m bc_buffers(2, -1)%sf(i, j, k) = q_prim_vf(j)%sf(i, 0, k) bc_buffers(2, 1)%sf(i, j, k) = q_prim_vf(j)%sf(i, n, k) @@ -389,7 +389,7 @@ contains end do if (p > 0) then - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, n do i = 0, m bc_buffers(3, -1)%sf(i, j, k) = q_prim_vf(k)%sf(i, j, 0) diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index 86cc884eb0..2ad90a7610 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -53,12 +53,12 @@ module m_data_output !! @param levelset_norm normalized vector from every cell to the closest point to the IB impure subroutine s_write_abstract_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) - import :: scalar_field, integer_field, sys_size, m, n, p, & + import :: scalar_field, integer_field, eqn_idx, m, n, p, & pres_field, levelset_field, levelset_norm_field, num_dims ! Conservative variables type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf, q_prim_vf type(integer_field), & @@ -98,7 +98,7 @@ contains !! @param levelset_norm normalized vector from every cell to the closest point to the IB impure subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf, q_prim_vf ! BC types @@ -124,7 +124,7 @@ contains character(LEN=3) :: status character(LEN= & - int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< Used to store + int(floor(log10(real(eqn_idx%sys_size, wp)))) + 1) :: file_num !< Used to store !! the number, in character form, of the currently !! manipulated conservative variable data file @@ -227,7 +227,7 @@ contains close (1) ! Outputting Conservative Variables - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_num, '(I0)') i file_loc = trim(t_step_dir)//'/q_cons_vf'//trim(file_num) & //'.dat' @@ -241,7 +241,7 @@ contains if (qbmm .and. .not. polytropic) then do i = 1, nb do r = 1, nnode - write (file_num, '(I0)') r + (i - 1)*nnode + sys_size + write (file_num, '(I0)') r + (i - 1)*nnode + eqn_idx%sys_size file_loc = trim(t_step_dir)//'/pb'//trim(file_num) & //'.dat' open (1, FILE=trim(file_loc), FORM='unformatted', & @@ -253,7 +253,7 @@ contains do i = 1, nb do r = 1, nnode - write (file_num, '(I0)') r + (i - 1)*nnode + sys_size + write (file_num, '(I0)') r + (i - 1)*nnode + eqn_idx%sys_size file_loc = trim(t_step_dir)//'/mv'//trim(file_num) & //'.dat' open (1, FILE=trim(file_loc), FORM='unformatted', & @@ -287,7 +287,7 @@ contains !1D if (n == 0 .and. p == 0) then if (model_eqns == 2) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_loc, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/prim.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_loc)) @@ -305,57 +305,57 @@ 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)) & + else if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) & .or. & - ((i >= adv_idx%beg) .and. (i <= adv_idx%end)) & + ((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 == mom_idx%beg) then !u - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg)%sf(j, 0, 0)/rho - else if (i == stress_idx%beg) then !tau_e - write (2, FMT) x_cb(j), q_cons_vf(stress_idx%beg)%sf(j, 0, 0)/rho - else if (i == E_idx) then !p + else if (i == eqn_idx%mom%beg) then !u + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%stress%beg) then !tau_e + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%stress%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%E) then !p if (mhd) then - pres_mag = 0.5_wp*(Bx0**2 + q_cons_vf(B_idx%beg)%sf(j, 0, 0)**2 + q_cons_vf(B_idx%beg + 1)%sf(j, 0, 0)**2) + pres_mag = 0.5_wp*(Bx0**2 + q_cons_vf(eqn_idx%B%beg)%sf(j, 0, 0)**2 + q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)**2) end if call s_compute_pressure( & - q_cons_vf(E_idx)%sf(j, 0, 0), & - q_cons_vf(alf_idx)%sf(j, 0, 0), & - 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, 0, 0)**2._wp)/rho, & + q_cons_vf(eqn_idx%E)%sf(j, 0, 0), & + q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), & + 0.5_wp*(q_cons_vf(eqn_idx%mom%beg)%sf(j, 0, 0)**2._wp)/rho, & pi_inf, gamma, rho, qv, rhoYks, pres, T, pres_mag=pres_mag) write (2, FMT) x_cb(j), pres else if (mhd) then - if (i == mom_idx%beg + 1) then ! v - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg + 1)%sf(j, 0, 0)/rho - else if (i == mom_idx%beg + 2) then ! w - write (2, FMT) x_cb(j), q_cons_vf(mom_idx%beg + 2)%sf(j, 0, 0)/rho - else if (i == B_idx%beg) then ! By - write (2, FMT) x_cb(j), q_cons_vf(B_idx%beg)%sf(j, 0, 0)/rho - else if (i == B_idx%beg + 1) then ! Bz - write (2, FMT) x_cb(j), q_cons_vf(B_idx%beg + 1)%sf(j, 0, 0)/rho + if (i == eqn_idx%mom%beg + 1) then ! v + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 1)%sf(j, 0, 0)/rho + else if (i == eqn_idx%mom%beg + 2) then ! w + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%mom%beg + 2)%sf(j, 0, 0)/rho + else if (i == eqn_idx%B%beg) then ! By + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg)%sf(j, 0, 0)/rho + else if (i == eqn_idx%B%beg + 1) then ! Bz + write (2, FMT) x_cb(j), q_cons_vf(eqn_idx%B%beg + 1)%sf(j, 0, 0)/rho end if - else if ((i >= bub_idx%beg) .and. (i <= bub_idx%end) .and. bubbles_euler) then + else if ((i >= eqn_idx%bub%beg) .and. (i <= eqn_idx%bub%end) .and. bubbles_euler) then if (qbmm) then nbub = q_cons_vf(bubxb)%sf(j, 0, 0) else if (adv_n) then - nbub = q_cons_vf(n_idx)%sf(j, 0, 0) + nbub = q_cons_vf(eqn_idx%n)%sf(j, 0, 0) else do k = 1, nb - nRtmp(k) = q_cons_vf(bub_idx%rs(k))%sf(j, 0, 0) + nRtmp(k) = q_cons_vf(eqn_idx%bub%rs(k))%sf(j, 0, 0) end do - call s_comp_n_from_cons(q_cons_vf(alf_idx)%sf(j, 0, 0), nRtmp, nbub, weight) + call s_comp_n_from_cons(q_cons_vf(eqn_idx%alf)%sf(j, 0, 0), nRtmp, nbub, weight) end if end if write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/nbub - else if (i == n_idx .and. adv_n .and. bubbles_euler) then + else if (i == eqn_idx%n .and. adv_n .and. bubbles_euler) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) - else if (i == damage_idx) then + else if (i == eqn_idx%damage) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) end if end do @@ -363,7 +363,7 @@ contains end do end if - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_loc, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_loc)) @@ -407,7 +407,7 @@ contains ! 2D if ((n > 0) .and. (p == 0)) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_loc, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_loc)) do j = 0, m @@ -456,7 +456,7 @@ contains ! 3D if (p > 0) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_loc, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_loc)) do j = 0, m @@ -557,7 +557,7 @@ contains ! Conservative variables type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf, q_prim_vf type(integer_field), & @@ -637,11 +637,11 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Write the data for each variable if (bubbles_euler) then - do i = 1, sys_size! adv_idx%end + do i = 1, eqn_idx%sys_size! eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -649,7 +649,7 @@ contains end do !Additional variables pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -657,8 +657,8 @@ contains end do end if else - do i = 1, sys_size !TODO: check if this is right - ! do i = 1, adv_idx%end + do i = 1, eqn_idx%sys_size !TODO: check if this is right + ! do i = 1, eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -701,11 +701,11 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Write the data for each variable if (bubbles_euler) then - do i = 1, sys_size! adv_idx%end + do i = 1, eqn_idx%sys_size! eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -718,7 +718,7 @@ contains end do !Additional variables pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -731,8 +731,8 @@ contains end do end if else - do i = 1, sys_size !TODO: check if this is right - ! do i = 1, adv_idx%end + do i = 1, eqn_idx%sys_size !TODO: check if this is right + ! do i = 1, eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -935,7 +935,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 @@ -950,7 +950,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 bb49f35d0d..93f4c71472 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 real(wp) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model integer :: num_fluids !< Number of different fluids present in the flow logical :: mpp_lim !< Alpha limiter - integer :: sys_size !< Number of unknowns in the system of equations + ! integer :: sys_size !< Number of unknowns in the system of equations integer :: weno_polyn !< Degree of the WENO polynomials (polyn) integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: hypoelasticity !< activate hypoelasticity @@ -90,29 +90,30 @@ module m_global_parameters logical :: elasticity !< elasticity modeling, true for hyper or hypo logical :: mhd !< Magnetohydrodynamics logical :: relativity !< Relativity for RMHD - integer :: b_size !< Number of components in the b tensor - integer :: tensor_size !< Number of components in the nonsymmetric tensor + ! integer :: eqn_idx%b_size !< Number of components in the b tensor + ! integer :: eqn_idx%tensor_size !< Number of components in the nonsymmetric tensor logical :: pre_stress !< activate pre_stressed domain logical :: cont_damage !< continuum damage modeling logical, parameter :: chemistry = .${chemistry}$. !< Chemistry modeling ! Annotations of the structure, i.e. the organization, of the state vectors - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of total energy equation - integer :: alf_idx !< Index of void fraction - integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: B_idx !< Indexes of first and last magnetic field eqns. - type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. - type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of the color function - type(int_bounds_info) :: species_idx !< Indexes of first & last concentration eqns. - integer :: damage_idx !< Index of damage state variable (D) for continuum damage model + ! type(int_bounds_info) :: eqn_idx%cont !< Indexes of first & last continuity eqns. + ! type(int_bounds_info) :: eqn_idx%mom !< Indexes of first & last momentum eqns. + ! integer :: eqn_idx%E !< Index of total energy equation + ! integer :: eqn_idx%alf !< Index of void fraction + ! integer :: eqn_idx%n !< Index of number density + ! type(int_bounds_info) :: eqn_idx%adv !< Indexes of first & last advection eqns. + ! type(int_bounds_info) :: eqn_idx%internalEnergies !< Indexes of first & last internal energy eqns. + ! type(bub_bounds_info) :: eqn_idx%bub !< Indexes of first & last bubble variable eqns. + ! integer :: eqn_idx%gamma !< Index of specific heat ratio func. eqn. + ! integer :: eqn_idx%pi_inf !< Index of liquid stiffness func. eqn. + ! type(int_bounds_info) :: eqn_idx%B !< Indexes of first and last magnetic field eqns. + ! type(int_bounds_info) :: eqn_idx%stress !< Indexes of elastic shear stress eqns. + ! type(int_bounds_info) :: eqn_idx%xi !< Indexes of first and last reference map eqns. + ! integer :: eqn_idx%c !< Index of the color function + ! type(int_bounds_info) :: eqn_idx%species !< Indexes of first & last concentration eqns. + ! integer :: eqn_idx%damage !< Index of damage state variable (D) for continuum damage model + type(system_of_equations) :: eqn_idx ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). ! Stands for "InDices With BUFFer". @@ -342,8 +343,8 @@ contains hyperelasticity = .false. elasticity = .false. pre_stress = .false. - b_size = dflt_int - tensor_size = dflt_int + eqn_idx%b_size = dflt_int + eqn_idx%tensor_size = dflt_int cont_damage = .false. mhd = .false. @@ -566,16 +567,16 @@ contains ! Annotating structure of the state and flux vectors belonging ! to the system of equations defined by the selected number of ! spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + eqn_idx%sys_size = eqn_idx%adv%end ! Volume Fraction Model (5-equation model) else if (model_eqns == 2) then @@ -583,62 +584,62 @@ 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 volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + 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 - sys_size = adv_idx%end + eqn_idx%sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = eqn_idx%sys_size + 1 if (qbmm) then if (nnode == 4) then nmom = 6 !! Already set as a parameter end if - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = eqn_idx%sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = eqn_idx%sys_size + 2*nb end if end if - sys_size = bub_idx%end + eqn_idx%sys_size = eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = eqn_idx%bub%end + 1 + eqn_idx%sys_size = eqn_idx%n end if allocate (weight(nb), R0(nb), V0(nb)) - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + allocate (eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) if (qbmm) then - allocate (bub_idx%moms(nb, nmom)) - allocate (bub_idx%fullmom(nb, 0:nmom, 0:nmom)) + allocate (eqn_idx%bub%moms(nb, nmom)) + allocate (eqn_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 + eqn_idx%bub%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%fullmom(i, 0, 0) = bub_idx%moms(i, 1) - bub_idx%fullmom(i, 1, 0) = bub_idx%moms(i, 2) - bub_idx%fullmom(i, 0, 1) = bub_idx%moms(i, 3) - bub_idx%fullmom(i, 2, 0) = bub_idx%moms(i, 4) - bub_idx%fullmom(i, 1, 1) = bub_idx%moms(i, 5) - bub_idx%fullmom(i, 0, 2) = bub_idx%moms(i, 6) - bub_idx%rs(i) = bub_idx%fullmom(i, 1, 0) + eqn_idx%bub%fullmom(i, 0, 0) = eqn_idx%bub%moms(i, 1) + eqn_idx%bub%fullmom(i, 1, 0) = eqn_idx%bub%moms(i, 2) + eqn_idx%bub%fullmom(i, 0, 1) = eqn_idx%bub%moms(i, 3) + eqn_idx%bub%fullmom(i, 2, 0) = eqn_idx%bub%moms(i, 4) + eqn_idx%bub%fullmom(i, 1, 1) = eqn_idx%bub%moms(i, 5) + eqn_idx%bub%fullmom(i, 0, 2) = eqn_idx%bub%moms(i, 6) + eqn_idx%bub%rs(i) = eqn_idx%bub%fullmom(i, 1, 0) end do else do i = 1, nb @@ -648,12 +649,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do end if @@ -692,13 +693,13 @@ contains end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = eqn_idx%sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = eqn_idx%sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = eqn_idx%sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + eqn_idx%sys_size = eqn_idx%B%end end if ! Volume Fraction Model (6-equation model) @@ -707,39 +708,39 @@ 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 volume fraction model - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%internalEnergies%beg = eqn_idx%adv%end + 1 + eqn_idx%internalEnergies%end = eqn_idx%adv%end + num_fluids + eqn_idx%sys_size = eqn_idx%internalEnergies%end else if (model_eqns == 4) then ! 4 equation model with subgrid bubbles_euler - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 ! num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each direction - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg !one volume advection equation - alf_idx = adv_idx%end - sys_size = alf_idx !adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 ! num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each direction + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg !one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + eqn_idx%sys_size = eqn_idx%alf !eqn_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = eqn_idx%sys_size + 1 + eqn_idx%bub%end = eqn_idx%sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = eqn_idx%sys_size + 4*nb end if - sys_size = bub_idx%end + eqn_idx%sys_size = eqn_idx%bub%end - allocate (bub_idx%rs(nb), bub_idx%vs(nb)) - allocate (bub_idx%ps(nb), bub_idx%ms(nb)) + allocate (eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + allocate (eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) allocate (weight(nb), R0(nb), V0(nb)) do i = 1, nb @@ -749,12 +750,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do @@ -780,24 +781,24 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = eqn_idx%sys_size + 1 + eqn_idx%stress%end = eqn_idx%sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + eqn_idx%sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2, 1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1, 1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2, 1:2) = shear_indices((/1, 3/)) @@ -810,48 +811,48 @@ contains if (hyperelasticity) then ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%b_size = (num_dims*(num_dims + 1))/2 + 1 + eqn_idx%tensor_size = num_dims**2 + 1 + eqn_idx%xi%beg = eqn_idx%sys_size + 1 + eqn_idx%xi%end = eqn_idx%sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + eqn_idx%sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = eqn_idx%sys_size + 1 + eqn_idx%sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = eqn_idx%sys_size + 1 + eqn_idx%sys_size = eqn_idx%damage end if end if if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = eqn_idx%sys_size + 1 + eqn_idx%species%end = eqn_idx%sys_size + num_species + eqn_idx%sys_size = eqn_idx%species%end end if - momxb = mom_idx%beg - momxe = mom_idx%end - advxb = adv_idx%beg - advxe = adv_idx%end - contxb = cont_idx%beg - contxe = cont_idx%end - bubxb = bub_idx%beg - bubxe = bub_idx%end - strxb = stress_idx%beg - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end - xibeg = xi_idx%beg - xiend = xi_idx%end - chemxb = species_idx%beg - chemxe = species_idx%end + 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%internalEnergies%beg + intxe = eqn_idx%internalEnergies%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(weno_polyn, buff_size, & idwint, idwbuff, viscous, & @@ -861,19 +862,19 @@ contains #ifdef MFC_MPI if (qbmm .and. .not. polytropic) then - allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*4)) - allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*4)) + allocate (MPI_IO_DATA%view(1:eqn_idx%sys_size + 2*nb*4)) + allocate (MPI_IO_DATA%var(1:eqn_idx%sys_size + 2*nb*4)) else - allocate (MPI_IO_DATA%view(1:sys_size)) - allocate (MPI_IO_DATA%var(1:sys_size)) + allocate (MPI_IO_DATA%view(1:eqn_idx%sys_size)) + allocate (MPI_IO_DATA%var(1:eqn_idx%sys_size)) end if - do i = 1, sys_size + do i = 1, eqn_idx%sys_size allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p)) MPI_IO_DATA%var(i)%sf => null() end do if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*4 allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p)) MPI_IO_DATA%var(i)%sf => null() end do @@ -961,7 +962,7 @@ contains if (parallel_io) then deallocate (start_idx) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size MPI_IO_DATA%var(i)%sf => null() end do diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 8b7e001ac7..b7a66f5505 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -73,10 +73,10 @@ contains integer :: i, j, k, l !< generic loop iterators ! Allocating the primitive and conservative variables - allocate (q_prim_vf(1:sys_size)) - allocate (q_cons_vf(1:sys_size)) + allocate (q_prim_vf(1:eqn_idx%sys_size)) + allocate (q_cons_vf(1:eqn_idx%sys_size)) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size allocate (q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -110,7 +110,7 @@ contains ! the grid the simulation component will catch the problem on start- ! up. The conservative variables do not need to be similarly treated ! since they are computed directly from the primitive variables. - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_cons_vf(i)%sf = dflt_real q_prim_vf(i)%sf = dflt_real end do @@ -154,8 +154,8 @@ contains ! Initial damage state is always zero if (cont_damage) then - q_cons_vf(damage_idx)%sf = 0._wp - q_prim_vf(damage_idx)%sf = 0._wp + q_cons_vf(eqn_idx%damage)%sf = 0._wp + q_prim_vf(eqn_idx%damage)%sf = 0._wp end if ! Setting default values for patch identities bookkeeping variable. @@ -211,7 +211,7 @@ contains integer :: i !< Generic loop iterator ! Dellocating the primitive and conservative variables - do i = 1, sys_size + do i = 1, eqn_idx%sys_size deallocate (q_prim_vf(i)%sf) deallocate (q_cons_vf(i)%sf) end do diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index ec9b2baf05..90a89cc804 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -66,7 +66,7 @@ contains impure subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp, ib_markers_sf type(levelset_field), intent(inout) :: levelset !< Levelset determined by models type(levelset_norm_field), intent(inout) :: levelset_norm !< Levelset_norm determined by models @@ -251,7 +251,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp) :: pi_inf, gamma, lit_gamma @@ -309,7 +309,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators real(wp) :: th, thickness, nturns, mya @@ -375,7 +375,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib real(wp) :: radius @@ -452,7 +452,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib real(wp) :: x0, y0, f, x_act, y_act, ca, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c @@ -614,7 +614,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c @@ -787,7 +787,7 @@ contains ! Patch identifier integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i, j, k @@ -828,7 +828,7 @@ contains ! Updating the patch identities bookkeeping variable if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id - q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & + 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 @@ -845,7 +845,7 @@ contains ! Patch identifier integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i, j, k @@ -891,7 +891,7 @@ contains ! Updating the patch identities bookkeeping variable if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id - q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & + 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 @@ -912,7 +912,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop operators real(wp) :: a, b @@ -979,7 +979,7 @@ contains ! Patch identifier integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i, j, k @@ -1064,7 +1064,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib !< True if this patch is an immersed boundary integer :: i, j, k !< generic loop iterators @@ -1125,8 +1125,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)%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 ! Updating the patch identities bookkeeping variable @@ -1154,7 +1154,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop operators real(wp) :: a, b, c @@ -1219,7 +1219,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters @@ -1273,9 +1273,9 @@ contains if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id ! Assign Parameters - q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) - q_prim_vf(mom_idx%end)%sf(i, j, 0) = -U0*cos(x_cc(i)/L0)*sin(y_cc(j)/L0) - q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/L0 + & + 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 @@ -1294,7 +1294,7 @@ contains ! Patch identifier integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i @@ -1354,7 +1354,7 @@ contains ! Patch identifier integer, intent(in) :: patch_id integer, intent(inout), dimension(0:m, 0:n, 0:p) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Generic loop iterators integer :: i, j, k @@ -1408,7 +1408,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j !< generic loop iterators @@ -1477,7 +1477,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters @@ -1561,7 +1561,7 @@ contains integer, intent(IN) :: patch_id integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp) :: r, x_p, eps, phi real(wp), dimension(2:9) :: as, Ps @@ -1711,7 +1711,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib !< True if this patch is an immersed boundary ! Generic loop iterators @@ -1807,7 +1807,7 @@ contains integer, intent(in) :: patch_id logical, optional, intent(in) :: ib integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators @@ -1904,7 +1904,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib !< True if this patch is an immersed boundary integer :: i, j, k !< Generic loop iterators @@ -2054,7 +2054,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators real(wp) :: a, b, c, d @@ -2133,7 +2133,7 @@ contains integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_prim_vf ! Variables for IBM+STL type(levelset_field), optional, intent(inout) :: STL_levelset !< Levelset determined by models diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index f4909e89ee..65d67fd65a 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -32,7 +32,7 @@ contains impure subroutine s_initialize_perturbation_module() - bcxb = bc_x%beg; bcxe = bc_x%end; bcyb = bc_y%beg; bcye = bc_y%end; bczb = bc_z%beg; bcze = bc_z%end + bc_bound%xb = bc_x%beg; bc_bound%xe = bc_x%end; bc_bound%yb = bc_y%beg; bc_bound%ye = bc_y%end; bc_bound%zb = bc_z%beg; bc_bound%ze = bc_z%end if (mixlayer_perturb) then mixlayer_bc_fd = 2 @@ -51,13 +51,13 @@ contains end if if (elliptic_smoothing) then - allocate (q_prim_temp(0:m, 0:n, 0:p, 1:sys_size)) + allocate (q_prim_temp(0:m, 0:n, 0:p, 1:eqn_idx%sys_size)) end if end subroutine s_initialize_perturbation_module impure subroutine s_perturb_sphere(q_prim_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k, l !< generic loop operators real(wp) :: perturb_alpha @@ -70,7 +70,7 @@ 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 ! IF ((perturb_alpha >= 25e-2_wp) .AND. (perturb_alpha <= 75e-2_wp)) THEN @@ -78,7 +78,7 @@ contains ! Derive new partial densities 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 @@ -89,7 +89,7 @@ contains end subroutine s_perturb_sphere impure subroutine s_perturb_surrounding_flow(q_prim_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators real(wp) :: perturb_alpha @@ -100,13 +100,13 @@ contains do k = 0, p do j = 0, n do i = 0, m - perturb_alpha = q_prim_vf(E_idx + perturb_flow_fluid)%sf(i, j, k) + perturb_alpha = q_prim_vf(eqn_idx%E + perturb_flow_fluid)%sf(i, j, k) call random_number(rand_real) rand_real = rand_real*perturb_flow_mag - 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(mom_idx%end)%sf(i, j, k) = rand_real*q_prim_vf(mom_idx%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) + q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = rand_real*q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) if (bubbles_euler) then - q_prim_vf(alf_idx)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(alf_idx)%sf(i, j, k) + q_prim_vf(eqn_idx%alf)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(eqn_idx%alf)%sf(i, j, k) end if end do end do @@ -121,7 +121,7 @@ contains !! and (1,0) are superposed. For a 3D waves, (4,4), (4,-4), !! (2,2), (2,-2), (1,1), (1,-1) areadded on top of 2D waves. impure subroutine s_superposition_instability_wave(q_prim_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p) :: wave, wave1, wave2, wave_tmp real(wp) :: uratio, Ldomain integer :: i, j, k, q @@ -169,11 +169,11 @@ contains if (p > 0) then q_prim_vf(momxb + 2)%sf(i, j, k) = q_prim_vf(momxb + 2)%sf(i, j, k) + wave(mixlayer_var(4), i, j, k)/uratio ! w end if - q_prim_vf(E_idx)%sf(i, j, k) = q_prim_vf(E_idx)%sf(i, j, k) + wave(mixlayer_var(5), i, j, k)/uratio**2 ! p + q_prim_vf(eqn_idx%E)%sf(i, j, k) = q_prim_vf(eqn_idx%E)%sf(i, j, k) + wave(mixlayer_var(5), i, j, k)/uratio**2 ! p if (bubbles_euler .and. (.not. qbmm)) then do q = 1, nb - call s_compute_equilibrium_state(q_prim_vf(E_idx)%sf(i, j, k), R0(q), q_prim_vf(bub_idx%rs(q))%sf(i, j, k)) + call s_compute_equilibrium_state(q_prim_vf(eqn_idx%E)%sf(i, j, k), R0(q), q_prim_vf(eqn_idx%bub%rs(q))%sf(i, j, k)) end do end if end do @@ -617,19 +617,19 @@ contains impure subroutine s_elliptic_smoothing(q_prim_vf, bc_type) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type integer :: i, j, k, l, q do q = 1, elliptic_smoothing_iters ! Communication of buffer regions and apply boundary conditions - call s_populate_variables_buffers(q_prim_vf, pb%sf, mv%sf, bc_type) + call s_populate_variables_buffers(q_prim_vf, pb%sf, mv%sf, bc_type, bc_bound) ! Perform smoothing and store in temp array if (n == 0) then do j = 0, m - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_temp(j, 0, 0, i) = (1._wp/4._wp)* & (q_prim_vf(i)%sf(j + 1, 0, 0) + q_prim_vf(i)%sf(j - 1, 0, 0) + & 2._wp*q_prim_vf(i)%sf(j, 0, 0)) @@ -638,7 +638,7 @@ contains else if (p == 0) then do k = 0, n do j = 0, m - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_temp(j, k, 0, i) = (1._wp/8._wp)* & (q_prim_vf(i)%sf(j + 1, k, 0) + q_prim_vf(i)%sf(j - 1, k, 0) + & q_prim_vf(i)%sf(j, k + 1, 0) + q_prim_vf(i)%sf(j, k - 1, 0) + & @@ -650,7 +650,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_temp(j, k, l, i) = (1._wp/12._wp)* & (q_prim_vf(i)%sf(j + 1, k, l) + q_prim_vf(i)%sf(j - 1, k, l) + & q_prim_vf(i)%sf(j, k + 1, l) + q_prim_vf(i)%sf(j, k - 1, l) + & @@ -666,7 +666,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_vf(i)%sf(j, k, l) = q_prim_temp(j, k, l, i) end do end do diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index e33491576f..6146ff14cf 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -84,10 +84,10 @@ module m_start_up !! @param ib_markers track if a cell is within the immersed boundary impure subroutine s_read_abstract_ic_data_files(q_cons_vf, ib_markers) - import :: scalar_field, integer_field, sys_size, pres_field + import :: scalar_field, integer_field, eqn_idx, pres_field type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_cons_vf type(integer_field), & @@ -409,7 +409,7 @@ contains impure subroutine s_read_serial_ic_data_files(q_cons_vf, ib_markers) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_cons_vf type(integer_field), & @@ -419,7 +419,7 @@ contains ! Generic string used to store the address of a particular file character(LEN= & - int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< + int(floor(log10(real(eqn_idx%sys_size, wp)))) + 1) :: file_num !< !! Used to store the variable position, in character form, of the !! currently manipulated conservative variable file @@ -430,7 +430,7 @@ contains integer :: i, r !< Generic loop iterator ! Reading the Conservative Variables Data Files - do i = 1, sys_size + do i = 1, eqn_idx%sys_size ! Checking whether data file associated with variable position ! of the currently manipulated conservative variable exists @@ -459,7 +459,7 @@ contains do r = 1, nnode ! Checking whether data file associated with variable position ! of the currently manipulated bubble variable exists - write (file_num, '(I0)') sys_size + r + (i - 1)*nnode + write (file_num, '(I0)') eqn_idx%sys_size + r + (i - 1)*nnode file_loc = trim(t_step_dir)//'/pb'// & trim(file_num)//'.dat' inquire (FILE=trim(file_loc), EXIST=file_check) @@ -483,7 +483,7 @@ contains do r = 1, 4 ! Checking whether data file associated with variable position ! of the currently manipulated bubble variable exists - write (file_num, '(I0)') sys_size + r + (i - 1)*4 + write (file_num, '(I0)') eqn_idx%sys_size + r + (i - 1)*4 file_loc = trim(t_step_dir)//'/mv'// & trim(file_num)//'.dat' inquire (FILE=trim(file_loc), EXIST=file_check) @@ -645,7 +645,7 @@ contains impure subroutine s_read_parallel_ic_data_files(q_cons_vf, ib_markers) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_cons_vf type(integer_field), & @@ -695,10 +695,10 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -711,7 +711,7 @@ contains end do if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*4 + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*4 var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp index 9ad956a2c8..d8a4eb293b 100644 --- a/src/simulation/include/inline_riemann.fpp +++ b/src/simulation/include/inline_riemann.fpp @@ -93,14 +93,14 @@ if (low_Mach == 1) then pcorr = rho_L*rho_R* & - (s_L - vel_L(dir_idx(1)))*(s_R - vel_R(dir_idx(1)))*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))/ & - (rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* & + (s_L - vel_L(eqn_idx%dir(1)))*(s_R - vel_R(eqn_idx%dir(1)))*(vel_R(eqn_idx%dir(1)) - vel_L(eqn_idx%dir(1)))/ & + (rho_R*(s_R - vel_R(eqn_idx%dir(1))) - rho_L*(s_L - vel_L(eqn_idx%dir(1))))* & (zcoef - 1._wp) else if (low_Mach == 2) then - vel_L_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) - vel_R_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) - vel_L(dir_idx(1)) = vel_L_tmp - vel_R(dir_idx(1)) = vel_R_tmp + vel_L_tmp = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + zcoef*(vel_L(eqn_idx%dir(1)) - vel_R(eqn_idx%dir(1)))) + vel_R_tmp = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + zcoef*(vel_R(eqn_idx%dir(1)) - vel_L(eqn_idx%dir(1)))) + vel_L(eqn_idx%dir(1)) = vel_L_tmp + vel_R(eqn_idx%dir(1)) = vel_R_tmp end if end if diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 0205e4043b..28639a26b7 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -123,17 +123,17 @@ contains !! @param rhs_vf rhs variables impure subroutine s_acoustic_src_calculations(q_cons_vf, q_prim_vf, t_step, rhs_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf !< + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf !< !! This variable contains the WENO-reconstructed values of the cell-average !! conservative variables, which are located in q_cons_vf, at cell-interior !! Gaussian quadrature points (QP). - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf !< + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf !< !! The primitive variables at cell-interior Gaussian quadrature points. These !! are calculated from the conservative variables and gradient magnitude (GM) !! of the volume fractions, q_cons_qp and gm_alpha_qp, respectively. - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf integer, intent(in) :: t_step @@ -254,7 +254,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) @@ -324,7 +324,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 1ef74cbcee..907910a6f0 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -76,7 +76,7 @@ contains !! param q_cons_vf Conservative variable subroutine s_compute_mixture_density(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf integer :: i, j, k, l !< standard iterators !$acc parallel loop collapse(3) gang vector default(present) @@ -100,9 +100,9 @@ contains !! @param q_prim_vf Primitive variables subroutine s_compute_body_forces_rhs(q_cons_vf, q_prim_vf, rhs_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf integer :: i, j, k, l !< Loop variables @@ -110,7 +110,7 @@ contains call s_compute_mixture_density(q_cons_vf) !$acc parallel loop collapse(4) gang vector default(present) - do i = momxb, E_idx + do i = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -128,7 +128,7 @@ contains 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) + & + 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 @@ -143,7 +143,7 @@ contains 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) + & + 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 @@ -158,7 +158,7 @@ contains 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) + & + 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 diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp index 47558229ea..60146b39ab 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -43,11 +43,11 @@ contains end if do l = 1, nb - rs(l) = bub_idx%rs(l) - vs(l) = bub_idx%vs(l) + rs(l) = eqn_idx%bub%rs(l) + vs(l) = eqn_idx%bub%vs(l) if (.not. polytropic) then - ps(l) = bub_idx%ps(l) - ms(l) = bub_idx%ms(l) + ps(l) = eqn_idx%bub%ps(l) + ms(l) = eqn_idx%bub%ms(l) end if end do @@ -72,7 +72,7 @@ contains ! Compute the bubble volume fraction alpha from the bubble number density n !! @param q_cons_vf is the conservative variable pure subroutine s_comp_alpha_from_n(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp) :: nR3bar integer(wp) :: i, j, k, l @@ -85,7 +85,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 @@ -95,7 +95,7 @@ contains pure subroutine s_compute_bubbles_EE_rhs(idir, q_prim_vf, divu) integer, intent(in) :: idir - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(scalar_field), intent(inout) :: divu !< matrix for div(u) integer :: j, k, l @@ -154,9 +154,9 @@ contains !! @param q_prim_vf Primitive variables !! @param q_cons_vf Conservative variables impure subroutine s_compute_bubble_EE_source(q_cons_vf, q_prim_vf, rhs_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf real(wp) :: rddot real(wp) :: pb, mv, vflux, pbdot @@ -197,7 +197,7 @@ contains 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 !$acc loop seq do q = 1, nb @@ -212,7 +212,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 @@ -263,8 +263,8 @@ contains B_tait = B_tait*(n_tait - 1)/n_tait ! make this the usual pi_inf myRho = q_prim_vf(1)%sf(j, k, l) - 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) @@ -327,7 +327,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) !$acc loop seq diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index 008840caa1..efbfea1647 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -75,7 +75,7 @@ contains !! @param q_cons_vf Initial conservative variables impure subroutine s_initialize_bubbles_EL_module(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer :: nBubs_glb, i @@ -190,7 +190,7 @@ contains !! @param q_cons_vf Conservative variables impure subroutine s_read_input_bubbles(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(wp), dimension(8) :: inputBubble real(wp) :: qtime @@ -280,7 +280,7 @@ contains !! @param bub_id Local id of the bubble impure subroutine s_add_bubbles(inputBubble, q_cons_vf, bub_id) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf real(wp), dimension(8), intent(in) :: inputBubble integer, intent(in) :: bub_id integer :: i @@ -342,9 +342,9 @@ 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 + 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(E_idx)%sf(cell(1), cell(2), cell(3)), pi_inf, gamma, pliq, cell, dynP + q_cons_vf(eqn_idx%E)%sf(cell(1), cell(2), cell(3)), pi_inf, gamma, pliq, cell, dynP ! Initial particle pressure gas_p(bub_id, 1) = pliq + 2._wp*(1._wp/Web)/bub_R0(bub_id) @@ -499,7 +499,7 @@ contains !! @param stage Current stage in the time-stepper algorithm subroutine s_compute_bubble_EL_dynamics(q_prim_vf, stage) - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf integer, intent(in) :: stage real(wp) :: myVapFlux @@ -570,7 +570,7 @@ contains !$acc loop seq do i = 1, num_fluids myalpha_rho(i) = q_prim_vf(i)%sf(cell(1), cell(2), cell(3)) - myalpha(i) = q_prim_vf(E_idx + i)%sf(cell(1), cell(2), cell(3)) + myalpha(i) = q_prim_vf(eqn_idx%E + i)%sf(cell(1), cell(2), cell(3)) end do call s_convert_species_to_mixture_variables_acc(myRho, gamma, pi_inf, qv, myalpha, & myalpha_rho, Re) @@ -631,9 +631,9 @@ contains !! @param rhs_vf Time derivative of the conservative variables subroutine s_compute_bubbles_EL_source(q_cons_vf, q_prim_vf, rhs_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf integer :: i, j, k, l @@ -646,7 +646,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%vf(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%vf(2)%sf(i, j, k) + & @@ -662,7 +662,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%vf(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%vf(1)%sf(i, j, k)* & @@ -676,7 +676,7 @@ contains do l = 1, num_dims - call s_gradient_dir(q_prim_vf(E_idx), q_beta%vf(3), l) + call s_gradient_dir(q_prim_vf(eqn_idx%E), q_beta%vf(3), l) !$acc parallel loop collapse(3) gang vector default(present) do k = 0, p @@ -697,7 +697,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%vf(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%vf(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 @@ -709,7 +709,7 @@ contains do j = 0, n do i = 0, m if (q_beta%vf(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) - & + rhs_vf(eqn_idx%E)%sf(i, j, k) = rhs_vf(eqn_idx%E)%sf(i, j, k) - & q_beta%vf(4)%sf(i, j, k)*(1._wp - q_beta%vf(1)%sf(i, j, k))/ & q_beta%vf(1)%sf(i, j, k) end if @@ -737,7 +737,7 @@ contains #else !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf real(wp), intent(in) :: pinf, rhol, gamma, pi_inf integer, dimension(3), intent(in) :: cell real(wp), intent(out) :: cson @@ -808,7 +808,7 @@ contains !$acc routine seq #endif integer, intent(in) :: bub_id, ptype - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf real(wp), intent(out) :: f_pinfl integer, dimension(3), intent(out) :: cell real(wp), intent(out), optional :: preterm1, term2, Romega @@ -886,19 +886,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 @@ -969,9 +969,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%vf(1)%sf(cellaux(1), cellaux(2), cellaux(3)) - charpres2 = charpres2 + q_prim_vf(E_idx)%sf(cellaux(1), cellaux(2), cellaux(3)) & + charpres2 = charpres2 + q_prim_vf(eqn_idx%E)%sf(cellaux(1), cellaux(2), cellaux(3)) & *vol*q_beta%vf(1)%sf(cellaux(1), cellaux(2), cellaux(3)) end if diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 1645ffef25..c6af336bbf 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -101,10 +101,10 @@ module m_cbc !$acc declare create(is1, is2, is3) integer :: dj - integer :: bcxb, bcxe, bcyb, bcye, bczb, bcze + type(boundary_bounds) :: bc_bound !< Boundary flags integer :: cbc_dir, cbc_loc integer :: flux_cbc_index - !$acc declare create(dj, bcxb, bcxe, bcyb, bcye, bczb, bcze, cbc_dir, cbc_loc, flux_cbc_index) + !$acc declare create(dj, bc_bound, cbc_dir, cbc_loc, flux_cbc_index) !! GRCBC inputs for subsonic inflow and outflow conditions consisting of !! inflow velocities, pressure, density and void fraction as well as @@ -133,9 +133,9 @@ contains logical :: is_cbc if (chemistry) then - flux_cbc_index = sys_size + flux_cbc_index = eqn_idx%sys_size else - flux_cbc_index = adv_idx%end + flux_cbc_index = eqn_idx%adv%end end if !$acc update device(flux_cbc_index) @@ -162,7 +162,7 @@ contains @:ALLOCATE(q_prim_rsx_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) if (weno_order > 1) then @@ -172,7 +172,7 @@ contains @:ALLOCATE(F_src_rsx_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @@ -182,7 +182,7 @@ contains @:ALLOCATE(flux_src_rsx_vf_l(-1:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) if (n > 0) then @@ -205,7 +205,7 @@ contains @:ALLOCATE(q_prim_rsy_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) if (weno_order > 1) then @@ -215,7 +215,7 @@ contains @:ALLOCATE(F_src_rsy_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @@ -225,7 +225,7 @@ contains @:ALLOCATE(flux_src_rsy_vf_l(-1:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @@ -250,7 +250,7 @@ contains @:ALLOCATE(q_prim_rsz_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) if (weno_order > 1) then @@ -260,7 +260,7 @@ contains @:ALLOCATE(F_src_rsz_vf(0:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @@ -270,7 +270,7 @@ contains @:ALLOCATE(flux_src_rsz_vf_l(-1:buff_size, & is2%beg:is2%end, & - is3%beg:is3%end, adv_idx%beg:adv_idx%end)) + is3%beg:is3%end, eqn_idx%adv%beg:eqn_idx%adv%end)) end if @@ -392,23 +392,23 @@ contains ! 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 + bc_bound%xb = bc_x%beg + bc_bound%xe = bc_x%end - !$acc update device(bcxb, bcxe) + !$acc update device(bc_bound) if (n > 0) then - bcyb = bc_y%beg - bcye = bc_y%end + bc_bound%yb = bc_y%beg + bc_bound%ye = bc_y%end - !$acc update device(bcyb, bcye) + !$acc update device(bc_bound) end if if (p > 0) then - bczb = bc_z%beg - bcze = bc_z%end + bc_bound%zb = bc_z%beg + bc_bound%ze = bc_z%end - !$acc update device(bczb, bcze) + !$acc update device(bc_bound) end if ! Allocate GRCBC inputs @@ -626,11 +626,11 @@ contains ix, iy, iz) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_prim_vf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_vf, flux_src_vf integer, intent(in) :: cbc_dir_norm, cbc_loc_norm @@ -653,7 +653,7 @@ contains real(wp), dimension(2) :: Re_cbc real(wp), dimension(num_vels) :: vel, dvel_ds real(wp), dimension(num_fluids) :: adv, dadv_ds - real(wp), dimension(sys_size) :: L + real(wp), dimension(eqn_idx%sys_size) :: L real(wp), dimension(3) :: lambda real(wp) :: rho !< Cell averaged density @@ -793,11 +793,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) !$acc loop seq - do i = 1, advxe - E_idx - adv(i) = q_prim_rs${XYZ}$_vf(0, k, r, E_idx + i) + do i = 1, advxe - eqn_idx%E + adv(i) = q_prim_rs${XYZ}$_vf(0, k, r, eqn_idx%E + i) end do if (bubbles_euler) then @@ -857,7 +857,7 @@ contains dpres_ds = 0._wp !$acc loop seq - do i = 1, advxe - E_idx + do i = 1, advxe - eqn_idx%E dadv_ds(i) = 0._wp end do @@ -884,12 +884,12 @@ contains dvel_ds(i) end do - dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, E_idx)* & + dpres_ds = q_prim_rs${XYZ}$_vf(j, k, r, eqn_idx%E)* & fd_coef_${XYZ}$ (j, cbc_loc) + & dpres_ds !$acc loop seq - do i = 1, advxe - E_idx - dadv_ds(i) = q_prim_rs${XYZ}$_vf(j, k, r, E_idx + 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 @@ -905,21 +905,21 @@ contains end do ! First-Order Temporal Derivatives of Primitive Variables - lambda(1) = vel(dir_idx(1)) - c - lambda(2) = vel(dir_idx(1)) - lambda(3) = vel(dir_idx(1)) + c + lambda(1) = vel(eqn_idx%dir(1)) - c + lambda(2) = vel(eqn_idx%dir(1)) + lambda(3) = vel(eqn_idx%dir(1)) + c - Ma = vel(dir_idx(1))/c + Ma = vel(eqn_idx%dir(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 - 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 + if ((cbc_loc == -1 .and. bc_bound%${XYZ}$b == BC_CHAR_SLIP_WALL) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == BC_CHAR_SLIP_WALL)) then + call s_compute_slip_wall_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + else if ((cbc_loc == -1 .and. bc_bound%${XYZ}$b == BC_CHAR_NR_SUB_BUFFER) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == 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 - call s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, dpres_ds, dvel_ds) + else if ((cbc_loc == -1 .and. bc_bound%${XYZ}$b == BC_CHAR_NR_SUB_INFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == BC_CHAR_NR_SUB_INFLOW)) then + call s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) ! Add GRCBC for Subsonic Inflow if (bc_${XYZ}$%grcbc_in) then !$acc loop seq @@ -927,19 +927,19 @@ contains L(2) = 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(momxb + 1) = c*Ma*(vel(eqn_idx%dir(2)) - vel_in(${CBC_DIR}$, eqn_idx%dir(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(momxb + 2) = c*Ma*(vel(eqn_idx%dir(3)) - vel_in(${CBC_DIR}$, eqn_idx%dir(3)))/Del_in(${CBC_DIR}$) end if end if !$acc loop seq - do i = E_idx, advxe - 1 - L(i) = c*Ma*(adv(i + 1 - E_idx) - alpha_in(i + 1 - E_idx, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) + do i = eqn_idx%E, advxe - 1 + L(i) = c*Ma*(adv(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, cbc_loc))/Del_in(${CBC_DIR}$) + c*(1._wp + Ma)*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) + L(advxe) = rho*c**2._wp*(1._wp + Ma)*(vel(eqn_idx%dir(1)) + vel_in(${CBC_DIR}$, eqn_idx%dir(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_bound%${XYZ}$b == BC_CHAR_NR_SUB_OUTFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == BC_CHAR_NR_SUB_OUTFLOW)) then call s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) ! Add GRCBC for Subsonic Outflow (Pressure) if (bc_${XYZ}$%grcbc_out) then @@ -947,26 +947,26 @@ contains ! 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(advxe) = L(advxe) + rho*c**2._wp*(1._wp - Ma)*(vel(eqn_idx%dir(1)) + vel_out(${CBC_DIR}$, eqn_idx%dir(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_bound%${XYZ}$b == BC_CHAR_FF_SUB_OUTFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == 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_bound%${XYZ}$b == BC_CHAR_CP_SUB_OUTFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == 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 - 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_bound%${XYZ}$b == BC_CHAR_SUP_INFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == BC_CHAR_SUP_INFLOW)) then + call s_compute_supersonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + else if ((cbc_loc == -1 .and. bc_bound%${XYZ}$b == BC_CHAR_SUP_OUTFLOW) .or. & + (cbc_loc == 1 .and. bc_bound%${XYZ}$e == BC_CHAR_SUP_OUTFLOW)) then call s_compute_supersonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) end if ! Be careful about the cylindrical coordinate! if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then - dpres_dt = -5e-1_wp*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) & + dpres_dt = -5e-1_wp*(L(advxe) + L(1)) + rho*c*c*vel(eqn_idx%dir(1)) & /y_cc(n) else dpres_dt = -5e-1_wp*(L(advxe) + L(1)) @@ -980,9 +980,9 @@ contains !$acc loop seq do i = 1, num_dims - dvel_dt(dir_idx(i)) = dir_flg(dir_idx(i))* & + dvel_dt(eqn_idx%dir(i)) = eqn_idx%dir_flg(eqn_idx%dir(i))* & (L(1) - L(advxe))/(2._wp*rho*c) + & - (dir_flg(dir_idx(i)) - 1._wp)* & + (eqn_idx%dir_flg(eqn_idx%dir(i)) - 1._wp)* & L(momxb + i - 1) end do @@ -1002,12 +1002,12 @@ contains ! The treatment of void fraction source is unclear if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then !$acc loop seq - do i = 1, advxe - E_idx - dadv_dt(i) = -L(momxe + i) !+ adv(i) * vel(dir_idx(1))/y_cc(n) + do i = 1, advxe - eqn_idx%E + dadv_dt(i) = -L(momxe + i) !+ adv(i) * vel(eqn_idx%dir(1))/y_cc(n) end do else !$acc loop seq - do i = 1, advxe - E_idx + do i = 1, advxe - eqn_idx%E dadv_dt(i) = -L(momxe + i) end do end if @@ -1051,7 +1051,7 @@ contains h_k(i) = h_k(i)*gas_constant/molecular_weights(i)*T sum_Enthalpies = sum_Enthalpies + (rho*h_k(i) - pres*Mw/molecular_weights(i)*Cp/R_gas)*dYs_dt(i) end do - flux_rs${XYZ}$_vf_l(-1, k, r, E_idx) = flux_rs${XYZ}$_vf_l(0, k, r, E_idx) & + 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) !$acc loop seq do i = 1, num_species @@ -1059,7 +1059,7 @@ contains + 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) & + 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 & @@ -1077,12 +1077,12 @@ contains !$acc loop seq do i = advxb, advxe 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))) & + 1._wp/max(abs(vel(eqn_idx%dir(1))), sgm_eps) & + *sign(1._wp, vel(eqn_idx%dir(1))) & *(flux_rs${XYZ}$_vf_l(0, k, r, i) & - + vel(dir_idx(1)) & + + vel(eqn_idx%dir(1)) & *flux_src_rs${XYZ}$_vf_l(0, k, r, i) & - + ds(0)*dadv_dt(i - E_idx)) + + ds(0)*dadv_dt(i - eqn_idx%E)) end do else @@ -1090,7 +1090,7 @@ contains !$acc loop 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) + ds(0)*dadv_dt(i - eqn_idx%E) end do !$acc loop seq @@ -1128,11 +1128,11 @@ contains ix, iy, iz) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_prim_vf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: flux_vf, flux_src_vf type(int_bounds_info), intent(in) :: ix, iy, iz @@ -1147,24 +1147,24 @@ contains if (cbc_dir == 1) then is1%beg = 0; is1%end = buff_size; is2 = iy; is3 = iz - dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/) + eqn_idx%dir = (/1, 2, 3/); eqn_idx%dir_flg = (/1._wp, 0._wp, 0._wp/) elseif (cbc_dir == 2) then is1%beg = 0; is1%end = buff_size; is2 = ix; is3 = iz - dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/) + eqn_idx%dir = (/2, 1, 3/); eqn_idx%dir_flg = (/0._wp, 1._wp, 0._wp/) else is1%beg = 0; is1%end = buff_size; is2 = iy; is3 = ix - dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/) + eqn_idx%dir = (/3, 1, 2/); eqn_idx%dir_flg = (/0._wp, 0._wp, 1._wp/) end if dj = max(0, cbc_loc) !$acc update device(is1, is2, is3, dj) - !$acc update device( dir_idx, dir_flg) + !$acc update device( eqn_idx%dir, eqn_idx%dir_flg) ! Reshaping Inputted Data in x-direction if (cbc_dir == 1) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size @@ -1240,7 +1240,7 @@ contains elseif (cbc_dir == 2) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size @@ -1316,7 +1316,7 @@ contains else !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do r = is3%beg, is3%end do k = is2%beg, is2%end do j = 0, buff_size @@ -1401,7 +1401,7 @@ contains subroutine s_finalize_cbc(flux_vf, flux_src_vf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_vf, flux_src_vf integer :: i, j, k, r !< Generic loop iterators diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 47b3f9ce81..65504a2436 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -23,13 +23,13 @@ contains real(wp), intent(in) :: rho, c, dpres_ds real(wp), dimension(num_dims), intent(in) :: dvel_ds real(wp) :: L1 - L1 = lambda(1)*(dpres_ds - rho*c*dvel_ds(dir_idx(1))) + L1 = lambda(1)*(dpres_ds - rho*c*dvel_ds(eqn_idx%dir(1))) end function f_base_L1 !> Fill density L variables pure subroutine s_fill_density_L(L, lambda_factor, lambda2, c, mf, dalpha_rho_ds, dpres_ds) !$acc routine seq - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: lambda_factor, lambda2, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -43,25 +43,25 @@ contains !> Fill velocity L variables pure subroutine s_fill_velocity_L(L, lambda_factor, lambda2, dvel_ds) !$acc routine seq - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: lambda_factor, lambda2 real(wp), dimension(num_dims), intent(in) :: dvel_ds integer :: i do i = momxb + 1, momxe - L(i) = lambda_factor*lambda2*dvel_ds(dir_idx(i - contxe)) + L(i) = lambda_factor*lambda2*dvel_ds(eqn_idx%dir(i - contxe)) end do end subroutine s_fill_velocity_L !> Fill advection L variables pure subroutine s_fill_advection_L(L, lambda_factor, lambda2, dadv_ds) !$acc routine seq - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: lambda_factor, lambda2 real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i - do i = E_idx, advxe - 1 + do i = eqn_idx%E, advxe - 1 L(i) = lambda_factor*lambda2*dadv_ds(i - momxe) end do end subroutine s_fill_advection_L @@ -69,7 +69,7 @@ contains !> Fill chemistry L variables pure subroutine s_fill_chemistry_L(L, lambda_factor, lambda2, dYs_ds) !$acc routine seq - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: lambda_factor, lambda2 real(wp), dimension(num_species), intent(in) :: dYs_ds integer :: i @@ -89,7 +89,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c, dpres_ds real(wp), dimension(num_dims), intent(in) :: dvel_ds integer :: i @@ -107,7 +107,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -117,7 +117,7 @@ contains real(wp) :: lambda_factor lambda_factor = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(1))) - L(1) = lambda_factor*lambda(1)*(dpres_ds - rho*c*dvel_ds(dir_idx(1))) + L(1) = lambda_factor*lambda(1)*(dpres_ds - rho*c*dvel_ds(eqn_idx%dir(1))) lambda_factor = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2))) call s_fill_density_L(L, lambda_factor, lambda(2), c, mf, dalpha_rho_ds, dpres_ds) @@ -126,7 +126,7 @@ contains call s_fill_chemistry_L(L, lambda_factor, lambda(2), dYs_ds) lambda_factor = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(3))) - L(advxe) = lambda_factor*lambda(3)*(dpres_ds + rho*c*dvel_ds(dir_idx(1))) + L(advxe) = lambda_factor*lambda(3)*(dpres_ds + rho*c*dvel_ds(eqn_idx%dir(1))) end subroutine s_compute_nonreflecting_subsonic_buffer_L !> Nonreflecting subsonic inflow CBC (Thompson 1990, pg. 455) @@ -137,7 +137,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c, dpres_ds real(wp), dimension(num_dims), intent(in) :: dvel_ds @@ -154,7 +154,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -178,7 +178,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -189,7 +189,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(advxe) = L(1) + 2._wp*rho*c*lambda(2)*dvel_ds(eqn_idx%dir(1)) end subroutine s_compute_force_free_subsonic_outflow_L !> Constant pressure subsonic outflow CBC (Thompson 1990, pg. 455) @@ -200,7 +200,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -221,7 +221,7 @@ contains #else !$acc routine seq #endif - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L L(1:advxe) = 0._wp if (chemistry) L(chemxb:chemxe) = 0._wp end subroutine s_compute_supersonic_inflow_L @@ -234,7 +234,7 @@ contains !$acc routine seq #endif real(wp), dimension(3), intent(in) :: lambda - real(wp), dimension(sys_size), intent(inout) :: L + real(wp), dimension(eqn_idx%sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds real(wp), intent(in) :: dpres_ds @@ -247,6 +247,6 @@ 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(advxe) = lambda(3)*(dpres_ds + rho*c*dvel_ds(eqn_idx%dir(1))) end subroutine s_compute_supersonic_outflow_L end module m_compute_cbc diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 5b174e6652..f5b75b2783 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -79,14 +79,14 @@ contains impure subroutine s_write_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(in) :: q_cons_vf type(scalar_field), & intent(inout) :: q_T_sf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_prim_vf integer, intent(in) :: t_step @@ -261,7 +261,7 @@ contains !! @param t_step Current time step impure subroutine s_write_run_time_information(q_prim_vf, t_step) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf integer, intent(in) :: t_step real(wp) :: rho !< Cell-avg. density @@ -388,9 +388,9 @@ contains !! @param t_step Current time-step impure subroutine s_write_serial_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf integer, intent(in) :: t_step type(scalar_field), intent(inout), optional :: beta @@ -453,7 +453,7 @@ contains end if ! Writing the conservative variables data files - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A)') trim(t_step_dir)//'/q_cons_vf', & i, '.dat' @@ -468,7 +468,7 @@ contains do i = 1, nb do r = 1, nnode write (file_path, '(A,I0,A)') trim(t_step_dir)//'/pb', & - sys_size + (i - 1)*nnode + r, '.dat' + eqn_idx%sys_size + (i - 1)*nnode + r, '.dat' open (2, FILE=trim(file_path), & FORM='unformatted', & @@ -481,7 +481,7 @@ contains do i = 1, nb do r = 1, nnode write (file_path, '(A,I0,A)') trim(t_step_dir)//'/mv', & - sys_size + (i - 1)*nnode + r, '.dat' + eqn_idx%sys_size + (i - 1)*nnode + r, '.dat' open (2, FILE=trim(file_path), & FORM='unformatted', & @@ -524,7 +524,7 @@ contains if (prim_vars_wrt .or. (n == 0 .and. p == 0)) then call s_convert_conservative_to_primitive_variables(q_cons_vf, q_T_sf, q_prim_vf, idwint) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size !$acc 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) @@ -537,13 +537,13 @@ contains if (n == 0 .and. p == 0) then if (model_eqns == 2) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/prim.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) do j = 0, m ! todo: revisit change here - if (((i >= adv_idx%beg) .and. (i <= adv_idx%end))) then + if (((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end))) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0) else write (2, FMT) x_cb(j), q_prim_vf(i)%sf(j, 0, 0) @@ -553,7 +553,7 @@ contains end do end if - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) @@ -597,7 +597,7 @@ contains ! 2D if ((n > 0) .and. (p == 0)) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) do j = 0, m @@ -651,16 +651,16 @@ contains end if if (prim_vars_wrt) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/prim.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) do j = 0, m do k = 0, n - if (((i >= cont_idx%beg) .and. (i <= cont_idx%end)) & + if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) & .or. & - ((i >= adv_idx%beg) .and. (i <= adv_idx%end)) & + ((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end)) & .or. & ((i >= chemxb) .and. (i <= chemxe)) & ) then @@ -684,7 +684,7 @@ contains ! 3D if (p > 0) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/cons.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) do j = 0, m @@ -748,7 +748,7 @@ contains end if if (prim_vars_wrt) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A,I2.2,A,I6.6,A)') trim(t_step_dir)//'/prim.', i, '.', proc_rank, '.', t_step, '.dat' open (2, FILE=trim(file_path)) @@ -756,9 +756,9 @@ contains do j = 0, m do k = 0, n do l = 0, p - if (((i >= cont_idx%beg) .and. (i <= cont_idx%end)) & + if (((i >= eqn_idx%cont%beg) .and. (i <= eqn_idx%cont%end)) & .or. & - ((i >= adv_idx%beg) .and. (i <= adv_idx%end)) & + ((i >= eqn_idx%adv%beg) .and. (i <= eqn_idx%adv%end)) & .or. & ((i >= chemxb) .and. (i <= chemxe)) & ) then @@ -785,7 +785,7 @@ contains !! @param beta Eulerian void fraction from lagrangian bubbles impure subroutine s_write_parallel_data_files(q_cons_vf, t_step, beta) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf integer, intent(in) :: t_step type(scalar_field), intent(inout), optional :: beta @@ -808,9 +808,9 @@ contains integer :: alt_sys !< Altered system size for the lagrangian subgrid bubble model if (present(beta)) then - alt_sys = sys_size + 1 + alt_sys = eqn_idx%sys_size + 1 else - alt_sys = sys_size + alt_sys = eqn_idx%sys_size end if if (file_per_process) then @@ -859,11 +859,11 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) if (bubbles_euler) then ! Write the data for each variable - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -871,7 +871,7 @@ contains end do !Write pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -879,7 +879,7 @@ contains end do end if else - do i = 1, sys_size !TODO: check if correct (sys_size + do i = 1, eqn_idx%sys_size !TODO: check if correct (eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -922,7 +922,7 @@ contains if (bubbles_euler) then ! Write the data for each variable - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -935,7 +935,7 @@ contains end do !Write pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -948,7 +948,7 @@ contains end do end if else - do i = 1, sys_size !TODO: check if correct (sys_size + do i = 1, eqn_idx%sys_size !TODO: check if correct (eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -963,14 +963,14 @@ contains ! Correction for the lagrangian subgrid bubble model if (present(beta)) then - var_MOK = int(sys_size + 1, MPI_OFFSET_KIND) + var_MOK = int(eqn_idx%sys_size + 1, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(sys_size + 1), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(eqn_idx%sys_size + 1), & 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(sys_size + 1)%sf, data_size, & + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(eqn_idx%sys_size + 1)%sf, data_size, & mpi_p, status, ierr) end if @@ -1040,7 +1040,7 @@ contains impure subroutine s_write_probe_files(t_step, q_cons_vf, accel_mag) integer, intent(in) :: t_step - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf real(wp), dimension(0:m, 0:n, 0:p), intent(in) :: accel_mag real(wp), dimension(-1:m) :: distx @@ -1159,48 +1159,48 @@ contains rho, gamma, pi_inf, qv) end if do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k, l)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(damage_idx)%sf(j - 2, k, l) + damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k, l) G = G*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), & + 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) + 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) else call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k, l), & - q_cons_vf(alf_idx)%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 = 1._wp/fluid_pp(1)%gamma + 1._wp else if (elasticity) then - tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho + tau_e(1) = q_cons_vf(eqn_idx%stress%end)%sf(j - 2, k, l)/rho end if if (bubbles_euler) then - alf = q_cons_vf(alf_idx)%sf(j - 2, k, l) + alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k, l) if (num_fluids == 3) then - alfgr = q_cons_vf(alf_idx - 1)%sf(j - 2, k, l) + alfgr = q_cons_vf(eqn_idx%alf - 1)%sf(j - 2, k, l) end if do s = 1, nb - nR(s) = q_cons_vf(bub_idx%rs(s))%sf(j - 2, k, l) - nRdot(s) = q_cons_vf(bub_idx%vs(s))%sf(j - 2, k, l) + nR(s) = q_cons_vf(eqn_idx%bub%rs(s))%sf(j - 2, k, l) + nRdot(s) = q_cons_vf(eqn_idx%bub%vs(s))%sf(j - 2, k, l) end do if (adv_n) then - nbub = q_cons_vf(n_idx)%sf(j - 2, k, l) + nbub = q_cons_vf(eqn_idx%n)%sf(j - 2, k, l) else nR3 = 0._wp do s = 1, nb @@ -1213,12 +1213,12 @@ 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 - M11 = q_cons_vf(bub_idx%moms(1, 5))%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(eqn_idx%bub%moms(1, 1))%sf(j - 2, k, l)/nbub + M10 = q_cons_vf(eqn_idx%bub%moms(1, 2))%sf(j - 2, k, l)/nbub + M01 = q_cons_vf(eqn_idx%bub%moms(1, 3))%sf(j - 2, k, l)/nbub + M20 = q_cons_vf(eqn_idx%bub%moms(1, 4))%sf(j - 2, k, l)/nbub + M11 = q_cons_vf(eqn_idx%bub%moms(1, 5))%sf(j - 2, k, l)/nbub + M02 = q_cons_vf(eqn_idx%bub%moms(1, 6))%sf(j - 2, k, l)/nbub M10 = M10/M00 M01 = M01/M00 @@ -1270,29 +1270,29 @@ contains rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (elasticity) then if (cont_damage) then - damage_state = q_cons_vf(damage_idx)%sf(j - 2, k - 2, l) + damage_state = q_cons_vf(eqn_idx%damage)%sf(j - 2, k - 2, l) G = G*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), & + 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) + 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) 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), & + 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 @@ -1306,14 +1306,14 @@ contains end if if (bubbles_euler) then - alf = q_cons_vf(alf_idx)%sf(j - 2, k - 2, l) + alf = q_cons_vf(eqn_idx%alf)%sf(j - 2, k - 2, l) do s = 1, nb - nR(s) = q_cons_vf(bub_idx%rs(s))%sf(j - 2, k - 2, l) - nRdot(s) = q_cons_vf(bub_idx%vs(s))%sf(j - 2, k - 2, l) + nR(s) = q_cons_vf(eqn_idx%bub%rs(s))%sf(j - 2, k - 2, l) + nRdot(s) = q_cons_vf(eqn_idx%bub%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 @@ -1360,7 +1360,7 @@ contains rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l - 2)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j - 2, k - 2, l - 2)/rho end do dyn_p = 0.5_wp*rho*dot_product(vel, vel) @@ -1373,20 +1373,20 @@ 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(eqn_idx%damage)%sf(j - 2, k - 2, l - 2) G = G*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), & + 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) + 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) 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), & + 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 @@ -1584,13 +1584,13 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j, k, l, & rho, gamma, pi_inf, qv, Re) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho end do pres = ( & - (q_cons_vf(E_idx)%sf(j, k, l) - & - 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2._wp)/rho)/ & - (1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - & + (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 @@ -1656,13 +1656,13 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j, k, l, & rho, gamma, pi_inf, qv, Re) do s = 1, num_vels - vel(s) = q_cons_vf(cont_idx%end + s)%sf(j, k, l)/rho + vel(s) = q_cons_vf(eqn_idx%cont%end + s)%sf(j, k, l)/rho end do pres = ( & - (q_cons_vf(E_idx)%sf(j, k, l) - & - 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2._wp)/rho)/ & - (1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - & + (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) diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 4e53547a9a..6f0a53b7d6 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -180,10 +180,10 @@ pure subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & !DIR$ INLINEALWAYS s_derive_acceleration_component integer, intent(in) :: i - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf0 - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf1 - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf2 - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf3 + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf0 + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf1 + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf2 + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf3 real(wp), dimension(0:m, 0:n, 0:p), intent(out) :: q_sf @@ -194,39 +194,39 @@ pure subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & - - 18._wp*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & - + 9._wp*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & - - 2._wp*q_prim_vf3(mom_idx%beg)%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) do r = -fd_number, fd_number if (n == 0) then ! 1D simulation q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg)%sf(r + 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) elseif (p == 0) then ! 2D simulation q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg)%sf(j, r + 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) else ! 3D simulation if (grid_geometry == 3) then q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%beg)%sf(j, k, r + l)/y_cc(k) + + 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) else q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%beg)%sf(j, k, r + 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 if end if end do @@ -239,36 +239,36 @@ pure subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & - - 18._wp*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & - + 9._wp*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & - - 2._wp*q_prim_vf3(mom_idx%beg + 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) do r = -fd_number, fd_number if (p == 0) then ! 2D simulation q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg + 1)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, r + 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) else ! 3D simulation if (grid_geometry == 3) then q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg + 1)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, k, r + l)/y_cc(k) & - - (q_prim_vf0(mom_idx%end)%sf(j, k, l)**2._wp)/y_cc(k) + + 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) else q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%beg + 1)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, k, r + 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 if end if end do @@ -281,30 +281,30 @@ pure subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%end)%sf(j, k, l) & - - 18._wp*q_prim_vf1(mom_idx%end)%sf(j, k, l) & - + 9._wp*q_prim_vf2(mom_idx%end)%sf(j, k, l) & - - 2._wp*q_prim_vf3(mom_idx%end)%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) do r = -fd_number, fd_number if (grid_geometry == 3) then q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%end)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%end)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%end)%sf(j, k, r + l)/y_cc(k) & - + (q_prim_vf0(mom_idx%end)%sf(j, k, l)* & - q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l))/y_cc(k) + + 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) else q_sf(j, k, l) = q_sf(j, k, l) & - + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & - q_prim_vf0(mom_idx%end)%sf(r + j, k, l) & - + q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l)*fd_coeff_y(r, k)* & - q_prim_vf0(mom_idx%end)%sf(j, r + k, l) & - + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & - q_prim_vf0(mom_idx%end)%sf(j, k, r + 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 if end do end do @@ -322,7 +322,7 @@ end subroutine s_derive_acceleration_component !! @param q_prim_vf Primitive variables !! @param c_m Mass,x-location,y-location,z-location impure subroutine s_derive_center_of_mass(q_vf, c_m) - type(scalar_field), dimension(sys_size), intent(IN) :: q_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(IN) :: q_vf real(wp), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m integer :: i, j, k, l !< Generic loop iterators real(wp) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce @@ -345,7 +345,7 @@ impure subroutine s_derive_center_of_mass(q_vf, c_m) ! x-location weighted c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ! Volume fraction - c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 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 @@ -363,7 +363,7 @@ impure subroutine s_derive_center_of_mass(q_vf, c_m) ! y-location weighted c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ! Volume fraction - c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 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 @@ -383,7 +383,7 @@ impure subroutine s_derive_center_of_mass(q_vf, c_m) ! z-location weighted c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) ! Volume fraction - c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 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_fftw.fpp b/src/simulation/m_fftw.fpp index 3c18a8c1fe..32b564096b 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -79,7 +79,7 @@ contains x_size = m + 1 - batch_size = x_size*sys_size + batch_size = x_size*eqn_idx%sys_size #if defined(MFC_OpenACC) rank = 1; istride = 1; ostride = 1 @@ -89,8 +89,8 @@ contains gpu_fft_size(1) = real_size; iembed(1) = 0 oembed(1) = 0 - !$acc enter data copyin(real_size, cmplx_size, x_size, sys_size, batch_size, Nfq) - !$acc update device(real_size, cmplx_size, x_size, sys_size, batch_size) + !$acc enter data copyin(real_size, cmplx_size, x_size, eqn_idx%sys_size, batch_size, Nfq) + !$acc update device(real_size, cmplx_size, x_size, eqn_idx%sys_size, batch_size) #else ! Allocate input and output DFT data sizes fftw_real_data = fftw_alloc_real(int(real_size, c_size_t)) @@ -107,9 +107,9 @@ contains #endif #if defined(MFC_OpenACC) - @:ALLOCATE(data_real_gpu(1:real_size*x_size*sys_size)) - @:ALLOCATE(data_cmplx_gpu(1:cmplx_size*x_size*sys_size)) - @:ALLOCATE(data_fltr_cmplx_gpu(1:cmplx_size*x_size*sys_size)) + @:ALLOCATE(data_real_gpu(1:real_size*x_size*eqn_idx%sys_size)) + @:ALLOCATE(data_cmplx_gpu(1:cmplx_size*x_size*eqn_idx%sys_size)) + @:ALLOCATE(data_fltr_cmplx_gpu(1:cmplx_size*x_size*eqn_idx%sys_size)) #if defined(__PGI) ierr = cufftPlanMany(fwd_plan_gpu, rank, gpu_fft_size, iembed, istride, real_size, oembed, ostride, cmplx_size, CUFFT_D2Z, batch_size) @@ -130,7 +130,7 @@ contains !! @param q_cons_vf Conservative variables impure subroutine s_apply_fourier_filter(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf real(c_double), pointer :: p_real(:) complex(c_double_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) integer :: i, j, k, l !< Generic loop iterators @@ -140,7 +140,7 @@ contains #if defined(MFC_OpenACC) !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 1, cmplx_size data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0_dp, 0_dp) @@ -149,7 +149,7 @@ contains end do !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 0, p data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = q_cons_vf(k)%sf(j, 0, l) @@ -174,7 +174,7 @@ contains !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 1, Nfq data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = data_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) @@ -192,7 +192,7 @@ contains !$acc end host_data !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 0, p data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, dp) @@ -204,7 +204,7 @@ contains do i = 1, fourier_rings !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 1, cmplx_size data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0_dp, 0_dp) @@ -213,7 +213,7 @@ contains end do !$acc parallel loop collapse(3) gang vector default(present) firstprivate(i) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 0, p data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = q_cons_vf(k)%sf(j, i, l) @@ -234,7 +234,7 @@ contains !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 1, Nfq data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = data_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) @@ -252,7 +252,7 @@ contains !$acc end host_data !$acc parallel loop collapse(3) gang vector default(present) firstprivate(i) - do k = 1, sys_size + do k = 1, eqn_idx%sys_size do j = 0, m do l = 0, p data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, dp) @@ -266,7 +266,7 @@ contains #else Nfq = 3 do j = 0, m - do k = 1, sys_size + do k = 1, eqn_idx%sys_size data_fltr_cmplx(:) = (0_dp, 0_dp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, 0, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) @@ -281,7 +281,7 @@ contains do i = 1, fourier_rings Nfq = min(floor(2_dp*real(i, dp)*pi), cmplx_size) do j = 0, m - do k = 1, sys_size + do k = 1, eqn_idx%sys_size data_fltr_cmplx(:) = (0_dp, 0_dp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, i, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index d0b94f6b7a..da7f07e84d 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -229,27 +229,28 @@ module m_global_parameters !! size and the configuration of the system of equations to which they belong !> @{ integer :: sys_size !< Number of unknowns in system of eqns. - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of energy equation - integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: alf_idx !< Index of void fraction - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: B_idx !< Indexes of first and last magnetic field eqns. - type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. - type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: b_size !< Number of elements in the symmetric b tensor, plus one - integer :: tensor_size !< Number of elements in the full tensor plus one - type(int_bounds_info) :: species_idx !< Indexes of first & last concentration eqns. - integer :: c_idx !< Index of color function - integer :: damage_idx !< Index of damage state variable (D) for continuum damage model + ! type(int_bounds_info) :: eqn_idx%cont !< Indexes of first & last continuity eqns. + ! type(int_bounds_info) :: eqn_idx%mom !< Indexes of first & last momentum eqns. + ! integer :: eqn_idx%E !< Index of energy equation + ! integer :: eqn_idx%n !< Index of number density + ! type(int_bounds_info) :: eqn_idx%adv !< Indexes of first & last advection eqns. + ! type(int_bounds_info) :: eqn_idx%internalEnergies !< Indexes of first & last internal energy eqns. + ! type(bub_bounds_info) :: eqn_idx%bub !< Indexes of first & last bubble variable eqns. + ! integer :: eqn_idx%alf !< Index of void fraction + ! integer :: eqn_idx%gamma !< Index of specific heat ratio func. eqn. + ! integer :: eqn_idx%pi_inf !< Index of liquid stiffness func. eqn. + ! type(int_bounds_info) :: eqn_idx%B !< Indexes of first and last magnetic field eqns. + ! type(int_bounds_info) :: eqn_idx%stress !< Indexes of first and last shear stress eqns. + ! type(int_bounds_info) :: eqn_idx%xi !< Indexes of first and last reference map eqns. + ! integer :: eqn_idx%b_size !< Number of elements in the symmetric b tensor, plus one + ! integer :: eqn_idx%tensor_size !< Number of elements in the full tensor plus one + ! type(int_bounds_info) :: eqn_idx%species !< Indexes of first & last concentration eqns. + ! integer :: eqn_idx%c !< Index of color function + ! integer :: eqn_idx%damage !< Index of damage state variable (D) for continuum damage model !> @} - !$acc declare create(bub_idx) + type(system_of_equations) :: eqn_idx + !$acc declare create(eqn_idx) ! Cell Indices for the (local) interior points (O-m, O-n, 0-p). ! Stands for "InDices With INTerior". @@ -262,16 +263,6 @@ module m_global_parameters type(int_bounds_info) :: idwbuff(1:3) !$acc declare create(idwbuff) - !> @name The number of fluids, along with their identifying indexes, respectively, - !! for which viscous effects, e.g. the shear and/or the volume Reynolds (Re) - !! numbers, will be non-negligible. - !> @{ - integer, dimension(2) :: Re_size - integer, allocatable, dimension(:, :) :: Re_idx - !> @} - - !$acc declare create(Re_size, Re_idx) - ! The WENO average (WA) flag regulates whether the calculation of any cell- ! average spatial derivatives is carried out in each cell by utilizing the ! arithmetic mean of the left and right, WENO-reconstructed, cell-boundary @@ -283,24 +274,12 @@ module m_global_parameters !$acc declare create(wa_flg) - !> @name The coordinate direction indexes and flags (flg), respectively, for which - !! the configurations will be determined with respect to a working direction - !! and that will be used to isolate the contributions, in that direction, in - !! the dimensionally split system of equations. - !> @{ - integer, dimension(3) :: dir_idx - real(wp), dimension(3) :: dir_flg - integer, dimension(3) :: dir_idx_tau !!used for hypoelasticity=true - !> @} - - !$acc declare create(dir_idx, dir_flg, dir_idx_tau) - integer :: buff_size !< !! The number of cells that are necessary to be able to store enough boundary !! conditions data to march the solution in the physical computational domain !! to the next time-step. - !$acc declare create(sys_size, buff_size, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size, xi_idx, species_idx, B_idx, c_idx) + !$acc declare create(buff_size) integer :: shear_num !! Number of shear stress components integer, dimension(3) :: shear_indices !< @@ -561,8 +540,8 @@ contains hyperelasticity = .false. elasticity = .false. hyper_model = dflt_int - b_size = dflt_int - tensor_size = dflt_int + eqn_idx%b_size = dflt_int + eqn_idx%tensor_size = dflt_int weno_flat = .true. riemann_flat = .true. rdma_mpi = .false. @@ -800,7 +779,7 @@ contains ! for which surface tension will be important and also, the number ! of fluids for which the physical and geometric curvatures of the ! interfaces will be computed - Re_size = 0 + eqn_idx%Re_size = 0 ! Gamma/Pi_inf Model if (model_eqns == 1) then @@ -808,16 +787,16 @@ contains ! Annotating structure of the state and flux vectors belonging ! to the system of equations defined by the selected number of ! spatial dimensions and the gamma/pi_inf model - cont_idx%beg = 1 - cont_idx%end = cont_idx%beg - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg + 1 - gamma_idx = adv_idx%beg - pi_inf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = eqn_idx%cont%beg + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg + 1 + eqn_idx%gamma = eqn_idx%adv%beg + eqn_idx%pi_inf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end ! Volume Fraction Model else @@ -826,50 +805,50 @@ contains ! to the system of equations defined by the selected number of ! spatial dimensions and the volume fraction model if (model_eqns == 2) then - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids + 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 - sys_size = adv_idx%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - alf_idx = adv_idx%end + eqn_idx%alf = eqn_idx%adv%end else - alf_idx = 1 + eqn_idx%alf = 1 end if if (bubbles_euler) then - bub_idx%beg = sys_size + 1 + eqn_idx%bub%beg = sys_size + 1 if (qbmm) then nmomsp = 4 !number of special moments if (nnode == 4) then ! nmom = 6 : It is already a parameter nmomtot = nmom*nb end if - bub_idx%end = adv_idx%end + nb*nmom + eqn_idx%bub%end = eqn_idx%adv%end + nb*nmom else if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb else - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%end = sys_size + 2*nb end if end if - sys_size = bub_idx%end - ! print*, 'alf idx', alf_idx - ! print*, 'bub -idx beg end', bub_idx%beg, bub_idx%end + sys_size = eqn_idx%bub%end + ! print*, 'alf idx', eqn_idx%alf + ! print*, 'bub -idx beg end', eqn_idx%bub%beg, eqn_idx%bub%end if (adv_n) then - n_idx = bub_idx%end + 1 - sys_size = n_idx + eqn_idx%n = eqn_idx%bub%end + 1 + sys_size = eqn_idx%n end if @:ALLOCATE(weight(nb), R0(nb), V0(nb)) - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + @:ALLOCATE(eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) if (num_fluids == 1) then gam = 1._wp/fluid_pp(num_fluids + 1)%gamma + 1._wp @@ -878,13 +857,13 @@ contains end if if (qbmm) then - @:ALLOCATE(bub_idx%moms(nb, nmom)) + @:ALLOCATE(eqn_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 + eqn_idx%bub%moms(i, j) = eqn_idx%bub%beg + (j - 1) + (i - 1)*nmom end do - bub_idx%rs(i) = bub_idx%moms(i, 2) - bub_idx%vs(i) = bub_idx%moms(i, 3) + eqn_idx%bub%rs(i) = eqn_idx%bub%moms(i, 2) + eqn_idx%bub%vs(i) = eqn_idx%bub%moms(i, 3) end do else @@ -895,12 +874,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do end if @@ -941,49 +920,49 @@ contains end if if (mhd) then - B_idx%beg = sys_size + 1 + eqn_idx%B%beg = sys_size + 1 if (n == 0) then - B_idx%end = sys_size + 2 ! 1D: By, Bz + eqn_idx%B%end = sys_size + 2 ! 1D: By, Bz else - B_idx%end = sys_size + 3 ! 2D/3D: Bx, By, Bz + eqn_idx%B%end = sys_size + 3 ! 2D/3D: Bx, By, Bz end if - sys_size = B_idx%end + sys_size = eqn_idx%B%end end if else if (model_eqns == 3) then - cont_idx%beg = 1 - cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 - adv_idx%beg = E_idx + 1 - adv_idx%end = E_idx + num_fluids - alf_idx = adv_idx%end - internalEnergies_idx%beg = adv_idx%end + 1 - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end + eqn_idx%cont%beg = 1 + eqn_idx%cont%end = num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%E + num_fluids + eqn_idx%alf = eqn_idx%adv%end + eqn_idx%internalEnergies%beg = eqn_idx%adv%end + 1 + eqn_idx%internalEnergies%end = eqn_idx%adv%end + num_fluids + sys_size = eqn_idx%internalEnergies%end else if (model_eqns == 4) then - cont_idx%beg = 1 ! one continuity equation - cont_idx%end = 1 !num_fluids - mom_idx%beg = cont_idx%end + 1 ! one momentum equation in each direction - mom_idx%end = cont_idx%end + num_vels - E_idx = mom_idx%end + 1 ! one energy equation - adv_idx%beg = E_idx + 1 - adv_idx%end = adv_idx%beg !one volume advection equation - alf_idx = adv_idx%end - sys_size = adv_idx%end + eqn_idx%cont%beg = 1 ! one continuity equation + eqn_idx%cont%end = 1 !num_fluids + eqn_idx%mom%beg = eqn_idx%cont%end + 1 ! one momentum equation in each direction + eqn_idx%mom%end = eqn_idx%cont%end + num_vels + eqn_idx%E = eqn_idx%mom%end + 1 ! one energy equation + eqn_idx%adv%beg = eqn_idx%E + 1 + eqn_idx%adv%end = eqn_idx%adv%beg !one volume advection equation + eqn_idx%alf = eqn_idx%adv%end + sys_size = eqn_idx%adv%end if (bubbles_euler) then - bub_idx%beg = sys_size + 1 - bub_idx%end = sys_size + 2*nb + eqn_idx%bub%beg = sys_size + 1 + eqn_idx%bub%end = sys_size + 2*nb if (.not. polytropic) then - bub_idx%end = sys_size + 4*nb + eqn_idx%bub%end = sys_size + 4*nb end if - sys_size = bub_idx%end + sys_size = eqn_idx%bub%end - @:ALLOCATE(bub_idx%rs(nb), bub_idx%vs(nb)) - @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) + @:ALLOCATE(eqn_idx%bub%rs(nb), eqn_idx%bub%vs(nb)) + @:ALLOCATE(eqn_idx%bub%ps(nb), eqn_idx%bub%ms(nb)) @:ALLOCATE(weight(nb), R0(nb), V0(nb)) do i = 1, nb @@ -993,12 +972,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 + eqn_idx%bub%rs(i) = eqn_idx%bub%beg + (i - 1)*fac + eqn_idx%bub%vs(i) = eqn_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 + eqn_idx%bub%ps(i) = eqn_idx%bub%vs(i) + 1 + eqn_idx%bub%ms(i) = eqn_idx%bub%ps(i) + 1 end if end do if (nb == 1) then @@ -1021,32 +1000,32 @@ contains ! Determining the number of fluids for which the shear and the ! volume Reynolds numbers, e.g. viscous effects, are important do i = 1, num_fluids - if (fluid_pp(i)%Re(1) > 0) Re_size(1) = Re_size(1) + 1 - if (fluid_pp(i)%Re(2) > 0) Re_size(2) = Re_size(2) + 1 + if (fluid_pp(i)%Re(1) > 0) eqn_idx%Re_size(1) = eqn_idx%Re_size(1) + 1 + if (fluid_pp(i)%Re(2) > 0) eqn_idx%Re_size(2) = eqn_idx%Re_size(2) + 1 end do - if (Re_size(1) > 0._wp) shear_stress = .true. - if (Re_size(2) > 0._wp) bulk_stress = .true. + if (eqn_idx%Re_size(1) > 0._wp) shear_stress = .true. + if (eqn_idx%Re_size(2) > 0._wp) bulk_stress = .true. - !$acc update device(Re_size, viscous, shear_stress, bulk_stress) + !$acc update device(eqn_idx, viscous, shear_stress, bulk_stress) ! Bookkeeping the indexes of any viscous fluids and any pairs of ! fluids whose interface will support effects of surface tension if (viscous) then - @:ALLOCATE(Re_idx(1:2, 1:maxval(Re_size))) + @:ALLOCATE(eqn_idx%Re(1:2, 1:maxval(eqn_idx%Re_size))) k = 0 do i = 1, num_fluids if (fluid_pp(i)%Re(1) > 0) then - k = k + 1; Re_idx(1, k) = i + k = k + 1; eqn_idx%Re(1, k) = i end if end do k = 0 do i = 1, num_fluids if (fluid_pp(i)%Re(2) > 0) then - k = k + 1; Re_idx(2, k) = i + k = k + 1; eqn_idx%Re(2, k) = i end if end do @@ -1058,24 +1037,24 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - if (cyl_coord) stress_idx%end = stress_idx%end + 1 + eqn_idx%stress%beg = sys_size + 1 + eqn_idx%stress%end = sys_size + (num_dims*(num_dims + 1))/2 + if (cyl_coord) eqn_idx%stress%end = eqn_idx%stress%end + 1 ! number of stresses is 1 in 1D, 3 in 2D, 4 in 2D-Axisym, 6 in 3D - sys_size = stress_idx%end + sys_size = eqn_idx%stress%end ! shear stress index is 2 for 2D and 2,4,5 for 3D if (num_dims == 1) then shear_num = 0 else if (num_dims == 2) then shear_num = 1 - shear_indices(1) = stress_idx%beg - 1 + 2 + shear_indices(1) = eqn_idx%stress%beg - 1 + 2 shear_BC_flip_num = 1 shear_BC_flip_indices(1:2, 1) = shear_indices(1) ! Both x-dir and y-dir: flip tau_xy only else if (num_dims == 3) then shear_num = 3 - shear_indices(1:3) = stress_idx%beg - 1 + (/2, 4, 5/) + shear_indices(1:3) = eqn_idx%stress%beg - 1 + (/2, 4, 5/) shear_BC_flip_num = 2 shear_BC_flip_indices(1, 1:2) = shear_indices((/1, 2/)) shear_BC_flip_indices(2, 1:2) = shear_indices((/1, 3/)) @@ -1089,23 +1068,23 @@ contains if (hyperelasticity) then ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 + eqn_idx%b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + eqn_idx%tensor_size = num_dims**2 + 1 + eqn_idx%xi%beg = sys_size + 1 + eqn_idx%xi%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + sys_size = eqn_idx%xi%end + 1 end if if (surface_tension) then - c_idx = sys_size + 1 - sys_size = c_idx + eqn_idx%c = sys_size + 1 + sys_size = eqn_idx%c end if if (cont_damage) then - damage_idx = sys_size + 1 - sys_size = damage_idx + eqn_idx%damage = sys_size + 1 + sys_size = eqn_idx%damage end if end if @@ -1113,9 +1092,9 @@ contains ! END: Volume Fraction Model if (chemistry) then - species_idx%beg = sys_size + 1 - species_idx%end = sys_size + num_species - sys_size = species_idx%end + eqn_idx%species%beg = sys_size + 1 + eqn_idx%species%end = sys_size + num_species + sys_size = eqn_idx%species%end end if if (bubbles_euler .and. qbmm .and. .not. polytropic) then @@ -1161,7 +1140,7 @@ contains if (ib) allocate (MPI_IO_IB_DATA%var%sf(0:m, 0:n, 0:p)) Np = 0 - !$acc update device(Re_size) + !$acc update device(eqn_idx%Re_size) if (elasticity) then fd_number = max(1, fd_order/2) @@ -1199,31 +1178,29 @@ 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 - - !$acc 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) - !$acc update device(b_size, xibeg, xiend, tensor_size) - - !$acc update device(species_idx) + 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%internalEnergies%beg + intxe = eqn_idx%internalEnergies%end + xibeg = eqn_idx%xi%beg + xiend = eqn_idx%xi%end + chemxb = eqn_idx%species%beg + chemxe = eqn_idx%species%end + + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, buff_size, eqn_idx, adv_n, adap_dt, pi_fac, strxb, strxe, chemxb, chemxe, xibeg, xiend) + !$acc update device(cfl_target, m, n, p) !$acc update device(alt_soundspeed, acoustic_source, num_source) - !$acc 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, num_fluids, model_eqns, num_dims, num_vels, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, hyper_model, elasticity, xi_idx, B_idx, low_Mach) + !$acc update device(dt, buff_size, pref, rhoref, mpp_lim, bubbles_euler, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, num_vels, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, hyper_model, elasticity, low_Mach) !$acc update device(Bx0, powell) @@ -1237,7 +1214,7 @@ contains !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles_euler, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) - !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) + !$acc enter data copyin(eqn_idx%dir, eqn_idx%dir_flg, eqn_idx%dir_tau) !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) @@ -1304,7 +1281,7 @@ contains ! fluids and any pairs of fluids whose interfaces supported effects ! of surface tension if (viscous) then - @:DEALLOCATE(Re_idx) + @:DEALLOCATE(eqn_idx%Re) end if deallocate (proc_coords) @@ -1339,3 +1316,4 @@ contains end subroutine s_finalize_global_parameters_module end module m_global_parameters + diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index ba8b5bc4a8..1afaf5d5bc 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -48,8 +48,8 @@ contains impure subroutine s_initialize_hyperelastic_module integer :: i !< generic iterator - @:ALLOCATE(btensor%vf(1:b_size)) - do i = 1, b_size + @:ALLOCATE(btensor%vf(1:eqn_idx%b_size)) + do i = 1, eqn_idx%b_size @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) end do @:ACC_SETUP_VFs(btensor) @@ -96,10 +96,10 @@ contains !! btensor is symmetric, save the data space subroutine s_hyperelastic_rmt_stress_update(q_cons_vf, q_prim_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf - real(wp), dimension(tensor_size) :: tensora, tensorb + real(wp), dimension(eqn_idx%tensor_size) :: tensora, tensorb real(wp), dimension(num_fluids) :: alpha_k, alpha_rho_k real(wp), dimension(2) :: Re real(wp) :: rho, gamma, pi_inf, qv @@ -125,7 +125,7 @@ contains if (G > verysmall) then !$acc loop seq - do i = 1, tensor_size + do i = 1, eqn_idx%tensor_size tensora(i) = 0_wp end do ! STEP 1: computing the grad_xi tensor using finite differences @@ -160,20 +160,20 @@ contains tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + tensorb(eqn_idx%tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - if (tensorb(tensor_size) > verysmall) then + if (tensorb(eqn_idx%tensor_size) > verysmall) then ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes F !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) + do i = 1, eqn_idx%tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(eqn_idx%tensor_size) end do ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1_wp/tensorb(tensor_size) + tensorb(eqn_idx%tensor_size) = 1_wp/tensorb(eqn_idx%tensor_size) ! STEP 3: computing F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 @@ -187,7 +187,7 @@ contains btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) #:endfor ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + btensor%vf(eqn_idx%b_size)%sf(j, k, l) = tensorb(eqn_idx%tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field if (hyper_model == 1) then call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) @@ -195,11 +195,11 @@ contains call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, 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) - & + q_prim_vf(eqn_idx%E)%sf(j, k, l) = q_prim_vf(eqn_idx%E)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field !$acc loop seq - do i = 1, b_size - 1 + do i = 1, eqn_idx%b_size - 1 q_cons_vf(strxb + i - 1)%sf(j, k, l) = & rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) end do @@ -221,8 +221,8 @@ contains !! btensor is symmetric, save the data space pure subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%b_size), intent(inout) :: btensor real(wp), intent(in) :: G integer, intent(in) :: j, k, l @@ -240,13 +240,13 @@ contains ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq - do i = 1, b_size - 1 + do i = 1, eqn_idx%b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + G*btensor(i)%sf(j, k, l)/btensor(eqn_idx%b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) + 0.5_wp*(trace - 3.0_wp)/btensor(eqn_idx%b_size)%sf(j, k, l) end subroutine s_neoHookean_cauchy_solver @@ -260,8 +260,8 @@ contains !! btensor is symmetric, save the data space pure subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%b_size), intent(inout) :: btensor real(wp), intent(in) :: G integer, intent(in) :: j, k, l @@ -281,13 +281,13 @@ contains ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq - do i = 1, b_size - 1 + do i = 1, eqn_idx%b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + G*btensor(i)%sf(j, k, l)/btensor(eqn_idx%b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) + 0.5_wp*(trace - 3.0_wp)/btensor(eqn_idx%b_size)%sf(j, k, l) end subroutine s_Mooney_Rivlin_cauchy_solver @@ -296,7 +296,7 @@ contains integer :: i !< iterator ! Deallocating memory - do i = 1, b_size + do i = 1, eqn_idx%b_size @:DEALLOCATE(btensor%vf(i)%sf) end do @:DEALLOCATE(fd_coeff_x) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 177e2d261d..7c88f643a8 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -90,8 +90,8 @@ contains subroutine s_compute_hypoelastic_rhs(idir, q_prim_vf, rhs_vf) integer, intent(in) :: idir - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf real(wp) :: rho_K, G_K @@ -206,7 +206,7 @@ contains G_K = G_K + q_prim_vf(advxb - 1 + i)%sf(k, l, q)*Gs(i) !alpha_K(1) * Gs(1) end do - if (cont_damage) G_K = G_K*max((1._wp - q_prim_vf(damage_idx)%sf(k, l, q)), 0._wp) + if (cont_damage) G_K = G_K*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(k, l, q)), 0._wp) rho_K_field(k, l, q) = rho_K G_K_field(k, l, q) = G_K @@ -389,8 +389,8 @@ contains pure subroutine s_compute_damage_state(q_cons_vf, rhs_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf real(wp) :: tau_p ! principal stress real(wp) :: tau_xx, tau_xy, tau_yy, tau_zz, tau_yz, tau_xz @@ -401,7 +401,7 @@ contains l = 0; q = 0 !$acc parallel loop gang vector default(present) do k = 0, m - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(abs(q_cons_vf(stress_idx%beg)%sf(k, l, q)) - tau_star, 0._wp))**cont_damage_s + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(abs(q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q)) - tau_star, 0._wp))**cont_damage_s end do elseif (p == 0) then q = 0 @@ -409,13 +409,13 @@ contains do l = 0, n do k = 0, m ! Maximum principal stress - tau_p = 0.5_wp*(q_cons_vf(stress_idx%beg)%sf(k, l, q) + & - q_cons_vf(stress_idx%beg + 2)%sf(k, l, q)) + & - sqrt((q_cons_vf(stress_idx%beg)%sf(k, l, q) - & - q_cons_vf(stress_idx%beg + 2)%sf(k, l, q))**2.0_wp + & - 4._wp*q_cons_vf(stress_idx%beg + 1)%sf(k, l, q)**2.0_wp)/2._wp + tau_p = 0.5_wp*(q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q) + & + q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, q)) + & + sqrt((q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q) - & + q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, q))**2.0_wp + & + 4._wp*q_cons_vf(eqn_idx%stress%beg + 1)%sf(k, l, q)**2.0_wp)/2._wp - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s end do end do else @@ -423,12 +423,12 @@ contains do q = 0, p do l = 0, n do k = 0, m - tau_xx = q_cons_vf(stress_idx%beg)%sf(k, l, q) - tau_xy = q_cons_vf(stress_idx%beg + 1)%sf(k, l, q) - tau_yy = q_cons_vf(stress_idx%beg + 2)%sf(k, l, q) - tau_xz = q_cons_vf(stress_idx%beg + 3)%sf(k, l, q) - tau_yz = q_cons_vf(stress_idx%beg + 4)%sf(k, l, q) - tau_zz = q_cons_vf(stress_idx%beg + 5)%sf(k, l, q) + tau_xx = q_cons_vf(eqn_idx%stress%beg)%sf(k, l, q) + tau_xy = q_cons_vf(eqn_idx%stress%beg + 1)%sf(k, l, q) + tau_yy = q_cons_vf(eqn_idx%stress%beg + 2)%sf(k, l, q) + tau_xz = q_cons_vf(eqn_idx%stress%beg + 3)%sf(k, l, q) + tau_yz = q_cons_vf(eqn_idx%stress%beg + 4)%sf(k, l, q) + tau_zz = q_cons_vf(eqn_idx%stress%beg + 5)%sf(k, l, q) ! Invariants of the stress tensor I1 = tau_xx + tau_yy + tau_zz @@ -452,7 +452,7 @@ contains tau_p = I1/3.0_wp end if - rhs_vf(damage_idx)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s + rhs_vf(eqn_idx%damage)%sf(k, l, q) = (alpha_bar*max(tau_p - tau_star, 0._wp))**cont_damage_s end do end do end do diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index c7c96890aa..578b3b7214 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -95,6 +95,35 @@ contains @:ALLOCATE(ghost_points(1:num_gps)) @:ALLOCATE(inner_points(1:num_inner_gps)) + ! Initialize the ip component of each ghost point + do i = 1, num_gps + allocate(ghost_points(i)%ip%alpha_rho(num_fluids)) + allocate(ghost_points(i)%ip%alpha(num_fluids)) + ghost_points(i)%ip%vel = 0.0_wp + ghost_points(i)%ip%pressure = 0.0_wp + + if (surface_tension) then + ghost_points(i)%ip%c = 0.0_wp + end if + + if (bubbles_euler) then + allocate(ghost_points(i)%ip%r(nb)) + allocate(ghost_points(i)%ip%v(nb)) + if (.not. polytropic) then + allocate(ghost_points(i)%ip%pb(nb)) + allocate(ghost_points(i)%ip%mv(nb)) + end if + end if + + if (qbmm) then + allocate(ghost_points(i)%ip%nmom(nb*nmom)) + if (.not. polytropic) then + allocate(ghost_points(i)%ip%presb(nb*nnode)) + allocate(ghost_points(i)%ip%massv(nb*nnode)) + end if + end if + end do + !$acc enter data copyin(ghost_points, inner_points) call s_find_ghost_points(ghost_points, inner_points) @@ -116,11 +145,11 @@ contains pure subroutine s_ibm_correct_state(q_cons_vf, q_prim_vf, pb, mv) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(INOUT) :: q_cons_vf !< Primitive Variables type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(INOUT) :: q_prim_vf !< Primitive Variables real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), optional, intent(INOUT) :: pb, mv @@ -133,13 +162,11 @@ contains real(wp) :: qv_K real(wp), dimension(num_fluids) :: Gs - real(wp) :: pres_IP, coeff - real(wp), dimension(3) :: vel_IP, vel_norm_IP - real(wp) :: c_IP - real(wp), dimension(num_fluids) :: alpha_rho_IP, alpha_IP - real(wp), dimension(nb) :: r_IP, v_IP, pb_IP, mv_IP - real(wp), dimension(nb*nmom) :: nmom_IP - real(wp), dimension(nb*nnode) :: presb_IP, massv_IP + real(wp) :: coeff + real(wp) :: nbub + real(wp) :: buf + type(ghost_point) :: gp + type(ghost_point) :: innerp !! Primitive variables at the image point associated with a ghost point, !! interpolated from surrounding fluid cells. @@ -147,19 +174,14 @@ contains real(wp), dimension(3) :: physical_loc !< Physical loc of GP real(wp), dimension(3) :: vel_g !< Velocity of GP - real(wp) :: nbub - real(wp) :: buf - type(ghost_point) :: gp - type(ghost_point) :: innerp - - !$acc parallel loop gang vector private(physical_loc, dyn_pres, alpha_rho_IP, alpha_IP, pres_IP, vel_IP, vel_g, vel_norm_IP, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, presb_IP, massv_IP, rho, gamma, pi_inf, Re_K, G_K, Gs, gp, innerp, norm, buf, j, k, l, q, coeff) + !$acc parallel loop gang vector private(physical_loc, dyn_pres, rho, gamma, pi_inf, Re_K, G_K, Gs, gp, innerp, norm, buf, j, k, l, q, nbub) do i = 1, num_gps gp = ghost_points(i) j = gp%loc(1) k = gp%loc(2) l = gp%loc(3) - patch_id = ghost_points(i)%ib_patch_id + patch_id = gp%ib_patch_id ! Calculate physical location of GP if (p > 0) then @@ -170,20 +192,13 @@ contains !Interpolate primitive variables at image point associated w/ GP if (bubbles_euler .and. .not. qbmm) then - call s_interpolate_image_point(q_prim_vf, gp, & - alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, & - r_IP, v_IP, pb_IP, mv_IP) + call s_interpolate_image_point(q_prim_vf, gp) else if (qbmm .and. polytropic) then - call s_interpolate_image_point(q_prim_vf, gp, & - alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, & - r_IP, v_IP, pb_IP, mv_IP, nmom_IP) + call s_interpolate_image_point(q_prim_vf, gp) else if (qbmm .and. .not. polytropic) then - call s_interpolate_image_point(q_prim_vf, gp, & - alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, & - r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP) + call s_interpolate_image_point(q_prim_vf, gp, pb, mv) else - call s_interpolate_image_point(q_prim_vf, gp, & - alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP) + call s_interpolate_image_point(q_prim_vf, gp) end if dyn_pres = 0._wp @@ -191,25 +206,25 @@ contains ! Set q_prim_vf params at GP so that mixture vars calculated properly !$acc loop 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(q)%sf(j, k, l) = gp%ip%alpha_rho(q) + q_prim_vf(advxb + q - 1)%sf(j, k, l) = gp%ip%alpha(q) end do if (surface_tension) then - q_prim_vf(c_idx)%sf(j, k, l) = c_IP + q_prim_vf(eqn_idx%c)%sf(j, k, l) = gp%ip%c end if if (model_eqns /= 4) then ! If in simulation, use acc mixture subroutines if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K, G_K, Gs) + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, & + gp%ip%alpha, gp%ip%alpha_rho, Re_K, G_K, Gs) else if (bubbles_euler) then - call s_convert_species_to_mixture_variables_bubbles_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K) + call s_convert_species_to_mixture_variables_bubbles_acc(rho, gamma, pi_inf, qv_K, & + gp%ip%alpha, gp%ip%alpha_rho, Re_K) else - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K) + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, & + gp%ip%alpha, gp%ip%alpha_rho, Re_K) end if end if @@ -218,8 +233,7 @@ contains norm(1:3) = levelset_norm%sf(gp%loc(1), gp%loc(2), gp%loc(3), gp%ib_patch_id, 1:3) buf = sqrt(sum(norm**2)) norm = norm/buf - vel_norm_IP = sum(vel_IP*norm)*norm - vel_g = vel_IP - vel_norm_IP + vel_g = gp%ip%vel - sum(gp%ip%vel*norm)*norm else vel_g = 0._wp end if @@ -235,42 +249,42 @@ contains ! Set continuity and adv vars !$acc loop 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(q)%sf(j, k, l) = gp%ip%alpha_rho(q) + q_cons_vf(advxb + q - 1)%sf(j, k, l) = gp%ip%alpha(q) end do ! Set color function if (surface_tension) then - q_cons_vf(c_idx)%sf(j, k, l) = c_IP + q_cons_vf(eqn_idx%c)%sf(j, k, l) = gp%ip%c 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 - gp%ip%alpha(1))*(gamma*gp%ip%pressure + 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*gp%ip%pressure + pi_inf + dyn_pres end if ! Set bubble vars if (bubbles_euler .and. .not. qbmm) then - call s_comp_n_from_prim(alpha_IP(1), r_IP, nbub, weight) + call s_comp_n_from_prim(gp%ip%alpha(1), gp%ip%r, nbub, weight) 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) - 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) + if (polytropic) then + q_cons_vf(bubxb + (q - 1)*2)%sf(j, k, l) = nbub*gp%ip%r(q) + q_cons_vf(bubxb + (q - 1)*2 + 1)%sf(j, k, l) = nbub*gp%ip%v(q) + else + q_cons_vf(bubxb + (q - 1)*4)%sf(j, k, l) = nbub*gp%ip%r(q) + q_cons_vf(bubxb + (q - 1)*4 + 1)%sf(j, k, l) = nbub*gp%ip%v(q) + q_cons_vf(bubxb + (q - 1)*4 + 2)%sf(j, k, l) = nbub*gp%ip%pb(q) + q_cons_vf(bubxb + (q - 1)*4 + 3)%sf(j, k, l) = nbub*gp%ip%mv(q) end if end do end if if (qbmm) then - - nbub = nmom_IP(1) + nbub = gp%ip%nmom(1) do q = 1, nb*nmom - q_cons_vf(bubxb + q - 1)%sf(j, k, l) = nbub*nmom_IP(q) + q_cons_vf(bubxb + q - 1)%sf(j, k, l) = nbub*gp%ip%nmom(q) end do do q = 1, nb q_cons_vf(bubxb + (q - 1)*nmom)%sf(j, k, l) = nbub @@ -279,8 +293,8 @@ contains if (.not. polytropic) then do q = 1, nb do r = 1, nnode - pb(j, k, l, r, q) = presb_IP((q - 1)*nnode + r) - mv(j, k, l, r, q) = massv_IP((q - 1)*nnode + r) + pb(j, k, l, r, q) = gp%ip%presb((q - 1)*nnode + r) + mv(j, k, l, r, q) = gp%ip%massv((q - 1)*nnode + r) end do end do end if @@ -289,14 +303,14 @@ contains if (model_eqns == 3) then !$acc loop 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)) + q_cons_vf(q)%sf(j, k, l) = gp%ip%alpha(q - intxb + 1)*(gammas(q - intxb + 1)*gp%ip%pressure & + + pi_infs(q - intxb + 1)) end do end if end do !Correct the state of the inner points in IBs - !$acc parallel loop gang vector private(physical_loc, dyn_pres, alpha_rho_IP, alpha_IP, vel_g, rho, gamma, pi_inf, Re_K, innerp, j, k, l, q) + !$acc parallel loop gang vector private(physical_loc, dyn_pres, rho, gamma, pi_inf, Re_K, G_K, Gs, gp, innerp, norm, buf, j, k, l, q, nbub) do i = 1, num_inner_gps vel_g = 0._wp @@ -315,16 +329,16 @@ contains !$acc loop 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(q)%sf(j, k, l) = gp%ip%alpha_rho(q) + q_prim_vf(advxb + q - 1)%sf(j, k, l) = gp%ip%alpha(q) end do if (surface_tension) then - q_prim_vf(c_idx)%sf(j, k, l) = c_IP + q_prim_vf(eqn_idx%c)%sf(j, k, l) = gp%ip%c end if - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K) + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, gp%ip%alpha, & + gp%ip%alpha_rho, Re_K, G_K, Gs) dyn_pres = 0._wp @@ -743,22 +757,15 @@ contains !> Function that uses the interpolation coefficients and the current state !! at the cell centers in order to estimate the state at the image point - pure subroutine s_interpolate_image_point(q_prim_vf, gp, alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP) + pure subroutine s_interpolate_image_point(q_prim_vf, gp, pb, mv) !$acc routine seq type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(IN) :: q_prim_vf !< Primitive Variables real(wp), optional, dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(INOUT) :: pb, mv - type(ghost_point), intent(IN) :: gp - real(wp), intent(INOUT) :: pres_IP - real(wp), dimension(3), intent(INOUT) :: vel_IP - real(wp), intent(INOUT) :: c_IP - real(wp), dimension(num_fluids), intent(INOUT) :: alpha_IP, alpha_rho_IP - real(wp), optional, dimension(:), intent(INOUT) :: r_IP, v_IP, pb_IP, mv_IP - real(wp), optional, dimension(:), intent(INOUT) :: nmom_IP - real(wp), optional, dimension(:), intent(INOUT) :: presb_IP, massv_IP + type(ghost_point), intent(INOUT) :: gp integer :: i, j, k, l, q !< Iterator variables integer :: i1, i2, j1, j2, k1, k2 !< Iterator variables @@ -773,27 +780,27 @@ contains k2 = 0 end if - alpha_rho_IP = 0._wp - alpha_IP = 0._wp - pres_IP = 0._wp - vel_IP = 0._wp + gp%ip%alpha_rho = 0._wp + gp%ip%alpha = 0._wp + gp%ip%pressure = 0._wp + gp%ip%vel = 0._wp - if (surface_tension) c_IP = 0._wp + if (surface_tension) gp%ip%c = 0._wp if (bubbles_euler) then - r_IP = 0._wp - v_IP = 0._wp + gp%ip%r = 0._wp + gp%ip%v = 0._wp if (.not. polytropic) then - mv_IP = 0._wp - pb_IP = 0._wp + gp%ip%pb = 0._wp + gp%ip%mv = 0._wp end if end if if (qbmm) then - nmom_IP = 0._wp + gp%ip%nmom = 0._wp if (.not. polytropic) then - presb_IP = 0._wp - massv_IP = 0._wp + gp%ip%presb = 0._wp + gp%ip%massv = 0._wp end if end if @@ -806,57 +813,57 @@ contains 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) + gp%ip%pressure = gp%ip%pressure + coeff* & + q_prim_vf(eqn_idx%E)%sf(i, j, k) !$acc loop seq do q = momxb, momxe - vel_IP(q + 1 - momxb) = vel_IP(q + 1 - momxb) + coeff* & - q_prim_vf(q)%sf(i, j, k) + gp%ip%vel(q + 1 - momxb) = gp%ip%vel(q + 1 - momxb) + coeff* & + q_prim_vf(q)%sf(i, j, k) end do !$acc loop seq do l = contxb, contxe - 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) + gp%ip%alpha_rho(l) = gp%ip%alpha_rho(l) + coeff* & + q_prim_vf(l)%sf(i, j, k) + gp%ip%alpha(l) = gp%ip%alpha(l) + coeff* & + q_prim_vf(advxb + l - 1)%sf(i, j, k) end do if (surface_tension) then - c_IP = c_IP + coeff*q_prim_vf(c_idx)%sf(i, j, k) + gp%ip%c = gp%ip%c + coeff*q_prim_vf(eqn_idx%c)%sf(i, j, k) end if if (bubbles_euler .and. .not. qbmm) then !$acc loop 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) + gp%ip%r(l) = gp%ip%r(l) + coeff*q_prim_vf(bubxb + (l - 1)*2)%sf(i, j, k) + gp%ip%v(l) = gp%ip%v(l) + coeff*q_prim_vf(bubxb + 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) + gp%ip%r(l) = gp%ip%r(l) + coeff*q_prim_vf(bubxb + (l - 1)*4)%sf(i, j, k) + gp%ip%v(l) = gp%ip%v(l) + coeff*q_prim_vf(bubxb + 1 + (l - 1)*4)%sf(i, j, k) + gp%ip%pb(l) = gp%ip%pb(l) + coeff*q_prim_vf(bubxb + 2 + (l - 1)*4)%sf(i, j, k) + gp%ip%mv(l) = gp%ip%mv(l) + coeff*q_prim_vf(bubxb + 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) + gp%ip%nmom(l) = gp%ip%nmom(l) + coeff*q_prim_vf(bubxb - 1 + l)%sf(i, j, k) end do if (.not. polytropic) then do q = 1, nb do l = 1, nnode - presb_IP((q - 1)*nnode + l) = presb_IP((q - 1)*nnode + l) + coeff*pb(i, j, k, l, q) - massv_IP((q - 1)*nnode + l) = massv_IP((q - 1)*nnode + l) + coeff*mv(i, j, k, l, q) + gp%ip%presb((q - 1)*nnode + l) = gp%ip%presb((q - 1)*nnode + l) + & + coeff*pb(i, j, k, l, q) + gp%ip%massv((q - 1)*nnode + l) = gp%ip%massv((q - 1)*nnode + l) + & + coeff*mv(i, j, k, l, q) end do end do end if - end if - end do end do end do @@ -866,9 +873,12 @@ contains !> Subroutine to deallocate memory reserved for the IBM module impure subroutine s_finalize_ibm_module() + if (allocated(ghost_points)) deallocate(ghost_points) + @:DEALLOCATE(ib_markers%sf) @:DEALLOCATE(levelset%sf) @:DEALLOCATE(levelset_norm%sf) + @:DEALLOCATE(inner_points) end subroutine s_finalize_ibm_module diff --git a/src/simulation/m_mhd.fpp b/src/simulation/m_mhd.fpp index f5730b513f..5185540dbd 100644 --- a/src/simulation/m_mhd.fpp +++ b/src/simulation/m_mhd.fpp @@ -69,8 +69,8 @@ contains !! @param rhs_vf rhs variables pure subroutine s_compute_mhd_powell_rhs(q_prim_vf, rhs_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf integer :: k, l, q, r real(wp), dimension(3) :: v, B @@ -85,16 +85,16 @@ contains divB = 0._wp !$acc loop seq do r = -fd_number, fd_number - divB = divB + q_prim_vf(B_idx%beg)%sf(k + r, l, q)*fd_coeff_x_h(r, k) + divB = divB + q_prim_vf(eqn_idx%B%beg)%sf(k + r, l, q)*fd_coeff_x_h(r, k) end do !$acc loop seq do r = -fd_number, fd_number - divB = divB + q_prim_vf(B_idx%beg + 1)%sf(k, l + r, q)*fd_coeff_y_h(r, l) + divB = divB + q_prim_vf(eqn_idx%B%beg + 1)%sf(k, l + r, q)*fd_coeff_y_h(r, l) end do if (p > 0) then !$acc loop seq do r = -fd_number, fd_number - divB = divB + q_prim_vf(B_idx%beg + 2)%sf(k, l, q + r)*fd_coeff_z_h(r, q) + divB = divB + q_prim_vf(eqn_idx%B%beg + 2)%sf(k, l, q + r)*fd_coeff_z_h(r, q) end do end if @@ -102,9 +102,9 @@ contains v(2) = q_prim_vf(momxb + 1)%sf(k, l, q) v(3) = q_prim_vf(momxb + 2)%sf(k, l, q) - B(1) = q_prim_vf(B_idx%beg)%sf(k, l, q) - B(2) = q_prim_vf(B_idx%beg + 1)%sf(k, l, q) - B(3) = q_prim_vf(B_idx%beg + 2)%sf(k, l, q) + B(1) = q_prim_vf(eqn_idx%B%beg)%sf(k, l, q) + B(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(k, l, q) + B(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(k, l, q) vdotB = sum(v*B) @@ -121,11 +121,11 @@ contains rhs_vf(momxb + 1)%sf(k, l, q) = rhs_vf(momxb + 1)%sf(k, l, q) - divB*B(2) rhs_vf(momxb + 2)%sf(k, l, q) = rhs_vf(momxb + 2)%sf(k, l, q) - divB*B(3) - rhs_vf(E_idx)%sf(k, l, q) = rhs_vf(E_idx)%sf(k, l, q) - divB*vdotB + rhs_vf(eqn_idx%E)%sf(k, l, q) = rhs_vf(eqn_idx%E)%sf(k, l, q) - divB*vdotB - rhs_vf(B_idx%beg)%sf(k, l, q) = rhs_vf(B_idx%beg)%sf(k, l, q) - divB*v(1) - rhs_vf(B_idx%beg + 1)%sf(k, l, q) = rhs_vf(B_idx%beg + 1)%sf(k, l, q) - divB*v(2) - rhs_vf(B_idx%beg + 2)%sf(k, l, q) = rhs_vf(B_idx%beg + 2)%sf(k, l, q) - divB*v(3) + rhs_vf(eqn_idx%B%beg)%sf(k, l, q) = rhs_vf(eqn_idx%B%beg)%sf(k, l, q) - divB*v(1) + rhs_vf(eqn_idx%B%beg + 1)%sf(k, l, q) = rhs_vf(eqn_idx%B%beg + 1)%sf(k, l, q) - divB*v(2) + rhs_vf(eqn_idx%B%beg + 2)%sf(k, l, q) = rhs_vf(eqn_idx%B%beg + 2)%sf(k, l, q) - divB*v(3) end do end do diff --git a/src/simulation/m_pressure_relaxation.fpp b/src/simulation/m_pressure_relaxation.fpp index 8aa78ad88a..1207180c24 100644 --- a/src/simulation/m_pressure_relaxation.fpp +++ b/src/simulation/m_pressure_relaxation.fpp @@ -42,13 +42,13 @@ contains !$acc update device(gamma_min, pres_inf) if (viscous) then - @:ALLOCATE(Res(1:2, 1:maxval(Re_size))) + @:ALLOCATE(Res(1:2, 1:maxval(eqn_idx%Re_size))) do i = 1, 2 - do j = 1, Re_size(i) - Res(i, j) = fluid_pp(Re_idx(i, j))%Re(i) + do j = 1, eqn_idx%Re_size(i) + Res(i, j) = fluid_pp(eqn_idx%Re(i, j))%Re(i) end do end do - !$acc update device(Res, Re_idx, Re_size) + !$acc update device(Res, eqn_idx%Re, eqn_idx%Re_size) end if end subroutine s_initialize_pressure_relaxation_module @@ -67,7 +67,7 @@ contains !! @param q_cons_vf Cell-average conservative variables pure subroutine s_pressure_relaxation_procedure(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer :: j, k, l !$acc parallel loop collapse(3) gang vector default(present) @@ -85,7 +85,7 @@ contains pure subroutine s_relax_cell_pressure(q_cons_vf, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer, intent(in) :: j, k, l ! Volume fraction correction @@ -105,7 +105,7 @@ contains pure logical function s_needs_pressure_relaxation(q_cons_vf, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf integer, intent(in) :: j, k, l integer :: i @@ -123,7 +123,7 @@ contains pure subroutine s_correct_volume_fractions(q_cons_vf, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer, intent(in) :: j, k, l real(wp) :: sum_alpha integer :: i @@ -153,7 +153,7 @@ contains pure subroutine s_equilibrate_pressure(q_cons_vf, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer, intent(in) :: j, k, l real(wp) :: pres_relax, f_pres, df_pres @@ -222,7 +222,7 @@ contains pure subroutine s_correct_internal_energies(q_cons_vf, j, k, l) !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf integer, intent(in) :: j, k, l real(wp), dimension(num_fluids) :: alpha_rho, alpha @@ -233,7 +233,7 @@ contains !$acc loop 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) @@ -284,10 +284,10 @@ contains !$acc loop seq do i = 1, 2 Re(i) = dflt_real - if (Re_size(i) > 0) Re(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re(i) = alpha(Re_idx(i, q))/Res(i, q) + Re(i) + do q = 1, eqn_idx%Re_size(i) + Re(i) = alpha(eqn_idx%Re(i, q))/Res(i, q) + Re(i) end do Re(i) = 1._wp/max(Re(i), sgm_eps) end do @@ -302,7 +302,7 @@ contains 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 !$acc loop seq do i = 1, num_fluids diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 5b37fa244c..e926bfe471 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -398,13 +398,13 @@ contains @:ALLOCATE(bubmoms(1:nb, 1:nmom)) do i = 1, nb - bubrs(i) = bub_idx%rs(i) + bubrs(i) = eqn_idx%bub%rs(i) end do !$acc update device(bubrs) do j = 1, nmom do i = 1, nb - bubmoms(i, j) = bub_idx%moms(i, j) + bubmoms(i, j) = eqn_idx%bub%moms(i, j) end do end do !$acc update device(bubmoms) @@ -414,9 +414,9 @@ contains pure subroutine s_compute_qbmm_rhs(idir, q_cons_vf, q_prim_vf, rhs_vf, flux_n_vf, pb, rhs_pb) integer, intent(in) :: idir - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf, q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf - type(scalar_field), dimension(sys_size), intent(in) :: flux_n_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_cons_vf, q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: flux_n_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, rhs_pb integer :: i, j, k, l, q @@ -542,7 +542,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 !$acc loop seq do k = 1, nb @@ -722,8 +722,8 @@ contains 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 44aa3e604f..fef75b36f9 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -176,26 +176,26 @@ contains !$acc enter data copyin(idwbuff, idwbuff) !$acc update device(idwbuff, idwbuff) - @:ALLOCATE(q_cons_qp%vf(1:sys_size)) - @:ALLOCATE(q_prim_qp%vf(1:sys_size)) + @:ALLOCATE(q_cons_qp%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(q_prim_qp%vf(1:eqn_idx%sys_size)) - do l = 1, sys_size + do l = 1, eqn_idx%sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end)) end do - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end)) end do num_eqns_after_adv = count((/surface_tension, cont_damage/)) - do l = adv_idx%end + 1, sys_size - num_eqns_after_adv + do l = eqn_idx%adv%end + 1, eqn_idx%sys_size - num_eqns_after_adv @: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 @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - do l = 1, cont_idx%end + do l = 1, eqn_idx%cont%end if (relativity) then ! Cons and Prim densities are different for relativity @:ALLOCATE(q_prim_qp%vf(l)%sf(idwbuff(1)%beg:idwbuff(1)%end, idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end)) @@ -206,38 +206,38 @@ contains end if end do - do l = adv_idx%beg, adv_idx%end + do l = eqn_idx%adv%beg, eqn_idx%adv%end q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf !$acc enter data copyin(q_prim_qp%vf(l)%sf) !$acc enter data attach(q_prim_qp%vf(l)%sf) end do if (surface_tension) then - q_prim_qp%vf(c_idx)%sf => & - q_cons_qp%vf(c_idx)%sf - !$acc enter data copyin(q_prim_qp%vf(c_idx)%sf) - !$acc 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 + !$acc enter data copyin(q_prim_qp%vf(eqn_idx%c)%sf) + !$acc enter data attach(q_prim_qp%vf(eqn_idx%c)%sf) end if if (cont_damage) then - q_prim_qp%vf(damage_idx)%sf => & - q_cons_qp%vf(damage_idx)%sf - !$acc enter data copyin(q_prim_qp%vf(damage_idx)%sf) - !$acc enter data attach(q_prim_qp%vf(damage_idx)%sf) + q_prim_qp%vf(eqn_idx%damage)%sf => & + q_cons_qp%vf(eqn_idx%damage)%sf + !$acc enter data copyin(q_prim_qp%vf(eqn_idx%damage)%sf) + !$acc enter data attach(q_prim_qp%vf(eqn_idx%damage)%sf) end if if (viscous) then - @:ALLOCATE(tau_Re_vf(1:sys_size)) + @:ALLOCATE(tau_Re_vf(1:eqn_idx%sys_size)) do i = 1, num_dims - @:ALLOCATE(tau_Re_vf(cont_idx%end + i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + @:ALLOCATE(tau_Re_vf(eqn_idx%cont%end + i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(tau_Re_vf(cont_idx%end + i)) + @:ACC_SETUP_SFs(tau_Re_vf(eqn_idx%cont%end + i)) end do - @:ALLOCATE(tau_Re_vf(E_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + @: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)) end if if (qbmm) then @@ -269,9 +269,9 @@ contains @:ALLOCATE(qR_prim(1:num_dims)) 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 + @:ALLOCATE(qL_prim(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(qR_prim(i)%vf(1:eqn_idx%sys_size)) + 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, idwbuff(3)%beg:idwbuff(3)%end)) end do @@ -284,33 +284,33 @@ contains ! END: Allocation/Association of qK_cons_n and qK_prim_n @:ALLOCATE(qL_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) @:ALLOCATE(qR_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) if (n > 0) then @:ALLOCATE(qL_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, & - idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) @:ALLOCATE(qR_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, & - idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) else @:ALLOCATE(qL_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) @:ALLOCATE(qR_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) end if if (p > 0) then @:ALLOCATE(qL_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, 1:eqn_idx%sys_size)) @:ALLOCATE(qR_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, 1:eqn_idx%sys_size)) else @:ALLOCATE(qL_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) @:ALLOCATE(qR_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:sys_size)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, 1:eqn_idx%sys_size)) end if @@ -321,11 +321,11 @@ contains @:ALLOCATE(dq_prim_dz_qp(1:1)) if (viscous) then - @: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)) + @:ALLOCATE(dq_prim_dx_qp(1)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dq_prim_dy_qp(1)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dq_prim_dz_qp(1)%vf(1:eqn_idx%sys_size)) - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -336,7 +336,7 @@ contains if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -347,7 +347,7 @@ contains if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -359,9 +359,9 @@ contains end if else - @: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)) + @:ALLOCATE(dq_prim_dx_qp(1)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dq_prim_dy_qp(1)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dq_prim_dz_qp(1)%vf(1:eqn_idx%sys_size)) do l = momxb, momxe @:ALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf(0, 0, 0)) @@ -388,14 +388,14 @@ contains if (viscous) then do i = 1, num_dims - @:ALLOCATE(dqL_prim_dx_n(i)%vf(1:sys_size)) - @:ALLOCATE(dqL_prim_dy_n(i)%vf(1:sys_size)) - @:ALLOCATE(dqL_prim_dz_n(i)%vf(1:sys_size)) - @:ALLOCATE(dqR_prim_dx_n(i)%vf(1:sys_size)) - @:ALLOCATE(dqR_prim_dy_n(i)%vf(1:sys_size)) - @:ALLOCATE(dqR_prim_dz_n(i)%vf(1:sys_size)) - - do l = mom_idx%beg, mom_idx%end + @:ALLOCATE(dqL_prim_dx_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dqL_prim_dy_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dqL_prim_dz_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dqR_prim_dx_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dqR_prim_dy_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(dqR_prim_dz_n(i)%vf(1:eqn_idx%sys_size)) + + 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, & @@ -407,7 +407,7 @@ contains end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -420,7 +420,7 @@ contains end if if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:ALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -441,34 +441,34 @@ contains if (viscous) then 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(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsx_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) if (n > 0) then @:ALLOCATE(dqL_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, & - idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsy_vf(idwbuff(2)%beg:idwbuff(2)%end, & - idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(1)%beg:idwbuff(1)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) else @:ALLOCATE(dqL_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsy_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) end if if (p > 0) then @:ALLOCATE(dqL_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsz_vf(idwbuff(3)%beg:idwbuff(3)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(1)%beg:idwbuff(1)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) else @:ALLOCATE(dqL_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) @:ALLOCATE(dqR_rsz_vf(idwbuff(1)%beg:idwbuff(1)%end, & - idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, mom_idx%beg:mom_idx%end)) + idwbuff(2)%beg:idwbuff(2)%end, idwbuff(3)%beg:idwbuff(3)%end, eqn_idx%mom%beg:eqn_idx%mom%end)) end if end if @@ -485,12 +485,12 @@ contains do i = 1, num_dims - @:ALLOCATE(flux_n(i)%vf(1:sys_size)) - @:ALLOCATE(flux_src_n(i)%vf(1:sys_size)) - @:ALLOCATE(flux_gsrc_n(i)%vf(1:sys_size)) + @:ALLOCATE(flux_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(flux_src_n(i)%vf(1:eqn_idx%sys_size)) + @:ALLOCATE(flux_gsrc_n(i)%vf(1:eqn_idx%sys_size)) if (i == 1) then - do l = 1, sys_size + do l = 1, eqn_idx%sys_size @:ALLOCATE(flux_n(i)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -502,7 +502,7 @@ contains end do if (viscous .or. surface_tension) then - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:ALLOCATE(flux_src_n(i)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -510,13 +510,13 @@ contains end do end if - @:ALLOCATE(flux_src_n(i)%vf(adv_idx%beg)%sf( & + @:ALLOCATE(flux_src_n(i)%vf(eqn_idx%adv%beg)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & & idwbuff(3)%beg:idwbuff(3)%end)) if (riemann_solver == 1 .or. riemann_solver == 4) then - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end @:ALLOCATE(flux_src_n(i)%vf(l)%sf( & & idwbuff(1)%beg:idwbuff(1)%end, & & idwbuff(2)%beg:idwbuff(2)%end, & @@ -534,7 +534,7 @@ contains end if else - do l = 1, sys_size + do l = 1, eqn_idx%sys_size @:ALLOCATE(flux_gsrc_n(i)%vf(l)%sf( & idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & @@ -546,13 +546,13 @@ contains if (i == 1) then if (riemann_solver /= 1 .and. riemann_solver /= 4) then - do l = adv_idx%beg + 1, adv_idx%end - flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end + flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(eqn_idx%adv%beg)%sf !$acc enter data attach(flux_src_n(i)%vf(l)%sf) end do end if else - do l = 1, sys_size + do l = 1, eqn_idx%sys_size flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) @@ -566,11 +566,30 @@ contains @:ALLOCATE(blkmod1(0:m, 0:n, 0:p), blkmod2(0:m, 0:n, 0:p), alpha1(0:m, 0:n, 0:p), alpha2(0:m, 0:n, 0:p), Kterm(0:m, 0:n, 0:p)) end if - call s_initialize_pressure_relaxation_module + @:ALLOCATE(gamma_min(1:num_fluids), pres_inf(1:num_fluids)) + + do i = 1, num_fluids + gamma_min(i) = 1._wp/fluid_pp(i)%gamma + 1._wp + pres_inf(i) = fluid_pp(i)%pi_inf/(1._wp + fluid_pp(i)%gamma) + end do + !$acc update device(gamma_min, pres_inf) + + if (viscous) then + @:ALLOCATE(Res(1:2, 1:maxval(eqn_idx%Re_size))) + end if + + if (viscous) then + do i = 1, 2 + do j = 1, eqn_idx%Re_size(i) + Res(i, j) = fluid_pp(eqn_idx%Re(i, j))%Re(i) + end do + end do + !$acc update device(Res, eqn_idx%Re, eqn_idx%Re_size) + end if !$acc parallel loop collapse(4) gang vector default(present) do id = 1, num_dims - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end @@ -589,11 +608,11 @@ contains impure subroutine s_compute_rhs(q_cons_vf, q_T_sf, q_prim_vf, bc_type, rhs_vf, pb, rhs_pb, mv, rhs_mv, t_step, time_avg, stage) - type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf type(scalar_field), intent(inout) :: q_T_sf - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, rhs_pb real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: mv, rhs_mv integer, intent(in) :: t_step @@ -609,7 +628,7 @@ contains call cpu_time(t_start) ! Association/Population of Working Variables !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end @@ -633,7 +652,7 @@ contains end do !$acc loop 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)) & + 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 @@ -649,7 +668,7 @@ contains call nvtxEndRange call nvtxStartRange("RHS-COMMUNICATION") - call s_populate_variables_buffers(q_prim_qp%vf, pb, mv, bc_type) + call s_populate_variables_buffers(q_prim_qp%vf, pb, mv, bc_type, bc_bound) call nvtxEndRange call nvtxStartRange("RHS-ELASTIC") @@ -693,28 +712,28 @@ contains if (.not. surface_tension) then ! Reconstruct densitiess - iv%beg = 1; iv%end = sys_size + iv%beg = 1; iv%end = eqn_idx%sys_size call s_reconstruct_cell_boundary_values( & - q_prim_qp%vf(1:sys_size), & + q_prim_qp%vf(1:eqn_idx%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 = 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 + iv%beg = eqn_idx%E; iv%end = eqn_idx%E call s_reconstruct_cell_boundary_values_first_order( & - q_prim_qp%vf(E_idx), & + 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 = eqn_idx%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, & @@ -845,7 +864,7 @@ contains do k = 0, n do j = 0, m if (ib_markers%sf(j, k, l) /= 0) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size rhs_vf(i)%sf(j, k, l) = 0._wp end do end if @@ -858,8 +877,8 @@ contains ! Additions for acoustic_source if (acoustic_source) then call nvtxStartRange("RHS-ACOUSTIC-SRC") - call s_acoustic_src_calculations(q_cons_qp%vf(1:sys_size), & - q_prim_qp%vf(1:sys_size), & + call s_acoustic_src_calculations(q_cons_qp%vf(1:eqn_idx%sys_size), & + q_prim_qp%vf(1:eqn_idx%sys_size), & t_step, & rhs_vf) call nvtxEndRange @@ -869,8 +888,8 @@ contains if (bubbles_euler .and. (.not. adap_dt) .and. (.not. qbmm)) then call nvtxStartRange("RHS-BUBBLES-SRC") call s_compute_bubble_EE_source( & - q_cons_qp%vf(1:sys_size), & - q_prim_qp%vf(1:sys_size), & + q_cons_qp%vf(1:eqn_idx%sys_size), & + q_prim_qp%vf(1:eqn_idx%sys_size), & rhs_vf) call nvtxEndRange end if @@ -879,15 +898,15 @@ contains ! RHS additions for sub-grid bubbles_lagrange call nvtxStartRange("RHS-EL-BUBBLES-SRC") call s_compute_bubbles_EL_source( & - q_cons_qp%vf(1:sys_size), & - q_prim_qp%vf(1:sys_size), & + q_cons_qp%vf(1:eqn_idx%sys_size), & + q_prim_qp%vf(1:eqn_idx%sys_size), & rhs_vf) call nvtxEndRange ! Compute bubble dynamics if (.not. adap_dt) then call nvtxStartRange("RHS-EL-BUBBLES-DYN") call s_compute_bubble_EL_dynamics( & - q_prim_qp%vf(1:sys_size), & + q_prim_qp%vf(1:eqn_idx%sys_size), & stage) call nvtxEndRange end if @@ -905,7 +924,7 @@ contains if (run_time_info .or. probe_wrt .or. ib .or. bubbles_lagrange) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end @@ -931,7 +950,7 @@ contains subroutine s_compute_advection_source_term(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf) integer, intent(in) :: idir - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf type(vector_field), intent(inout) :: q_cons_vf type(vector_field), intent(inout) :: q_prim_vf type(vector_field), intent(inout) :: flux_src_n_vf @@ -948,14 +967,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, q_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, q_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 @@ -979,7 +998,7 @@ contains end if !$acc parallel loop collapse(4) gang vector default(present) private(inv_ds, flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do q_loop = 0, p do l_loop = 0, n do k_loop = 0, m @@ -1001,7 +1020,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, q_loop) = & @@ -1024,7 +1043,7 @@ contains end if !$acc parallel loop collapse(4) gang vector default(present) private(inv_ds, flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do q = 0, m @@ -1046,7 +1065,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) = & @@ -1065,7 +1084,7 @@ contains if (cyl_coord) then !$acc parallel loop collapse(4) gang vector default(present) private(flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do q = 0, m @@ -1092,7 +1111,7 @@ contains if (grid_geometry == 3) then ! Cylindrical Coordinates !$acc parallel loop collapse(4) gang vector default(present) & !$acc private(inv_ds, velocity_val, flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do k = 0, p do q = 0, n do l = 0, m @@ -1107,7 +1126,7 @@ contains end do end do !$acc parallel loop collapse(4) gang vector default(present) private(flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do k = 0, p do q = 0, n do l = 0, m @@ -1121,7 +1140,7 @@ contains end do else ! Cartesian Coordinates !$acc parallel loop collapse(4) gang vector default(present) private(inv_ds, flux_face1, flux_face2) - do j = 1, sys_size + do j = 1, eqn_idx%sys_size do k = 0, p do q = 0, n do l = 0, m @@ -1144,7 +1163,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) = & @@ -1165,7 +1184,7 @@ contains subroutine s_add_directional_advection_source_terms(current_idir, rhs_vf_arg, q_cons_vf_arg, & q_prim_vf_arg, flux_src_n_vf_arg, Kterm_arg) integer, intent(in) :: current_idir - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf_arg + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf_arg type(vector_field), intent(in) :: q_cons_vf_arg type(vector_field), intent(in) :: q_prim_vf_arg type(vector_field), intent(in) :: flux_src_n_vf_arg @@ -1391,10 +1410,10 @@ contains dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf) integer, intent(in) :: idir - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf - type(scalar_field), dimension(sys_size), intent(in) :: flux_src_n - type(scalar_field), dimension(sys_size), intent(in) :: dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: flux_src_n + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: dq_prim_dx_vf, dq_prim_dy_vf, dq_prim_dz_vf integer :: i, j, k, l @@ -1405,9 +1424,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)* & + 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(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j - 1, k, l)) end do @@ -1420,7 +1439,7 @@ contains do k = 0, n do j = 0, m !$acc loop 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(i)%sf(j - 1, k, l) & @@ -1437,9 +1456,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)* & + 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(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j, k - 1, l)) end do @@ -1451,16 +1470,16 @@ contains if (viscous) then if (p > 0) then call s_compute_viscous_stress_tensor(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), & + 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_tensor(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_dy_vf(mom_idx%beg:mom_idx%end), & + 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_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), & tau_Re_vf, & idwbuff(1), idwbuff(2), idwbuff(3)) end if @@ -1469,7 +1488,7 @@ contains do l = 0, p do j = 0, m !$acc loop 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) & @@ -1485,7 +1504,7 @@ contains do k = 1, n do j = 0, m !$acc loop 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(i)%sf(j, k - 1, l) & @@ -1501,7 +1520,7 @@ contains do k = 0, n do j = 0, m !$acc loop 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(i)%sf(j, k - 1, l) & @@ -1522,7 +1541,7 @@ contains do k = 1, n do j = 0, m !$acc loop 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) - 5e-1_wp/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & @@ -1537,7 +1556,7 @@ contains do l = 0, p do j = 0, m !$acc loop 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) @@ -1552,7 +1571,7 @@ contains do k = 0, n do j = 0, m !$acc loop 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) - 5e-1_wp/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & @@ -1572,9 +1591,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)* & + 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(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j, k, l - 1)) end do @@ -1587,7 +1606,7 @@ contains do k = 0, n do j = 0, m !$acc loop 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(i)%sf(j, k, l - 1) & @@ -1625,6 +1644,249 @@ contains !! fraction of each phase are recomputed. For conservation !! purpose, this pressure is finally corrected using the !! mixture-total-energy equation. + !! @param q_cons_vf Cell-average conservative variables + pure subroutine s_pressure_relaxation_procedure(q_cons_vf) + + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: q_cons_vf + + !> @name Relaxed pressure, initial partial pressures, function f(p) and its partial + !! derivative df(p), isentropic partial density, sum of volume fractions, + !! mixture density, dynamic pressure, surface energy, specific heat ratio + !! function, liquid stiffness function (two variations of the last two + !! ones), shear and volume Reynolds numbers and the Weber numbers + !> @{ + real(wp) :: pres_relax + real(wp), dimension(num_fluids) :: pres_K_init + real(wp) :: f_pres + real(wp) :: df_pres + real(wp), dimension(num_fluids) :: rho_K_s + real(wp), dimension(num_fluids) :: alpha_rho + real(wp), dimension(num_fluids) :: alpha + real(wp) :: sum_alpha + real(wp) :: rho + real(wp) :: dyn_pres + real(wp) :: gamma + real(wp) :: pi_inf + real(wp), dimension(2) :: Re + + integer :: i, j, k, l, q, iter !< Generic loop iterators + integer :: relax !< Relaxation procedure determination variable + + !$acc parallel loop collapse(3) gang vector private(pres_K_init, rho_K_s, alpha_rho, alpha, Re, pres_relax) + do l = 0, p + do k = 0, n + do j = 0, m + + ! Numerical correction of the volume fractions + if (mpp_lim) then + sum_alpha = 0._wp + + !$acc loop 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 + 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) + end do + + !$acc loop 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 + end do + end if + + ! Pressures relaxation procedure + + ! Is the pressure relaxation procedure necessary? + relax = 1 + + !$acc loop seq + do i = 1, num_fluids + if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > (1._wp - sgm_eps)) relax = 0 + end do + + if (relax == 1) then + ! Initial state + pres_relax = 0._wp + + !$acc loop 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 (pres_K_init(i) <= -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-8_wp) & + pres_K_init(i) = -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-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) + end do + + ! Iterative process for relaxed pressure determination + f_pres = 1e-9_wp + df_pres = 1e9_wp + + !$acc loop seq + do i = 1, num_fluids + rho_K_s(i) = 0._wp + end do + + !$acc loop seq + do iter = 0, 49 + + if (abs(f_pres) > 1e-10_wp) then + pres_relax = pres_relax - f_pres/df_pres + + ! Physical pressure + do i = 1, num_fluids + if (pres_relax <= -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-8_wp) & + pres_relax = -(1._wp - 1e-8_wp)*pres_inf(i) + 1._wp + end do + + ! Newton-Raphson method + f_pres = -1._wp + df_pres = 0._wp + + !$acc loop seq + do i = 1, num_fluids + if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then + 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 + pres_inf(i))/(pres_K_init(i) + & + pres_inf(i)))**(1._wp/gamma_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) & + /(gamma_min(i)*rho_K_s(i)*(pres_relax + pres_inf(i))) + end if + end do + end if + + end do + + ! Cell update of the volume fraction + !$acc loop 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) + end do + end if + + ! Mixture-total-energy correction + + ! The mixture-total-energy correction of the mixture pressure P is not necessary here + ! because the primitive variables are directly recovered later on by the conservative + ! variables (see s_convert_conservative_to_primitive_variables called in s_compute_rhs). + ! However, the internal-energy equations should be reset with the corresponding mixture + ! pressure from the correction. This step is carried out below. + + !$acc loop 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) + end do + + if (bubbles_euler) then + rho = 0._wp + gamma = 0._wp + pi_inf = 0._wp + + if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then + !$acc loop seq + do i = 1, num_fluids + rho = rho + alpha_rho(i) + gamma = gamma + alpha(i)*gammas(i) + pi_inf = pi_inf + alpha(i)*pi_infs(i) + end do + else if ((model_eqns == 2) .and. (num_fluids > 2)) then + !$acc loop seq + do i = 1, num_fluids - 1 + rho = rho + alpha_rho(i) + gamma = gamma + alpha(i)*gammas(i) + pi_inf = pi_inf + alpha(i)*pi_infs(i) + end do + else + rho = alpha_rho(1) + gamma = gammas(1) + pi_inf = pi_infs(1) + end if + else + rho = 0._wp + gamma = 0._wp + pi_inf = 0._wp + + sum_alpha = 0._wp + + if (mpp_lim) then + !$acc loop seq + do i = 1, num_fluids + alpha_rho(i) = max(0._wp, alpha_rho(i)) + alpha(i) = min(max(0._wp, alpha(i)), 1._wp) + sum_alpha = sum_alpha + alpha(i) + end do + + alpha = alpha/max(sum_alpha, sgm_eps) + + end if + + !$acc loop seq + do i = 1, num_fluids + rho = rho + alpha_rho(i) + gamma = gamma + alpha(i)*gammas(i) + pi_inf = pi_inf + alpha(i)*pi_infs(i) + end do + + if (viscous) then + !$acc loop seq + do i = 1, 2 + Re(i) = dflt_real + + if (eqn_idx%Re_size(i) > 0) Re(i) = 0._wp + !$acc loop seq + do q = 1, eqn_idx%Re_size(i) + Re(i) = alpha(eqn_idx%Re(i, q))/Res(i, q) & + + Re(i) + end do + + Re(i) = 1._wp/max(Re(i), sgm_eps) + + end do + end if + end if + + dyn_pres = 0._wp + + !$acc loop seq + do i = momxb, momxe + dyn_pres = dyn_pres + 5e-1_wp*q_cons_vf(i)%sf(j, k, l)* & + q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps) + end do + + pres_relax = (q_cons_vf(eqn_idx%E)%sf(j, k, l) - dyn_pres - pi_inf)/gamma + + !$acc loop 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)) + end do + end do + end do + end do + + end subroutine s_pressure_relaxation_procedure !> The purpose of this subroutine is to WENO-reconstruct the !! left and the right cell-boundary values, including values @@ -1770,7 +2032,7 @@ contains call s_finalize_pressure_relaxation_module - do j = cont_idx%beg, cont_idx%end + do j = eqn_idx%cont%beg, eqn_idx%cont%end if (relativity) then ! Cons and Prim densities are different for relativity @:DEALLOCATE(q_cons_qp%vf(j)%sf) @@ -1781,12 +2043,12 @@ contains end if end do - do j = adv_idx%beg, adv_idx%end + do j = eqn_idx%adv%beg, eqn_idx%adv%end !$acc exit data detach(q_prim_qp%vf(j)%sf) nullify (q_prim_qp%vf(j)%sf) end do - do j = mom_idx%beg, E_idx + do j = eqn_idx%mom%beg, eqn_idx%E @:DEALLOCATE(q_cons_qp%vf(j)%sf) @:DEALLOCATE(q_prim_qp%vf(j)%sf) end do @@ -1820,18 +2082,18 @@ contains end if if (viscous) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dx_qp(1)%vf(l)%sf) end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dy_qp(1)%vf(l)%sf) end do if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dq_prim_dz_qp(1)%vf(l)%sf) end do end if @@ -1846,20 +2108,20 @@ contains if (viscous) then do i = num_dims, 1, -1 - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dx_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dx_n(i)%vf(l)%sf) end do if (n > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dy_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dy_n(i)%vf(l)%sf) end do end if if (p > 0) then - do l = mom_idx%beg, mom_idx%end + do l = eqn_idx%mom%beg, eqn_idx%mom%end @:DEALLOCATE(dqL_prim_dz_n(i)%vf(l)%sf) @:DEALLOCATE(dqR_prim_dz_n(i)%vf(l)%sf) end do @@ -1879,34 +2141,34 @@ contains do i = num_dims, 1, -1 if (i /= 1) then - do l = 1, sys_size + do l = 1, eqn_idx%sys_size nullify (flux_n(i)%vf(l)%sf) nullify (flux_src_n(i)%vf(l)%sf) @:DEALLOCATE(flux_gsrc_n(i)%vf(l)%sf) end do else - do l = 1, sys_size + do l = 1, eqn_idx%sys_size @:DEALLOCATE(flux_n(i)%vf(l)%sf) @:DEALLOCATE(flux_gsrc_n(i)%vf(l)%sf) end do if (viscous) then - do l = mom_idx%beg, E_idx + do l = eqn_idx%mom%beg, eqn_idx%E @:DEALLOCATE(flux_src_n(i)%vf(l)%sf) end do end if if (riemann_solver == 1 .or. riemann_solver == 4) then - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end @:DEALLOCATE(flux_src_n(i)%vf(l)%sf) end do else - do l = adv_idx%beg + 1, adv_idx%end + do l = eqn_idx%adv%beg + 1, eqn_idx%adv%end nullify (flux_src_n(i)%vf(l)%sf) end do end if - @:DEALLOCATE(flux_src_n(i)%vf(adv_idx%beg)%sf) + @:DEALLOCATE(flux_src_n(i)%vf(eqn_idx%adv%beg)%sf) end if @:DEALLOCATE(flux_n(i)%vf, flux_src_n(i)%vf, flux_gsrc_n(i)%vf) @@ -1916,9 +2178,9 @@ contains if (viscous .and. cyl_coord) then do i = 1, num_dims - @:DEALLOCATE(tau_re_vf(cont_idx%end + i)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%cont%end + i)%sf) end do - @:DEALLOCATE(tau_re_vf(e_idx)%sf) + @:DEALLOCATE(tau_re_vf(eqn_idx%e)%sf) @:DEALLOCATE(tau_re_vf) end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 36d831a439..7d239abeb0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -160,7 +160,7 @@ contains norm_dir, ix, iy, iz) real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(INOUT) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(IN) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(INOUT) :: qL_prim_vf, qR_prim_vf @@ -171,7 +171,7 @@ contains dqL_prim_dz_vf, dqR_prim_dz_vf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(INOUT) :: flux_vf, flux_src_vf, flux_gsrc_vf integer, intent(IN) :: norm_dir @@ -222,7 +222,7 @@ contains dvelL_dz_vf, dvelR_dz_vf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(INOUT) :: flux_src_vf integer, intent(IN) :: norm_dir @@ -267,7 +267,7 @@ contains norm_dir, ix, iy, iz) real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf @@ -279,7 +279,7 @@ contains ! Intercell fluxes type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf integer, intent(in) :: norm_dir @@ -389,28 +389,28 @@ contains !$acc loop seq do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do - pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) if (mhd) then if (n == 0) then ! 1D: constant Bx; By, Bz as variables B%L(1) = Bx0 B%R(1) = Bx0 - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz as variables - B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 2) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 2) + B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 2) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 2) end if end if @@ -468,11 +468,11 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_L(i) = alpha_L(eqn_idx%Re(i, q))/Res(i, q) & + Re_L(i) end do @@ -484,11 +484,11 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_R(i) = alpha_R(eqn_idx%Re(i, q))/Res(i, q) & + Re_R(i) end do @@ -601,8 +601,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, 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 @@ -637,12 +637,12 @@ contains ! 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) ! !$acc loop seq - ! do i = 1, b_size-1 + ! do i = 1, eqn_idx%b_size-1 ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ! end do ! !$acc loop seq - ! do i = 1, b_size-1 + ! do i = 1, eqn_idx%b_size-1 ! tau_e_L(i) = 0_wp ! tau_e_R(i) = 0_wp ! end do @@ -682,41 +682,41 @@ contains if (wave_speeds == 1) then if (mhd) then - s_L = min(vel_L(dir_idx(1)) - c_fast%L, vel_R(dir_idx(1)) - c_fast%R) - s_R = max(vel_R(dir_idx(1)) + c_fast%R, vel_L(dir_idx(1)) + c_fast%L) + s_L = min(vel_L(eqn_idx%dir(1)) - c_fast%L, vel_R(eqn_idx%dir(1)) - c_fast%R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_fast%R, vel_L(eqn_idx%dir(1)) + c_fast%L) elseif (hypoelasticity) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + s_L = min(vel_L(eqn_idx%dir(1)) - sqrt(c_L*c_L + & (((4._wp*G_L)/3._wp) + & - tau_e_L(dir_idx_tau(1)))/rho_L) & - , vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + tau_e_L(eqn_idx%dir_tau(1)))/rho_L) & + , vel_R(eqn_idx%dir(1)) - sqrt(c_R*c_R + & (((4._wp*G_R)/3._wp) + & - tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + tau_e_R(eqn_idx%dir_tau(1)))/rho_R)) + s_R = max(vel_R(eqn_idx%dir(1)) + sqrt(c_R*c_R + & (((4._wp*G_R)/3._wp) + & - tau_e_R(dir_idx_tau(1)))/rho_R) & - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + tau_e_R(eqn_idx%dir_tau(1)))/rho_R) & + , vel_L(eqn_idx%dir(1)) + sqrt(c_L*c_L + & (((4._wp*G_L)/3._wp) + & - tau_e_L(dir_idx_tau(1)))/rho_L)) + tau_e_L(eqn_idx%dir_tau(1)))/rho_L)) else if (hyperelasticity) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4_wp*G_L/3_wp)/rho_L) & - , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4_wp*G_R/3_wp)/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4_wp*G_R/3_wp)/rho_R) & - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4_wp*G_L/3_wp)/rho_L)) + s_L = min(vel_L(eqn_idx%dir(1)) - sqrt(c_L*c_L + (4_wp*G_L/3_wp)/rho_L) & + , vel_R(eqn_idx%dir(1)) - sqrt(c_R*c_R + (4_wp*G_R/3_wp)/rho_R)) + s_R = max(vel_R(eqn_idx%dir(1)) + sqrt(c_R*c_R + (4_wp*G_R/3_wp)/rho_R) & + , vel_L(eqn_idx%dir(1)) + sqrt(c_L*c_L + (4_wp*G_L/3_wp)/rho_L)) else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + s_L = min(vel_L(eqn_idx%dir(1)) - c_L, vel_R(eqn_idx%dir(1)) - c_R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_R, vel_L(eqn_idx%dir(1)) + c_L) end if - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - & - rho_R*vel_R(dir_idx(1))* & - (s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - & - rho_R*(s_R - vel_R(dir_idx(1)))) + s_S = (pres_R - pres_L + rho_L*vel_L(eqn_idx%dir(1))* & + (s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*vel_R(eqn_idx%dir(1))* & + (s_R - vel_R(eqn_idx%dir(1)))) & + /(rho_L*(s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*(s_R - vel_R(eqn_idx%dir(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(eqn_idx%dir(1)) - & + vel_R(eqn_idx%dir(1)))) pres_SR = pres_SL @@ -727,10 +727,10 @@ contains (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R + s_L = vel_L(eqn_idx%dir(1)) - c_L*Ms_L + s_R = vel_R(eqn_idx%dir(1)) + c_R*Ms_R - s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -781,10 +781,10 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 1) = & (s_M*(rho_R*vel_R(1)*vel_R(norm_dir) & - B%R(1)*B%R(norm_dir) & - + dir_flg(1)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(1)*(pres_R + pres_mag%R)) & - s_P*(rho_L*vel_L(1)*vel_L(norm_dir) & - B%L(1)*B%L(norm_dir) & - + dir_flg(1)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(1)*(pres_L + pres_mag%L)) & + s_M*s_P*(rho_L*vel_L(1) - rho_R*vel_R(1))) & /(s_M - s_P) ! Flux of rho*v_y in the ${XYZ}$ direction @@ -792,10 +792,10 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 2) = & (s_M*(rho_R*vel_R(2)*vel_R(norm_dir) & - B%R(2)*B%R(norm_dir) & - + dir_flg(2)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(2)*(pres_R + pres_mag%R)) & - s_P*(rho_L*vel_L(2)*vel_L(norm_dir) & - B%L(2)*B%L(norm_dir) & - + dir_flg(2)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(2)*(pres_L + pres_mag%L)) & + s_M*s_P*(rho_L*vel_L(2) - rho_R*vel_R(2))) & /(s_M - s_P) ! Flux of rho*v_z in the ${XYZ}$ direction @@ -803,10 +803,10 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 3) = & (s_M*(rho_R*vel_R(3)*vel_R(norm_dir) & - B%R(3)*B%R(norm_dir) & - + dir_flg(3)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(3)*(pres_R + pres_mag%R)) & - s_P*(rho_L*vel_L(3)*vel_L(norm_dir) & - B%L(3)*B%L(norm_dir) & - + dir_flg(3)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(3)*(pres_L + pres_mag%L)) & + s_M*s_P*(rho_L*vel_L(3) - rho_R*vel_R(3))) & /(s_M - s_P) elseif (mhd .and. relativity) then @@ -815,10 +815,10 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 1) = & (s_M*(cm%R(1)*vel_R(norm_dir) & - b4%R(1)/Ga%R*B%R(norm_dir) & - + dir_flg(1)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(1)*(pres_R + pres_mag%R)) & - s_P*(cm%L(1)*vel_L(norm_dir) & - b4%L(1)/Ga%L*B%L(norm_dir) & - + dir_flg(1)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(1)*(pres_L + pres_mag%L)) & + s_M*s_P*(cm%L(1) - cm%R(1))) & /(s_M - s_P) ! Flux of m_y in the ${XYZ}$ direction @@ -826,10 +826,10 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 2) = & (s_M*(cm%R(2)*vel_R(norm_dir) & - b4%R(2)/Ga%R*B%R(norm_dir) & - + dir_flg(2)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(2)*(pres_R + pres_mag%R)) & - s_P*(cm%L(2)*vel_L(norm_dir) & - b4%L(2)/Ga%L*B%L(norm_dir) & - + dir_flg(2)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(2)*(pres_L + pres_mag%L)) & + s_M*s_P*(cm%L(2) - cm%R(2))) & /(s_M - s_P) ! Flux of m_z in the ${XYZ}$ direction @@ -837,64 +837,64 @@ contains flux_rs${XYZ}$_vf(j, k, l, contxe + 3) = & (s_M*(cm%R(3)*vel_R(norm_dir) & - b4%R(3)/Ga%R*B%R(norm_dir) & - + dir_flg(3)*(pres_R + pres_mag%R)) & + + eqn_idx%dir_flg(3)*(pres_R + pres_mag%R)) & - s_P*(cm%L(3)*vel_L(norm_dir) & - b4%L(3)/Ga%L*B%L(norm_dir) & - + dir_flg(3)*(pres_L + pres_mag%L)) & + + eqn_idx%dir_flg(3)*(pres_L + pres_mag%L)) & + s_M*s_P*(cm%L(3) - cm%R(3))) & /(s_M - s_P) elseif (bubbles_euler) then !$acc loop 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)))) & + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) = & + (s_M*(rho_R*vel_R(eqn_idx%dir(1)) & + *vel_R(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*(pres_R - ptilde_R)) & + - s_P*(rho_L*vel_L(eqn_idx%dir(1)) & + *vel_L(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*(pres_L - ptilde_L)) & + + s_M*s_P*(rho_L*vel_L(eqn_idx%dir(i)) & + - rho_R*vel_R(eqn_idx%dir(i)))) & /(s_M - s_P) & - + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(eqn_idx%dir(i)) - vel_L(eqn_idx%dir(i))) end do else if (hypoelasticity) then !$acc loop 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))) & - - 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)))) & + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) = & + (s_M*(rho_R*vel_R(eqn_idx%dir(1)) & + *vel_R(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_R & + - tau_e_R(eqn_idx%dir_tau(i))) & + - s_P*(rho_L*vel_L(eqn_idx%dir(1)) & + *vel_L(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_L & + - tau_e_L(eqn_idx%dir_tau(i))) & + + s_M*s_P*(rho_L*vel_L(eqn_idx%dir(i)) & + - rho_R*vel_R(eqn_idx%dir(i)))) & /(s_M - s_P) end do else !$acc loop 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)))) & + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) = & + (s_M*(rho_R*vel_R(eqn_idx%dir(1)) & + *vel_R(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_R) & + - s_P*(rho_L*vel_L(eqn_idx%dir(1)) & + *vel_L(eqn_idx%dir(i)) & + + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_L) & + + s_M*s_P*(rho_L*vel_L(eqn_idx%dir(i)) & + - rho_R*vel_R(eqn_idx%dir(i)))) & /(s_M - s_P) & - + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(dir_idx(i)) - vel_L(dir_idx(i))) + + (s_M/s_L)*(s_P/s_R)*pcorr*(vel_R(eqn_idx%dir(i)) - vel_L(eqn_idx%dir(i))) end do end if ! Energy if (mhd .and. (.not. relativity)) then ! energy flux = (E + p + p_mag) * v_${XYZ}$ - B_${XYZ}$ * (v_x*B_x + v_y*B_y + v_z*B_z) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + flux_rs${XYZ}$_vf(j, k, l, 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)) & @@ -902,55 +902,55 @@ contains elseif (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) = & + 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)) & - 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) & - - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + (s_M*vel_R(eqn_idx%dir(1))*(E_R + pres_R - ptilde_R) & + - s_P*vel_L(eqn_idx%dir(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 !TODO: simplify this so it's not split into 3 if (num_dims == 1) then - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) & - - (tau_e_R(dir_idx_tau(1))*vel_R(dir_idx(1)))) & - - s_P*(vel_L(dir_idx(1))*(E_L + pres_L) & - - (tau_e_L(dir_idx_tau(1))*vel_L(dir_idx(1)))) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + (s_M*(vel_R(eqn_idx%dir(1))*(E_R + pres_R) & + - (tau_e_R(eqn_idx%dir_tau(1))*vel_R(eqn_idx%dir(1)))) & + - s_P*(vel_L(eqn_idx%dir(1))*(E_L + pres_L) & + - (tau_e_L(eqn_idx%dir_tau(1))*vel_L(eqn_idx%dir(1)))) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) else if (num_dims == 2) then - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) & - - (tau_e_R(dir_idx_tau(1))*vel_R(dir_idx(1))) & - - (tau_e_R(dir_idx_tau(2))*vel_R(dir_idx(2)))) & - - s_P*(vel_L(dir_idx(1))*(E_L + pres_L) & - - (tau_e_L(dir_idx_tau(1))*vel_L(dir_idx(1))) & - - (tau_e_L(dir_idx_tau(2))*vel_L(dir_idx(2)))) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + (s_M*(vel_R(eqn_idx%dir(1))*(E_R + pres_R) & + - (tau_e_R(eqn_idx%dir_tau(1))*vel_R(eqn_idx%dir(1))) & + - (tau_e_R(eqn_idx%dir_tau(2))*vel_R(eqn_idx%dir(2)))) & + - s_P*(vel_L(eqn_idx%dir(1))*(E_L + pres_L) & + - (tau_e_L(eqn_idx%dir_tau(1))*vel_L(eqn_idx%dir(1))) & + - (tau_e_L(eqn_idx%dir_tau(2))*vel_L(eqn_idx%dir(2)))) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) else if (num_dims == 3) then - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - (s_M*(vel_R(dir_idx(1))*(E_R + pres_R) & - - (tau_e_R(dir_idx_tau(1))*vel_R(dir_idx(1))) & - - (tau_e_R(dir_idx_tau(2))*vel_R(dir_idx(2))) & - - (tau_e_R(dir_idx_tau(3))*vel_R(dir_idx(3)))) & - - s_P*(vel_L(dir_idx(1))*(E_L + pres_L) & - - (tau_e_L(dir_idx_tau(1))*vel_L(dir_idx(1))) & - - (tau_e_L(dir_idx_tau(2))*vel_L(dir_idx(2))) & - - (tau_e_L(dir_idx_tau(3))*vel_L(dir_idx(3)))) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + (s_M*(vel_R(eqn_idx%dir(1))*(E_R + pres_R) & + - (tau_e_R(eqn_idx%dir_tau(1))*vel_R(eqn_idx%dir(1))) & + - (tau_e_R(eqn_idx%dir_tau(2))*vel_R(eqn_idx%dir(2))) & + - (tau_e_R(eqn_idx%dir_tau(3))*vel_R(eqn_idx%dir(3)))) & + - s_P*(vel_L(eqn_idx%dir(1))*(E_L + pres_L) & + - (tau_e_L(eqn_idx%dir_tau(1))*vel_L(eqn_idx%dir(1))) & + - (tau_e_L(eqn_idx%dir_tau(2))*vel_L(eqn_idx%dir(2))) & + - (tau_e_L(eqn_idx%dir_tau(3))*vel_L(eqn_idx%dir(3)))) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) end if 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) & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + (s_M*vel_R(eqn_idx%dir(1))*(E_R + pres_R) & + - s_P*vel_L(eqn_idx%dir(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 @@ -960,9 +960,9 @@ contains if (hypoelasticity) then do i = 1, strxe - strxb + 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)) & + (s_M*(rho_R*vel_R(eqn_idx%dir(1)) & *tau_e_R(i)) & - - s_P*(rho_L*vel_L(dir_idx(1)) & + - s_P*(rho_L*vel_L(eqn_idx%dir(1)) & *tau_e_L(i)) & + s_M*s_P*(rho_L*tau_e_L(i) & - rho_R*tau_e_R(i))) & @@ -987,8 +987,8 @@ contains !if ( hyperelasticity ) then ! do i = 1, num_dims ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & - ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + ! (s_M*rho_R*vel_R(eqn_idx%dir(1))*xi_field_R(i) & + ! - s_P*rho_L*vel_L(eqn_idx%dir(1))*xi_field_L(i) & ! + s_M*s_P*(rho_L*xi_field_L(i) & ! - rho_R*xi_field_R(i))) & ! /(s_M - s_P) @@ -998,15 +998,15 @@ contains ! Div(U)? !$acc loop seq do i = 1, num_vels - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & - (xi_M*(rho_L*vel_L(dir_idx(i))* & - (s_L - vel_L(dir_idx(1))) - & - pres_L*dir_flg(dir_idx(i))) - & - xi_P*(rho_R*vel_R(dir_idx(i))* & - (s_R - vel_R(dir_idx(1))) - & - pres_R*dir_flg(dir_idx(i)))) & - /(xi_M*rho_L*(s_L - vel_L(dir_idx(1))) - & - xi_P*rho_R*(s_R - vel_R(dir_idx(1)))) + vel_src_rs${XYZ}$_vf(j, k, l, eqn_idx%dir(i)) = & + (xi_M*(rho_L*vel_L(eqn_idx%dir(i))* & + (s_L - vel_L(eqn_idx%dir(1))) - & + pres_L*eqn_idx%dir_flg(eqn_idx%dir(i))) - & + xi_P*(rho_R*vel_R(eqn_idx%dir(i))* & + (s_R - vel_R(eqn_idx%dir(1))) - & + pres_R*eqn_idx%dir_flg(eqn_idx%dir(i)))) & + /(xi_M*rho_L*(s_L - vel_L(eqn_idx%dir(1))) - & + xi_P*rho_R*(s_R - vel_R(eqn_idx%dir(1)))) end do if (bubbles_euler) then @@ -1022,8 +1022,8 @@ contains Y_L = qL_prim_rs${XYZ}$_vf(j, k, l, i) Y_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) - flux_rs${XYZ}$_vf(j, k, l, i) = (s_M*Y_R*rho_R*vel_R(dir_idx(1)) & - - s_P*Y_L*rho_L*vel_L(dir_idx(1)) & + flux_rs${XYZ}$_vf(j, k, l, i) = (s_M*Y_R*rho_R*vel_R(eqn_idx%dir(1)) & + - s_P*Y_L*rho_L*vel_L(eqn_idx%dir(1)) & + s_M*s_P*(Y_L*rho_L - Y_R*rho_R)) & /(s_M - s_P) flux_src_rs${XYZ}$_vf(j, k, l, i) = 0._wp @@ -1033,30 +1033,30 @@ contains if (mhd) then if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const. ! B_y flux = v_x * B_y - v_y * Bx0 - flux_rsx_vf(j, k, l, B_idx%beg) = (s_M*(vel_R(1)*B%R(2) - vel_R(2)*Bx0) & + flux_rsx_vf(j, k, l, eqn_idx%B%beg) = (s_M*(vel_R(1)*B%R(2) - vel_R(2)*Bx0) & - s_P*(vel_L(1)*B%L(2) - vel_L(2)*Bx0) + s_M*s_P*(B%L(2) - B%R(2)))/(s_M - s_P) ! B_z flux = v_x * B_z - v_z * Bx0 - flux_rsx_vf(j, k, l, B_idx%beg + 1) = (s_M*(vel_R(1)*B%R(3) - vel_R(3)*Bx0) & + flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = (s_M*(vel_R(1)*B%R(3) - vel_R(3)*Bx0) & - s_P*(vel_L(1)*B%L(3) - vel_L(3)*Bx0) + s_M*s_P*(B%L(3) - B%R(3)))/(s_M - s_P) else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction ! B_x d/d${XYZ}$ flux = (1 - delta(x,${XYZ}$)) * (v_${XYZ}$ * B_x - v_x * B_${XYZ}$) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg) = (1 - dir_flg(1))*( & - s_M*(vel_R(dir_idx(1))*B%R(1) - vel_R(1)*B%R(norm_dir)) - & - s_P*(vel_L(dir_idx(1))*B%L(1) - vel_L(1)*B%L(norm_dir)) + & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) = (1 - eqn_idx%dir_flg(1))*( & + s_M*(vel_R(eqn_idx%dir(1))*B%R(1) - vel_R(1)*B%R(norm_dir)) - & + s_P*(vel_L(eqn_idx%dir(1))*B%L(1) - vel_L(1)*B%L(norm_dir)) + & s_M*s_P*(B%L(1) - B%R(1)))/(s_M - s_P) ! B_y d/d${XYZ}$ flux = (1 - delta(y,${XYZ}$)) * (v_${XYZ}$ * B_y - v_y * B_${XYZ}$) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) = (1 - dir_flg(2))*( & - s_M*(vel_R(dir_idx(1))*B%R(2) - vel_R(2)*B%R(norm_dir)) - & - s_P*(vel_L(dir_idx(1))*B%L(2) - vel_L(2)*B%L(norm_dir)) + & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) = (1 - eqn_idx%dir_flg(2))*( & + s_M*(vel_R(eqn_idx%dir(1))*B%R(2) - vel_R(2)*B%R(norm_dir)) - & + s_P*(vel_L(eqn_idx%dir(1))*B%L(2) - vel_L(2)*B%L(norm_dir)) + & s_M*s_P*(B%L(2) - B%R(2)))/(s_M - s_P) ! B_z d/d${XYZ}$ flux = (1 - delta(z,${XYZ}$)) * (v_${XYZ}$ * B_z - v_z * B_${XYZ}$) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + 2) = (1 - dir_flg(3))*( & - s_M*(vel_R(dir_idx(1))*B%R(3) - vel_R(3)*B%R(norm_dir)) - & - s_P*(vel_L(dir_idx(1))*B%L(3) - vel_L(3)*B%L(norm_dir)) + & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 2) = (1 - eqn_idx%dir_flg(3))*( & + s_M*(vel_R(eqn_idx%dir(1))*B%R(3) - vel_R(3)*B%R(norm_dir)) - & + s_P*(vel_L(eqn_idx%dir(1))*B%L(3) - vel_L(3)*B%L(norm_dir)) + & s_M*s_P*(B%L(3) - B%R(3)))/(s_M - s_P) end if @@ -1068,7 +1068,7 @@ contains if (cyl_coord) then !Substituting the advective flux into the inviscid geometrical source flux !$acc loop 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 @@ -1181,7 +1181,7 @@ contains norm_dir, ix, iy, iz) real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf type(scalar_field), & @@ -1192,7 +1192,7 @@ contains ! Intercell fluxes type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf integer, intent(in) :: norm_dir @@ -1276,7 +1276,7 @@ contains flux_src_vf, & norm_dir) - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + idx1 = 1; if (eqn_idx%dir(1) == 2) idx1 = 2; if (eqn_idx%dir(1) == 3) idx1 = 3 #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] @@ -1296,7 +1296,7 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end - idx1 = dir_idx(1) + idx1 = eqn_idx%dir(1) vel_L_rms = 0._wp; vel_R_rms = 0._wp @@ -1308,8 +1308,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 @@ -1328,38 +1328,38 @@ contains !$acc loop 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 !$acc loop 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) + 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) end do !$acc loop 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 !$acc loop seq do i = 1, num_fluids - 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) + 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 !$acc loop 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) @@ -1371,11 +1371,11 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop 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(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + eqn_idx%Re(i, q))/Res(i, q) & + Re_L(i) end do @@ -1387,11 +1387,11 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + eqn_idx%Re(i, q))/Res(i, q) & + Re_R(i) end do @@ -1451,7 +1451,7 @@ contains E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) end if !$acc loop seq - do i = 1, b_size - 1 + do i = 1, eqn_idx%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) end do @@ -1488,28 +1488,28 @@ contains ! COMPUTING THE DIRECT WAVE SPEEDS if (wave_speeds == 1) then if (elasticity) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4_wp*G_L)/3_wp) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4_wp*G_R)/3_wp) + tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4_wp*G_R)/3_wp) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4_wp*G_L)/3_wp) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + s_L = min(vel_L(eqn_idx%dir(1)) - sqrt(c_L*c_L + & + (((4_wp*G_L)/3_wp) + tau_e_L(eqn_idx%dir_tau(1)))/rho_L), vel_R(eqn_idx%dir(1)) - sqrt(c_R*c_R + & + (((4_wp*G_R)/3_wp) + tau_e_R(eqn_idx%dir_tau(1)))/rho_R)) + s_R = max(vel_R(eqn_idx%dir(1)) + sqrt(c_R*c_R + & + (((4_wp*G_R)/3_wp) + tau_e_R(eqn_idx%dir_tau(1)))/rho_R), vel_L(eqn_idx%dir(1)) + sqrt(c_L*c_L + & + (((4_wp*G_L)/3_wp) + tau_e_L(eqn_idx%dir_tau(1)))/rho_L)) + s_S = (pres_R - tau_e_R(eqn_idx%dir_tau(1)) - pres_L + & + tau_e_L(eqn_idx%dir_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & rho_R*(s_R - vel_R(idx1))) else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + s_L = min(vel_L(eqn_idx%dir(1)) - c_L, vel_R(eqn_idx%dir(1)) - c_R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_R, vel_L(eqn_idx%dir(1)) + c_L) + s_S = (pres_R - pres_L + rho_L*vel_L(eqn_idx%dir(1))* & + (s_L - vel_L(eqn_idx%dir(1))) - rho_R*vel_R(eqn_idx%dir(1))*(s_R - vel_R(eqn_idx%dir(1)))) & + /(rho_L*(s_L - vel_L(eqn_idx%dir(1))) - rho_R*(s_R - vel_R(eqn_idx%dir(1)))) end if elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(eqn_idx%dir(1)) - & + vel_R(eqn_idx%dir(1)))) pres_SR = pres_SL @@ -1520,10 +1520,10 @@ contains (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R + s_L = vel_L(eqn_idx%dir(1)) - c_L*Ms_L + s_R = vel_R(eqn_idx%dir(1)) + c_R*Ms_R - s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1547,12 +1547,12 @@ contains xi_MP = -min(0._wp, sign(1._wp, s_L)) xi_PP = max(0._wp, sign(1._wp, s_R)) - E_star = xi_M*(E_L + xi_MP*(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*(E_R + xi_PP*(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)) - p_Star = xi_M*(pres_L + xi_MP*(rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))))) + & - xi_P*(pres_R + xi_PP*(rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))))) + E_star = xi_M*(E_L + xi_MP*(xi_L*(E_L + (s_S - vel_L(eqn_idx%dir(1)))* & + (rho_L*s_S + pres_L/(s_L - vel_L(eqn_idx%dir(1))))) - E_L)) + & + xi_P*(E_R + xi_PP*(xi_R*(E_R + (s_S - vel_R(eqn_idx%dir(1)))* & + (rho_R*s_S + pres_R/(s_R - vel_R(eqn_idx%dir(1))))) - E_R)) + p_Star = xi_M*(pres_L + xi_MP*(rho_L*(s_L - vel_L(eqn_idx%dir(1)))*(s_S - vel_L(eqn_idx%dir(1))))) + & + xi_P*(pres_R + xi_PP*(rho_R*(s_R - vel_R(eqn_idx%dir(1)))*(s_S - vel_R(eqn_idx%dir(1))))) rho_Star = xi_M*(rho_L*(xi_MP*xi_L + 1._wp - xi_MP)) + & xi_P*(rho_R*(xi_PP*xi_R + 1._wp - xi_PP)) @@ -1580,15 +1580,15 @@ contains ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = rho_Star*vel_K_Star* & - (dir_flg(idxi)*vel_K_Star + (1_wp - dir_flg(idxi))*(xi_M*vel_L(idxi) + xi_P*vel_R(idxi))) + dir_flg(idxi)*p_Star & - + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr + (eqn_idx%dir_flg(idxi)*vel_K_Star + (1_wp - eqn_idx%dir_flg(idxi))*(xi_M*vel_L(idxi) + xi_P*vel_R(idxi))) + eqn_idx%dir_flg(idxi)*p_Star & + + (s_M/s_L)*(s_P/s_R)*eqn_idx%dir_flg(idxi)*pcorr end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_star + p_Star)*vel_K_Star & + 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 @@ -1596,19 +1596,19 @@ contains flux_ene_e = 0_wp; !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) ! MOMENTUM ELASTIC FLUX. flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + - xi_M*tau_e_L(eqn_idx%dir_tau(i)) - xi_P*tau_e_R(eqn_idx%dir_tau(i)) ! ENERGY ELASTIC FLUX. flux_ene_e = flux_ene_e - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*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)))))) + xi_M*(vel_L(idxi)*tau_e_L(eqn_idx%dir_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(eqn_idx%dir_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(eqn_idx%dir_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(eqn_idx%dir_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. @@ -1622,10 +1622,10 @@ contains ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) + xi_M*(vel_L(idxi) + eqn_idx%dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & + xi_P*(vel_R(idxi) + eqn_idx%dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) end do ! INTERNAL ENERGIES ADVECTION FLUX. @@ -1671,9 +1671,9 @@ 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 @@ -1681,7 +1681,7 @@ contains if (cyl_coord) then !Substituting the advective flux into the inviscid geometrical source flux !$acc loop 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 !$acc loop seq @@ -1689,8 +1689,8 @@ 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, 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, momxb - 1 + eqn_idx%dir(1)) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + eqn_idx%dir(1)) - p_Star ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe @@ -1701,11 +1701,11 @@ contains #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq - do i = 1, sys_size + do i = 1, eqn_idx%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, momxb - 1 + eqn_idx%dir(1)) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + eqn_idx%dir(1)) - p_Star flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if @@ -1744,12 +1744,12 @@ contains !$acc loop 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) rho_L = 0._wp gamma_L = 0._wp @@ -1797,19 +1797,19 @@ contains vel_avg_rms, 0._wp, c_avg) if (wave_speeds == 1) then - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - & - rho_R*vel_R(dir_idx(1))* & - (s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - & - rho_R*(s_R - vel_R(dir_idx(1)))) + s_L = min(vel_L(eqn_idx%dir(1)) - c_L, vel_R(eqn_idx%dir(1)) - c_R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_R, vel_L(eqn_idx%dir(1)) + c_L) + + s_S = (pres_R - pres_L + rho_L*vel_L(eqn_idx%dir(1))* & + (s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*vel_R(eqn_idx%dir(1))* & + (s_R - vel_R(eqn_idx%dir(1)))) & + /(rho_L*(s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*(s_R - vel_R(eqn_idx%dir(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(eqn_idx%dir(1)) - & + vel_R(eqn_idx%dir(1)))) pres_SR = pres_SL @@ -1820,10 +1820,10 @@ contains (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R + s_L = vel_L(eqn_idx%dir(1)) - c_L*Ms_L + s_R = vel_R(eqn_idx%dir(1)) + c_R*Ms_R - s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1834,8 +1834,8 @@ contains ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) - xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) - xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) + xi_L = (s_L - vel_L(eqn_idx%dir(1)))/(s_L - s_S) + xi_R = (s_R - vel_R(eqn_idx%dir(1)))/(s_R - s_S) ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) @@ -1846,61 +1846,61 @@ contains do i = 1, contxe 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)) & + *(vel_L(eqn_idx%dir(1)) + s_M*(xi_L - 1._wp)) & + xi_P*alpha_rho_R(i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do ! Momentum flux. ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop 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) + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) = & + xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(i)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(i))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(i)))* & + vel_L(eqn_idx%dir(i))) - vel_L(eqn_idx%dir(i)))) + & + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_L) & + + xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(i)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(i))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(i)))* & + vel_R(eqn_idx%dir(i))) - vel_R(eqn_idx%dir(i)))) + & + eqn_idx%dir_flg(eqn_idx%dir(i))*pres_R) end do if (bubbles_euler) then ! Put p_tilde in !$acc loop 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, contxe + eqn_idx%dir(i)) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) + & + xi_M*(eqn_idx%dir_flg(eqn_idx%dir(i))*(-1._wp*ptilde_L)) & + + xi_P*(eqn_idx%dir_flg(eqn_idx%dir(i))*(-1._wp*ptilde_R)) end do end if - flux_rs${XYZ}$_vf(j, k, l, E_idx) = 0._wp + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = 0._wp !$acc loop 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)) & + *(vel_L(eqn_idx%dir(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)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do ! Source for volume fraction advection equation !$acc loop seq do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = 0._wp - !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp + vel_src_rs${XYZ}$_vf(j, k, l, eqn_idx%dir(i)) = 0._wp + !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(eqn_idx%dir(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, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, eqn_idx%dir(1)) ! Add advection flux for bubble variables if (bubbles_euler) then @@ -1908,9 +1908,9 @@ contains do i = bubxb, bubxe 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)) & + *(vel_L(eqn_idx%dir(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do end if @@ -1920,21 +1920,21 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux !$acc loop seq - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(1)) = & - xi_M*(rho_L*(vel_L(dir_idx(1))* & - 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, contxe + eqn_idx%dir(1)) = & + xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(1)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_L(eqn_idx%dir(1))) - vel_L(eqn_idx%dir(1))))) & + + xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(1)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_R(eqn_idx%dir(1))) - vel_R(eqn_idx%dir(1))))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe @@ -1945,20 +1945,20 @@ contains #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq - do i = 1, sys_size + do i = 1, eqn_idx%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) = & - -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))))) + -xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(1)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_L(eqn_idx%dir(1))) - vel_L(eqn_idx%dir(1))))) & + - xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(1)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_R(eqn_idx%dir(1))) - vel_R(eqn_idx%dir(1))))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if #:endif @@ -1976,8 +1976,8 @@ contains !$acc loop 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 @@ -1990,8 +1990,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 @@ -2003,16 +2003,16 @@ contains !$acc loop 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) end do else if (num_fluids > 2) then !$acc loop 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) end do else @@ -2031,16 +2031,16 @@ contains !$acc loop seq do i = 1, num_fluids 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 !$acc loop seq do i = 1, num_fluids - 1 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 @@ -2056,11 +2056,11 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop 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(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_L(i) = (1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + eqn_idx%Re(i, q)))/Res(i, q) & + Re_L(i) end do @@ -2072,11 +2072,11 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + eqn_idx%Re(i, q)))/Res(i, q) & + Re_R(i) end do @@ -2108,8 +2108,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_denom = 0._wp nbub_R_denom = 0._wp @@ -2118,8 +2118,8 @@ contains nbub_L_denom = nbub_L_denom + (R0_L(i)**3._wp)*weight(i) nbub_R_denom = nbub_R_denom + (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_denom - nbub_R = (3._wp/(4._wp*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)/nbub_R_denom + nbub_L = (3._wp/(4._wp*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_L_denom + nbub_R = (3._wp/(4._wp*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + num_fluids)/nbub_R_denom end if else !nb stored in 0th moment of first R0 bin in variable conversion module @@ -2173,17 +2173,17 @@ contains end do end if - if (qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids) < small_alf .or. R3Lbar < small_alf) then - ptilde_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids)*pres_L + if (qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + num_fluids) < small_alf .or. R3Lbar < small_alf) then + ptilde_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + num_fluids)*pres_L else - ptilde_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids)*(pres_L - PbwR3Lbar/R3Lbar - & + ptilde_L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + num_fluids)*(pres_L - PbwR3Lbar/R3Lbar - & rho_L*R3V2Lbar/R3Lbar) end if - if (qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids) < small_alf .or. R3Rbar < small_alf) then - ptilde_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)*pres_R + if (qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + num_fluids) < small_alf .or. R3Rbar < small_alf) then + ptilde_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + num_fluids)*pres_R else - ptilde_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)*(pres_R - PbwR3Rbar/R3Rbar - & + ptilde_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + num_fluids)*(pres_R - PbwR3Rbar/R3Rbar - & rho_R*R3V2Rbar/R3Rbar) end if @@ -2226,19 +2226,19 @@ contains end if if (wave_speeds == 1) then - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - & - rho_R*vel_R(dir_idx(1))* & - (s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - & - rho_R*(s_R - vel_R(dir_idx(1)))) + s_L = min(vel_L(eqn_idx%dir(1)) - c_L, vel_R(eqn_idx%dir(1)) - c_R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_R, vel_L(eqn_idx%dir(1)) + c_L) + + s_S = (pres_R - pres_L + rho_L*vel_L(eqn_idx%dir(1))* & + (s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*vel_R(eqn_idx%dir(1))* & + (s_R - vel_R(eqn_idx%dir(1)))) & + /(rho_L*(s_L - vel_L(eqn_idx%dir(1))) - & + rho_R*(s_R - vel_R(eqn_idx%dir(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(eqn_idx%dir(1)) - & + vel_R(eqn_idx%dir(1)))) pres_SR = pres_SL @@ -2249,10 +2249,10 @@ contains (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R + s_L = vel_L(eqn_idx%dir(1)) - c_L*Ms_L + s_R = vel_R(eqn_idx%dir(1)) + c_R*Ms_R - s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(eqn_idx%dir(1)) + vel_R(eqn_idx%dir(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -2263,8 +2263,8 @@ contains ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) - xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) - xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) + xi_L = (s_L - vel_L(eqn_idx%dir(1)))/(s_L - s_S) + xi_R = (s_R - vel_R(eqn_idx%dir(1)))/(s_R - s_S) ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) @@ -2282,9 +2282,9 @@ contains do i = 1, contxe 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)) & + *(vel_L(eqn_idx%dir(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)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do if (bubbles_euler .and. (num_fluids > 1)) then @@ -2299,33 +2299,33 @@ contains !$acc loop 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 - ptilde_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 - ptilde_R)) & - + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(i)) = & + xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(i)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(i))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(i)))* & + vel_L(eqn_idx%dir(i))) - vel_L(eqn_idx%dir(i)))) + & + eqn_idx%dir_flg(eqn_idx%dir(i))*(pres_L - ptilde_L)) & + + xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(i)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(i))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(i)))* & + vel_R(eqn_idx%dir(i))) - vel_R(eqn_idx%dir(i)))) + & + eqn_idx%dir_flg(eqn_idx%dir(i))*(pres_R - ptilde_R)) & + + (s_M/s_L)*(s_P/s_R)*eqn_idx%dir_flg(eqn_idx%dir(i))*pcorr end do ! Energy flux. ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & + xi_M*(vel_L(eqn_idx%dir(1))*(E_L + pres_L - ptilde_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(eqn_idx%dir(1)))* & (rho_L*s_S + (pres_L - ptilde_L)/ & - (s_L - vel_L(dir_idx(1))))) - E_L)) & - + xi_P*(vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & + (s_L - vel_L(eqn_idx%dir(1))))) - E_L)) & + + xi_P*(vel_R(eqn_idx%dir(1))*(E_R + pres_R - ptilde_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(eqn_idx%dir(1)))* & (rho_R*s_S + (pres_R - ptilde_R)/ & - (s_R - vel_R(dir_idx(1))))) - E_R)) & + (s_R - vel_R(eqn_idx%dir(1))))) - E_R)) & + (s_M/s_L)*(s_P/s_R)*pcorr*s_S ! Volume fraction flux @@ -2333,51 +2333,51 @@ contains do i = advxb, advxe 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)) & + *(vel_L(eqn_idx%dir(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)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do ! Source for volume fraction advection equation !$acc loop seq do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & - xi_M*(vel_L(dir_idx(i)) + & - dir_flg(dir_idx(i))* & + vel_src_rs${XYZ}$_vf(j, k, l, eqn_idx%dir(i)) = & + xi_M*(vel_L(eqn_idx%dir(i)) + & + eqn_idx%dir_flg(eqn_idx%dir(i))* & s_M*(xi_L - 1._wp)) & - + xi_P*(vel_R(dir_idx(i)) + & - dir_flg(dir_idx(i))* & + + xi_P*(vel_R(eqn_idx%dir(i)) + & + eqn_idx%dir_flg(eqn_idx%dir(i))* & s_P*(xi_R - 1._wp)) !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(idxi)%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, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, eqn_idx%dir(1)) ! Add advection flux for bubble variables !$acc loop seq do i = bubxb, bubxe 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)) & + *(vel_L(eqn_idx%dir(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end do 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)) & + *(vel_L(eqn_idx%dir(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end if if (adv_n) then - flux_rs${XYZ}$_vf(j, k, l, n_idx) = & + 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)) & + *(vel_L(eqn_idx%dir(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) + *(vel_R(eqn_idx%dir(1)) + s_P*(xi_R - 1._wp)) end if ! Geometrical source flux for cylindrical coordinates @@ -2385,21 +2385,21 @@ contains if (cyl_coord) then ! Substituting the advective flux into the inviscid geometrical source flux !$acc loop seq - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(1)) = & - xi_M*(rho_L*(vel_L(dir_idx(1))* & - 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, contxe + eqn_idx%dir(1)) = & + xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(1)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_L(eqn_idx%dir(1))) - vel_L(eqn_idx%dir(1))))) & + + xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(1)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_R(eqn_idx%dir(1))) - vel_R(eqn_idx%dir(1))))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe @@ -2410,21 +2410,21 @@ contains #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq - do i = 1, sys_size + do i = 1, eqn_idx%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) = & - -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))))) + -xi_M*(rho_L*(vel_L(eqn_idx%dir(1))* & + vel_L(eqn_idx%dir(1)) + & + s_M*(xi_L*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_L(eqn_idx%dir(1))) - vel_L(eqn_idx%dir(1))))) & + - xi_P*(rho_R*(vel_R(eqn_idx%dir(1))* & + vel_R(eqn_idx%dir(1)) + & + s_P*(xi_R*(eqn_idx%dir_flg(eqn_idx%dir(1))*s_S + & + (1._wp - eqn_idx%dir_flg(eqn_idx%dir(1)))* & + vel_R(eqn_idx%dir(1))) - vel_R(eqn_idx%dir(1))))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if @@ -2444,12 +2444,12 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end - !idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + !idx1 = 1; if (eqn_idx%dir(1) == 2) idx1 = 2; if (eqn_idx%dir(1) == 3) idx1 = 3 !$acc loop 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 @@ -2461,8 +2461,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 @@ -2483,38 +2483,38 @@ contains !$acc loop 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 !$acc loop 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) + 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) end do !$acc loop 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 !$acc loop seq do i = 1, num_fluids - 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) + 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 !$acc loop 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 @@ -2523,11 +2523,11 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop 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(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + eqn_idx%Re(i, q))/Res(i, q) & + Re_L(i) end do @@ -2539,11 +2539,11 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + eqn_idx%Re(i, q))/Res(i, q) & + Re_R(i) end do @@ -2660,7 +2660,7 @@ contains E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) end if !$acc loop seq - do i = 1, b_size - 1 + do i = 1, eqn_idx%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) end do @@ -2696,22 +2696,22 @@ contains if (wave_speeds == 1) then if (elasticity) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4_wp*G_L)/3_wp) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4_wp*G_R)/3_wp) + tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4_wp*G_R)/3_wp) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4_wp*G_L)/3_wp) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + s_L = min(vel_L(eqn_idx%dir(1)) - sqrt(c_L*c_L + & + (((4_wp*G_L)/3_wp) + tau_e_L(eqn_idx%dir_tau(1)))/rho_L), vel_R(eqn_idx%dir(1)) - sqrt(c_R*c_R + & + (((4_wp*G_R)/3_wp) + tau_e_R(eqn_idx%dir_tau(1)))/rho_R)) + s_R = max(vel_R(eqn_idx%dir(1)) + sqrt(c_R*c_R + & + (((4_wp*G_R)/3_wp) + tau_e_R(eqn_idx%dir_tau(1)))/rho_R), vel_L(eqn_idx%dir(1)) + sqrt(c_L*c_L + & + (((4_wp*G_L)/3_wp) + tau_e_L(eqn_idx%dir_tau(1)))/rho_L)) + s_S = (pres_R - tau_e_R(eqn_idx%dir_tau(1)) - pres_L + & + tau_e_L(eqn_idx%dir_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & rho_R*(s_R - vel_R(idx1))) else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + s_L = min(vel_L(eqn_idx%dir(1)) - c_L, vel_R(eqn_idx%dir(1)) - c_R) + s_R = max(vel_R(eqn_idx%dir(1)) + c_R, vel_L(eqn_idx%dir(1)) + c_L) + s_S = (pres_R - pres_L + rho_L*vel_L(eqn_idx%dir(1))* & + (s_L - vel_L(eqn_idx%dir(1))) - rho_R*vel_R(eqn_idx%dir(1))*(s_R - vel_R(eqn_idx%dir(1)))) & + /(rho_L*(s_L - vel_L(eqn_idx%dir(1))) - rho_R*(s_R - vel_R(eqn_idx%dir(1)))) end if elseif (wave_speeds == 2) then @@ -2772,26 +2772,26 @@ contains ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & xi_M*(rho_L*(vel_L(idx1)* & vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1._wp - dir_flg(idxi))* & + s_M*(xi_L*(eqn_idx%dir_flg(idxi)*s_S + & + (1._wp - eqn_idx%dir_flg(idxi))* & vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) & + eqn_idx%dir_flg(idxi)*(pres_L)) & + xi_P*(rho_R*(vel_R(idx1)* & vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1._wp - dir_flg(idxi))* & + s_P*(xi_R*(eqn_idx%dir_flg(idxi)*s_S + & + (1._wp - eqn_idx%dir_flg(idxi))* & vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R)) & - + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr + eqn_idx%dir_flg(idxi)*(pres_R)) & + + (s_M/s_L)*(s_P/s_R)*eqn_idx%dir_flg(idxi)*pcorr end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%E) = & xi_M*(vel_L(idx1)*(E_L + pres_L) + & s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & (rho_L*s_S + pres_L/ & @@ -2807,19 +2807,19 @@ contains flux_ene_e = 0_wp !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) ! MOMENTUM ELASTIC FLUX. flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + - xi_M*tau_e_L(eqn_idx%dir_tau(i)) - xi_P*tau_e_R(eqn_idx%dir_tau(i)) ! ENERGY ELASTIC FLUX. flux_ene_e = flux_ene_e - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*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)))))) + xi_M*(vel_L(idxi)*tau_e_L(eqn_idx%dir_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(eqn_idx%dir_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(eqn_idx%dir_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(eqn_idx%dir_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. @@ -2845,22 +2845,22 @@ contains ! VOLUME FRACTION SOURCE FLUX. !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) + idxi = eqn_idx%dir(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & xi_M*(vel_L(idxi) + & - dir_flg(idxi)* & + eqn_idx%dir_flg(idxi)* & s_M*(xi_L - 1._wp)) & + xi_P*(vel_R(idxi) + & - dir_flg(idxi)* & + eqn_idx%dir_flg(idxi)* & s_P*(xi_R - 1._wp)) end do ! 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) & + 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(idx1) + s_M*(xi_L - 1._wp)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%c) & *(vel_R(idx1) + s_P*(xi_R - 1._wp)) end if @@ -2895,20 +2895,20 @@ contains if (cyl_coord) then !Substituting the advective flux into the inviscid geometrical source flux !$acc loop seq - do i = 1, E_idx + do i = 1, eqn_idx%E flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux flux_gsrc_rs${XYZ}$_vf(j, k, l, contxe + idx1) = & xi_M*(rho_L*(vel_L(idx1)* & vel_L(idx1) + & - s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1._wp - dir_flg(idx1))* & + s_M*(xi_L*(eqn_idx%dir_flg(idx1)*s_S + & + (1._wp - eqn_idx%dir_flg(idx1))* & vel_L(idx1)) - vel_L(idx1)))) & + xi_P*(rho_R*(vel_R(idx1)* & vel_R(idx1) + & - s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1._wp - dir_flg(idx1))* & + s_P*(xi_R*(eqn_idx%dir_flg(idx1)*s_S + & + (1._wp - eqn_idx%dir_flg(idx1))* & vel_R(idx1)) - vel_R(idx1)))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq @@ -2920,20 +2920,20 @@ contains #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq - do i = 1, sys_size + do i = 1, eqn_idx%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) = & -xi_M*(rho_L*(vel_L(idx1)* & vel_L(idx1) + & - s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1._wp - dir_flg(idx1))* & + s_M*(xi_L*(eqn_idx%dir_flg(idx1)*s_S + & + (1._wp - eqn_idx%dir_flg(idx1))* & vel_L(idx1)) - vel_L(idx1)))) & - xi_P*(rho_R*(vel_R(idx1)* & vel_R(idx1) + & - s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1._wp - dir_flg(idx1))* & + s_P*(xi_R*(eqn_idx%dir_flg(idx1)*s_S + & + (1._wp - eqn_idx%dir_flg(idx1))* & vel_R(idx1)) - vel_R(idx1)))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) @@ -3011,8 +3011,8 @@ contains type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz @@ -3070,39 +3070,39 @@ contains 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 + ! NOTE: unlike HLL & HLLC, vel_L here is permutated by eqn_idx%dir 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, contxe + eqn_idx%dir(i)) + vel%R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + eqn_idx%dir(i)) end do vel_rms%L = sum(vel%L**2._wp) vel_rms%R = sum(vel%R**2._wp) do i = 1, num_fluids - alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) - alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) + alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E + i) + alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E + i) end do - pres%L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) - pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) + pres%L = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%E) + pres%R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%E) - ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic + ! NOTE: unlike HLL, Bx, By, Bz are permutated by eqn_idx%dir 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(1) = Bx0 B%R(1) = Bx0 - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + 1) else ! 2D/3D: Bx, By, Bz as variables - B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(1) - 1) - B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(1) - 1) - B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2) - 1) - B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(2) - 1) - B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3) - 1) - B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(3) - 1) + B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + eqn_idx%dir(1) - 1) + B%R(1) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + eqn_idx%dir(1) - 1) + B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + eqn_idx%dir(2) - 1) + B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + eqn_idx%dir(2) - 1) + B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + eqn_idx%dir(3) - 1) + B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, eqn_idx%B%beg + eqn_idx%dir(3) - 1) end if end if @@ -3265,19 +3265,19 @@ contains ! Mass 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, contxe + eqn_idx%dir(1)) = F_hlld(2) + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(2)) = F_hlld(3) + flux_rs${XYZ}$_vf(j, k, l, contxe + eqn_idx%dir(3)) = F_hlld(4) ! Magnetic field if (n == 0) then - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) = F_hlld(6) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + 1) = F_hlld(6) else - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2) - 1) = F_hlld(5) - flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3) - 1) = F_hlld(6) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + eqn_idx%dir(2) - 1) = F_hlld(5) + flux_rs${XYZ}$_vf(j, k, l, eqn_idx%B%beg + eqn_idx%dir(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) ! Partial fraction !$acc loop seq do i = advxb, advxe @@ -3314,16 +3314,16 @@ contains !$acc update device(Gs) if (viscous) then - @:ALLOCATE(Res(1:2, 1:maxval(Re_size))) + @:ALLOCATE(Res(1:2, 1:maxval(eqn_idx%Re_size))) end if if (viscous) then do i = 1, 2 - do j = 1, Re_size(i) - Res(i, j) = fluid_pp(Re_idx(i, j))%Re(i) + do j = 1, eqn_idx%Re_size(i) + Res(i, j) = fluid_pp(eqn_idx%Re(i, j))%Re(i) end do end do - !$acc update device(Res, Re_idx, Re_size) + !$acc update device(Res, eqn_idx%Re, Re_size) end if !$acc enter data copyin(is1, is2, is3, isx, isy, isz) @@ -3333,13 +3333,13 @@ contains @:ALLOCATE(flux_rsx_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_gsrc_rsx_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, advxb:sys_size)) + is3%beg:is3%end, advxb:eqn_idx%sys_size)) @:ALLOCATE(vel_src_rsx_vf(is1%beg:is1%end, & is2%beg:is2%end, & is3%beg:is3%end, 1:num_vels)) @@ -3360,13 +3360,13 @@ contains @:ALLOCATE(flux_rsy_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_gsrc_rsy_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, advxb:sys_size)) + is3%beg:is3%end, advxb:eqn_idx%sys_size)) @:ALLOCATE(vel_src_rsy_vf(is1%beg:is1%end, & is2%beg:is2%end, & is3%beg:is3%end, 1:num_vels)) @@ -3388,13 +3388,13 @@ contains @:ALLOCATE(flux_rsz_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_gsrc_rsz_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, 1:sys_size)) + is3%beg:is3%end, 1:eqn_idx%sys_size)) @:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, & is2%beg:is2%end, & - is3%beg:is3%end, advxb:sys_size)) + is3%beg:is3%end, advxb:eqn_idx%sys_size)) @:ALLOCATE(vel_src_rsz_vf(is1%beg:is1%end, & is2%beg:is2%end, & is3%beg:is3%end, 1:num_vels)) @@ -3460,37 +3460,37 @@ contains if (norm_dir == 1) then is1 = ix; is2 = iy; is3 = iz - dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/) + eqn_idx%dir = (/1, 2, 3/); eqn_idx%dir_flg = (/1._wp, 0._wp, 0._wp/) elseif (norm_dir == 2) then is1 = iy; is2 = ix; is3 = iz - dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/) + eqn_idx%dir = (/2, 1, 3/); eqn_idx%dir_flg = (/0._wp, 1._wp, 0._wp/) else is1 = iz; is2 = iy; is3 = ix - dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/) + eqn_idx%dir = (/3, 1, 2/); eqn_idx%dir_flg = (/0._wp, 0._wp, 1._wp/) end if !$acc update device(is1, is2, is3) if (elasticity) then if (norm_dir == 1) then - dir_idx_tau = (/1, 2, 4/) + eqn_idx%dir_tau = (/1, 2, 4/) else if (norm_dir == 2) then - dir_idx_tau = (/3, 2, 5/) + eqn_idx%dir_tau = (/3, 2, 5/) else - dir_idx_tau = (/6, 4, 5/) + eqn_idx%dir_tau = (/6, 4, 5/) end if end if isx = ix; isy = iy; isz = iz !$acc update device(isx, isy, isz) ! for stuff in the same module - !$acc update device(dir_idx, dir_flg, dir_idx_tau) ! for stuff in different modules + !$acc update device(eqn_idx%dir, eqn_idx%dir_flg, eqn_idx%dir_tau) ! for stuff in different modules ! Population of Buffers in x-direction if (norm_dir == 1) then if (bc_x%beg == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at beginning !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qL_prim_rsx_vf(-1, k, l, i) = & @@ -3545,7 +3545,7 @@ contains if (bc_x%end == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at end !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qR_prim_rsx_vf(m + 1, k, l, i) = & @@ -3604,7 +3604,7 @@ contains if (bc_y%beg == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at beginning !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qL_prim_rsy_vf(-1, k, l, i) = & @@ -3654,7 +3654,7 @@ contains if (bc_y%end == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at end !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qR_prim_rsy_vf(n + 1, k, l, i) = & @@ -3707,7 +3707,7 @@ contains if (bc_z%beg == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at beginning !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qL_prim_rsz_vf(-1, k, l, i) = & @@ -3751,7 +3751,7 @@ contains if (bc_z%end == BC_RIEMANN_EXTRAP) then ! Riemann state extrap. BC at end !$acc parallel loop collapse(3) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do k = is2%beg, is2%end qR_prim_rsz_vf(p + 1, k, l, i) = & @@ -3820,7 +3820,7 @@ contains norm_dir) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_src_vf integer, intent(in) :: norm_dir @@ -3834,7 +3834,7 @@ contains if (viscous .or. (surface_tension)) then !$acc parallel loop collapse(4) gang vector default(present) - 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 @@ -3864,7 +3864,7 @@ contains if (viscous .or. (surface_tension)) then !$acc parallel loop collapse(4) gang vector default(present) - 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 @@ -3893,7 +3893,7 @@ contains if (viscous .or. (surface_tension)) then !$acc parallel loop collapse(4) gang vector default(present) - 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 @@ -3933,7 +3933,7 @@ contains !! @param[in] dvelR_dx_vf Right boundary $\partial v_i/\partial x$ (num_dims scalar_field). !! @param[in] dvelR_dy_vf Right boundary $\partial v_i/\partial y$ (num_dims scalar_field). !! @param[in] dvelR_dz_vf Right boundary $\partial v_i/\partial z$ (num_dims scalar_field). - !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field). + !! @param[inout] flux_src_vf Intercell source flux array to update (eqn_idx%sys_size scalar_field). !! @param[in] norm_dir Interface normal direction (1=x-face, 2=y-face, 3=z-face). !! @param[in] ix Global X-direction loop bounds (int_bounds_info). !! @param[in] iy Global Y-direction loop bounds (int_bounds_info). @@ -3948,7 +3948,7 @@ contains type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf - type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: flux_src_vf integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz @@ -4066,7 +4066,7 @@ contains !$acc loop seq do i_vel = 1, num_dims flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) = flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) - stress_vector_shear(i_vel) - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - vel_src_int(i_vel)*stress_vector_shear(i_vel) + flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - vel_src_int(i_vel)*stress_vector_shear(i_vel) end do end if @@ -4074,7 +4074,7 @@ contains stress_normal_bulk = divergence_cyl/Re_b flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) = flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) - vel_src_int(norm_dir)*stress_normal_bulk + flux_src_vf(eqn_idx%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 @@ -4095,7 +4095,7 @@ contains !! @param[in] dvelR_dx_vf Right boundary d(vel)/dx (num_dims scalar_field). !! @param[in] dvelR_dy_vf Right boundary d(vel)/dy (num_dims scalar_field). !! @param[in] dvelR_dz_vf Right boundary d(vel)/dz (num_dims scalar_field). - !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field). + !! @param[inout] flux_src_vf Intercell source flux array to update (eqn_idx%sys_size scalar_field). !! @param[in] norm_dir Interface normal direction (1=x, 2=y, 3=z). !! @param[in] ix X-direction loop bounds (int_bounds_info). !! @param[in] iy Y-direction loop bounds (int_bounds_info). @@ -4113,7 +4113,7 @@ contains type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf - type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: flux_src_vf integer, intent(in) :: norm_dir ! Local variables @@ -4195,8 +4195,8 @@ 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, l_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 @@ -4209,8 +4209,8 @@ 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, l_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 @@ -4294,7 +4294,7 @@ contains norm_dir) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf integer, intent(in) :: norm_dir @@ -4304,7 +4304,7 @@ contains ! Reshaping Outputted Data in y-direction if (norm_dir == 2) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4317,7 +4317,7 @@ contains if (cyl_coord) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end @@ -4356,7 +4356,7 @@ contains ! Reshaping Outputted Data in z-direction elseif (norm_dir == 3) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4369,7 +4369,7 @@ contains end do if (grid_geometry == 3) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end @@ -4408,7 +4408,7 @@ contains end if elseif (norm_dir == 1) then !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size 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.f90 b/src/simulation/m_sim_helpers.f90 index a05ba92bf1..98176b6a07 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -36,7 +36,7 @@ pure subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, a !$acc routine seq #endif - type(scalar_field), intent(in), dimension(sys_size) :: q_prim_vf + type(scalar_field), intent(in), dimension(eqn_idx%sys_size) :: q_prim_vf real(wp), intent(inout), dimension(num_fluids) :: alpha real(wp), intent(inout), dimension(num_vels) :: vel real(wp), intent(inout) :: rho, gamma, pi_inf, vel_sum, H, pres @@ -51,7 +51,7 @@ pure subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, a !$acc loop seq do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) - alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) + alpha(i) = q_prim_vf(eqn_idx%E + i)%sf(j, k, l) end do if (elasticity) then @@ -74,7 +74,7 @@ pure subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, a vel_sum = vel_sum + vel(i)**2._wp end do - 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 + 5e-1_wp*rho*vel_sum + qv @@ -260,7 +260,7 @@ pure subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) end if - if (any(re_size > 0)) then + if (any(eqn_idx%re_size > 0)) then max_dt(j, k, l) = min(icfl_dt, vcfl_dt) else max_dt(j, k, l) = icfl_dt diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index dbfda5f83b..cbb8565178 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -115,7 +115,7 @@ contains impure subroutine s_read_data_files(q_cons_vf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: q_cons_vf @@ -258,7 +258,7 @@ contains !! @param q_cons_vf Cell-averaged conservative variables impure subroutine s_read_serial_data_files(q_cons_vf) - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_cons_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(INOUT) :: q_cons_vf character(LEN=path_len + 2*name_len) :: t_step_dir !< @@ -365,7 +365,7 @@ contains end if - do i = 1, sys_size + do i = 1, eqn_idx%sys_size write (file_path, '(A,I0,A)') & trim(t_step_dir)//'/q_cons_vf', i, '.dat' inquire (FILE=trim(file_path), EXIST=file_exist) @@ -386,7 +386,7 @@ contains do i = 1, nb do r = 1, nnode write (file_path, '(A,I0,A)') & - trim(t_step_dir)//'/pb', sys_size + (i - 1)*nnode + r, '.dat' + trim(t_step_dir)//'/pb', eqn_idx%sys_size + (i - 1)*nnode + r, '.dat' inquire (FILE=trim(file_path), EXIST=file_exist) if (file_exist) then open (2, FILE=trim(file_path), & @@ -402,7 +402,7 @@ contains do i = 1, nb do r = 1, nnode write (file_path, '(A,I0,A)') & - trim(t_step_dir)//'/mv', sys_size + (i - 1)*nnode + r, '.dat' + trim(t_step_dir)//'/mv', eqn_idx%sys_size + (i - 1)*nnode + r, '.dat' inquire (FILE=trim(file_path), EXIST=file_exist) if (file_exist) then open (2, FILE=trim(file_path), & @@ -504,7 +504,7 @@ contains impure subroutine s_read_parallel_data_files(q_cons_vf) type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(INOUT) :: q_cons_vf #ifdef MFC_MPI @@ -638,12 +638,12 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Read the data for each variable if (bubbles_euler .or. elasticity) then - do i = 1, sys_size!adv_idx%end + do i = 1, eqn_idx%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, & @@ -651,7 +651,7 @@ contains end do !Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -659,7 +659,7 @@ contains end do end if else - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & @@ -774,11 +774,11 @@ contains WP_MOK = int(8._wp, MPI_OFFSET_KIND) MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + NVARS_MOK = int(eqn_idx%sys_size, MPI_OFFSET_KIND) ! Read the data for each variable if (bubbles_euler .or. elasticity) then - do i = 1, sys_size !adv_idx%end + do i = 1, eqn_idx%sys_size !eqn_idx%adv%end var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -790,7 +790,7 @@ contains end do !Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then - do i = sys_size + 1, sys_size + 2*nb*nnode + do i = eqn_idx%sys_size + 1, eqn_idx%sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -802,7 +802,7 @@ contains end do end if else - do i = 1, sys_size + do i = 1, eqn_idx%sys_size var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file @@ -1178,7 +1178,7 @@ contains !! @param v_vf conservative variables subroutine s_initialize_internal_energy_equations(v_vf) - type(scalar_field), dimension(sys_size), intent(inout) :: v_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(inout) :: v_vf real(wp) :: rho real(wp) :: dyn_pres @@ -1205,7 +1205,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 = eqn_idx%mom%beg, eqn_idx%mom%end dyn_pres = dyn_pres + 5e-1_wp*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & /max(rho, sgm_eps) end do @@ -1218,19 +1218,19 @@ 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(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg+1)%sf(j, k, l)**2) else - pres_mag = 0.5_wp*(v_vf(B_idx%beg)%sf(j, k, l)**2 + v_vf(B_idx%beg+1)%sf(j, k, l)**2 + v_vf(B_idx%beg+2)%sf(j, k, l)**2) + pres_mag = 0.5_wp*(v_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg+1)%sf(j, k, l)**2 + v_vf(eqn_idx%B%beg+2)%sf(j, k, l)**2) end if end if - call s_compute_pressure(v_vf(E_idx)%sf(j, k, l), 0._wp, & + call s_compute_pressure(v_vf(eqn_idx%E)%sf(j, k, l), 0._wp, & dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres, T, pres_mag = pres_mag) do i = 1, num_fluids - v_vf(i + internalEnergies_idx%beg - 1)%sf(j, k, l) = v_vf(i + adv_idx%beg - 1)%sf(j, k, l)* & + v_vf(i + eqn_idx%internalEnergies%beg - 1)%sf(j, k, l) = v_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)* & (fluid_pp(i)%gamma*pres + fluid_pp(i)%pi_inf) & - + v_vf(i + cont_idx%beg - 1)%sf(j, k, l)*fluid_pp(i)%qv + + v_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*fluid_pp(i)%qv end do end do @@ -1290,7 +1290,7 @@ contains end if if (probe_wrt) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size !$acc update host(q_cons_ts(1)%vf(i)%sf) end do end if @@ -1352,7 +1352,7 @@ contains io_time_final = maxval(io_proc_time) end if - grind_time = time_final*1.0e9_wp/(sys_size*maxval((/1,m_glb/))*maxval((/1,n_glb/))*maxval((/1,p_glb/))) + grind_time = time_final*1.0e9_wp/(eqn_idx%sys_size*maxval((/1,m_glb/))*maxval((/1,n_glb/))*maxval((/1,p_glb/))) print *, "Performance:", grind_time, "ns/gp/eq/rhs" inquire (FILE='time_data.dat', EXIST=file_exists) @@ -1393,7 +1393,7 @@ contains call cpu_time(start) call nvtxStartRange("SAVE-DATA") - do i = 1, sys_size + do i = 1, eqn_idx%sys_size !$acc update host(q_cons_ts(1)%vf(i)%sf) do l = 0, p do k = 0, n @@ -1624,7 +1624,7 @@ contains subroutine s_initialize_gpu_vars integer :: i !Update GPU DATA - do i = 1, sys_size + do i = 1, eqn_idx%sys_size !$acc update device(q_cons_ts(1)%vf(i)%sf) end do @@ -1634,7 +1634,7 @@ contains if (chemistry) then !$acc update device(q_T_sf%sf) end if - !$acc update device(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles_euler, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma, adv_n, adap_dt, adap_dt_tol, n_idx, pi_fac, low_Mach) + !$acc update device(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles_euler, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma, adv_n, adap_dt, adap_dt_tol, eqn_idx%n, pi_fac, low_Mach) !$acc update device(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) !$acc update device(acoustic_source, num_source) diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 5cf87531aa..3d0798a706 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -74,7 +74,7 @@ contains real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsy_vf real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsz_vf type(scalar_field), & - dimension(sys_size), & + dimension(eqn_idx%sys_size), & intent(inout) :: flux_src_vf integer, intent(in) :: id type(int_bounds_info), intent(in) :: isx, isy, isz @@ -117,12 +117,12 @@ contains 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) + & + 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 - flux_src_vf(E_idx)%sf(j, k, l) = flux_src_vf(E_idx)%sf(j, k, l) + & + 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 @@ -163,12 +163,12 @@ contains 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) + & + 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, l) + & + 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 @@ -209,12 +209,12 @@ contains 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) + & + 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, l) + & + 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 @@ -227,7 +227,7 @@ contains impure subroutine s_get_capilary(q_prim_vf, bc_type) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type type(int_bounds_info) :: isx, isy, isz @@ -245,7 +245,7 @@ contains 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)) + (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 @@ -255,7 +255,7 @@ contains 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)) + (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 @@ -266,7 +266,7 @@ contains 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)) + (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 @@ -289,7 +289,7 @@ contains end do end do - call s_populate_capillary_buffers(c_divs, bc_type) + call s_populate_capillary_buffers(c_divs, bc_type, bc_bound) iv%beg = 1; iv%end = num_dims + 1 diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 9a7f64775d..bde59f031a 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -99,11 +99,11 @@ contains @:ALLOCATE(q_cons_ts(1:num_ts)) do i = 1, num_ts - @:ALLOCATE(q_cons_ts(i)%vf(1:sys_size)) + @:ALLOCATE(q_cons_ts(i)%vf(1:eqn_idx%sys_size)) end do do i = 1, num_ts - do j = 1, sys_size + do j = 1, eqn_idx%sys_size @:ALLOCATE(q_cons_ts(i)%vf(j)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -116,11 +116,11 @@ contains @:ALLOCATE(q_prim_ts(0:3)) do i = 0, 3 - @:ALLOCATE(q_prim_ts(i)%vf(1:sys_size)) + @:ALLOCATE(q_prim_ts(i)%vf(1:eqn_idx%sys_size)) end do do i = 0, 3 - do j = 1, sys_size + do j = 1, eqn_idx%sys_size @:ALLOCATE(q_prim_ts(i)%vf(j)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -133,9 +133,9 @@ contains end if ! Allocating the cell-average primitive variables - @:ALLOCATE(q_prim_vf(1:sys_size)) + @:ALLOCATE(q_prim_vf(1:eqn_idx%sys_size)) - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -143,22 +143,22 @@ contains end do if (bubbles_euler) then - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) end do if (adv_n) then - @:ALLOCATE(q_prim_vf(n_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%n)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(n_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%n)) end if end if if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -167,7 +167,7 @@ contains end if if (elasticity) then - do i = stress_idx%beg, stress_idx%end + do i = eqn_idx%stress%beg, eqn_idx%stress%end @:ALLOCATE(q_prim_vf(i)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) @@ -185,14 +185,14 @@ contains end if if (cont_damage) then - @:ALLOCATE(q_prim_vf(damage_idx)%sf(idwbuff(1)%beg:idwbuff(1)%end, & + @:ALLOCATE(q_prim_vf(eqn_idx%damage)%sf(idwbuff(1)%beg:idwbuff(1)%end, & idwbuff(2)%beg:idwbuff(2)%end, & idwbuff(3)%beg:idwbuff(3)%end)) - @:ACC_SETUP_SFs(q_prim_vf(damage_idx)) + @:ACC_SETUP_SFs(q_prim_vf(eqn_idx%damage)) end if if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end + do i = eqn_idx%internalEnergies%beg, eqn_idx%internalEnergies%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)) @@ -201,10 +201,10 @@ contains end if if (surface_tension) then - @:ALLOCATE(q_prim_vf(c_idx)%sf(idwbuff(1)%beg:idwbuff(1)%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 @@ -303,9 +303,9 @@ contains end if ! Allocating the cell-average RHS variables - @:ALLOCATE(rhs_vf(1:sys_size)) + @:ALLOCATE(rhs_vf(1:eqn_idx%sys_size)) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size @:ALLOCATE(rhs_vf(i)%sf(0:m, 0:n, 0:p)) @:ACC_SETUP_SFs(rhs_vf(i)) end do @@ -380,7 +380,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=1) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -482,7 +482,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=1) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -554,7 +554,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=2) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -664,7 +664,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=1) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -736,7 +736,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=2) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -809,7 +809,7 @@ contains if (bubbles_lagrange .and. .not. adap_dt) call s_update_lagrange_tdv_rk(stage=3) !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size + do i = 1, eqn_idx%sys_size do l = 0, p do k = 0, n do j = 0, m @@ -941,8 +941,8 @@ contains elseif (bubbles_lagrange) then - call s_populate_variables_buffers(q_prim_vf, pb_ts(1)%sf, mv_ts(1)%sf, bc_type) - call s_compute_bubble_EL_dynamics(q_prim_vf, stage) + call s_populate_variables_buffers(q_prim_vf, pb_ts(1)%sf, mv_ts(1)%sf, bc_type, bc_bound) + call s_compute_bubble_EL_dynamics(q_cons_ts(1)%vf, q_prim_vf, t_step, rhs_vf, stage) call s_transfer_data_to_tmp() call s_smear_voidfraction() if (stage == 3) then @@ -1013,9 +1013,9 @@ contains !! Runge-Kutta stage subroutine s_apply_bodyforces(q_cons_vf, q_prim_vf, rhs_vf, ldt) - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_cons_vf - type(scalar_field), dimension(1:sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(1:sys_size), intent(inout) :: rhs_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: q_cons_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: rhs_vf real(wp), intent(in) :: ldt !< local dt @@ -1025,7 +1025,7 @@ contains call s_compute_body_forces_rhs(q_prim_vf, q_cons_vf, rhs_vf) !$acc parallel loop collapse(4) gang vector default(present) - do i = momxb, E_idx + do i = momxb, eqn_idx%E do l = 0, p do k = 0, n do j = 0, m @@ -1049,28 +1049,28 @@ contains integer :: i !< Generic loop iterator - do i = 1, sys_size + do i = 1, eqn_idx%sys_size !$acc update host(q_prim_vf(i)%sf) end do if (t_step == t_step_start) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_ts(3)%vf(i)%sf(:, :, :) = q_prim_vf(i)%sf(:, :, :) end do elseif (t_step == t_step_start + 1) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_ts(2)%vf(i)%sf(:, :, :) = q_prim_vf(i)%sf(:, :, :) end do elseif (t_step == t_step_start + 2) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_ts(1)%vf(i)%sf(:, :, :) = q_prim_vf(i)%sf(:, :, :) end do elseif (t_step == t_step_start + 3) then - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_ts(0)%vf(i)%sf(:, :, :) = q_prim_vf(i)%sf(:, :, :) end do else ! All other timesteps - do i = 1, sys_size + do i = 1, eqn_idx%sys_size q_prim_ts(3)%vf(i)%sf(:, :, :) = q_prim_ts(2)%vf(i)%sf(:, :, :) q_prim_ts(2)%vf(i)%sf(:, :, :) = q_prim_ts(1)%vf(i)%sf(:, :, :) q_prim_ts(1)%vf(i)%sf(:, :, :) = q_prim_ts(0)%vf(i)%sf(:, :, :) @@ -1088,7 +1088,7 @@ contains ! Deallocating the cell-average conservative variables do i = 1, num_ts - do j = 1, sys_size + do j = 1, eqn_idx%sys_size @:DEALLOCATE(q_cons_ts(i)%vf(j)%sf) end do @@ -1101,7 +1101,7 @@ contains ! Deallocating the cell-average primitive ts variables if (probe_wrt) then do i = 0, 3 - do j = 1, sys_size + do j = 1, eqn_idx%sys_size @:DEALLOCATE(q_prim_ts(i)%vf(j)%sf) end do @:DEALLOCATE(q_prim_ts(i)%vf) @@ -1110,18 +1110,18 @@ contains end if ! Deallocating the cell-average primitive variables - do i = 1, adv_idx%end + do i = 1, eqn_idx%adv%end @:DEALLOCATE(q_prim_vf(i)%sf) end do if (mhd) then - do i = B_idx%beg, B_idx%end + do i = eqn_idx%B%beg, eqn_idx%B%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (elasticity) then - do i = stress_idx%beg, stress_idx%end + do i = eqn_idx%stress%beg, eqn_idx%stress%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if @@ -1133,17 +1133,17 @@ contains end if if (cont_damage) then - @:DEALLOCATE(q_prim_vf(damage_idx)%sf) + @:DEALLOCATE(q_prim_vf(eqn_idx%damage)%sf) end if if (bubbles_euler) then - do i = bub_idx%beg, bub_idx%end + do i = eqn_idx%bub%beg, eqn_idx%bub%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end + do i = eqn_idx%internalEnergies%beg, eqn_idx%internalEnergies%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if @@ -1151,7 +1151,7 @@ contains @:DEALLOCATE(q_prim_vf) ! Deallocating the cell-average RHS variables - do i = 1, sys_size + do i = 1, eqn_idx%sys_size @:DEALLOCATE(rhs_vf(i)%sf) end do diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index fc73ed0743..9b2d72136d 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -35,14 +35,14 @@ contains integer :: i, j !< generic loop iterators - @:ALLOCATE(Res_viscous(1:2, 1:maxval(Re_size))) + @:ALLOCATE(Res_viscous(1:2, 1:maxval(eqn_idx%Re_size))) do i = 1, 2 - do j = 1, Re_size(i) - Res_viscous(i, j) = fluid_pp(Re_idx(i, j))%Re(i) + do j = 1, eqn_idx%Re_size(i) + Res_viscous(i, j) = fluid_pp(eqn_idx%Re(i, j))%Re(i) end do end do - !$acc update device(Res_viscous, Re_idx, Re_size) + !$acc update device(Res_viscous, eqn_idx%Re, eqn_idx%Re_size) !$acc enter data copyin(is1_viscous, is2_viscous, is3_viscous, iv) end subroutine s_initialize_viscous_module @@ -60,9 +60,9 @@ contains tau_Re_vf, & ix, iy, iz) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(eqn_idx%sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(num_dims), intent(in) :: grad_x_vf, grad_y_vf, grad_z_vf - type(scalar_field), dimension(1:sys_size), intent(inout) :: tau_Re_vf + type(scalar_field), dimension(1:eqn_idx%sys_size), intent(inout) :: tau_Re_vf type(int_bounds_info), intent(in) :: ix, iy, iz real(wp) :: rho_visc, gamma_visc, pi_inf_visc, alpha_visc_sum !< Mixture variables @@ -82,7 +82,7 @@ contains do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end !$acc loop 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 @@ -98,9 +98,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 @@ -159,10 +159,10 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_visc(i) = alpha_visc(eqn_idx%Re(i, q))/Res_viscous(i, q) & + Re_visc(i) end do @@ -186,8 +186,8 @@ contains 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) - & + 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 @@ -205,9 +205,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 @@ -266,10 +266,10 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_visc(i) = alpha_visc(eqn_idx%Re(i, q))/Res_viscous(i, q) & + Re_visc(i) end do @@ -288,8 +288,8 @@ contains 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) - & + 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 @@ -309,9 +309,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,10 +370,10 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_visc(i) = alpha_visc(eqn_idx%Re(i, q))/Res_viscous(i, q) & + Re_visc(i) end do @@ -397,8 +397,8 @@ contains 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) - & + 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 @@ -417,9 +417,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 @@ -478,10 +478,10 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0._wp + if (eqn_idx%Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq - do q = 1, Re_size(i) - Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + do q = 1, eqn_idx%Re_size(i) + Re_visc(i) = alpha_visc(eqn_idx%Re(i, q))/Res_viscous(i, q) & + Re_visc(i) end do @@ -498,8 +498,8 @@ contains 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) - & + 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 @@ -543,7 +543,7 @@ contains do i = 1, num_dims - iv%beg = mom_idx%beg; iv%end = mom_idx%end + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end !$acc update device(iv) @@ -582,7 +582,7 @@ contains else ! Compute velocity gradient at cell centers using finite differences - iv%beg = mom_idx%beg; iv%end = mom_idx%end + iv%beg = eqn_idx%mom%beg; iv%end = eqn_idx%mom%end !$acc update device(iv) is1_viscous = ix; is2_viscous = iy; is3_viscous = iz diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 015ea87a3f..0f99542cf6 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -147,7 +147,7 @@ contains call s_compute_weno_coefficients(1, is1_weno) @:ALLOCATE(v_rs_ws_x(is1_weno%beg:is1_weno%end, & - is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size)) + is2_weno%beg:is2_weno%end, is3_weno%beg:is3_weno%end, 1:eqn_idx%sys_size)) ! Allocating/Computing WENO Coefficients in y-direction if (n == 0) return @@ -177,7 +177,7 @@ contains call s_compute_weno_coefficients(2, is2_weno) @:ALLOCATE(v_rs_ws_y(is2_weno%beg:is2_weno%end, & - is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:sys_size)) + is1_weno%beg:is1_weno%end, is3_weno%beg:is3_weno%end, 1:eqn_idx%sys_size)) ! Allocating/Computing WENO Coefficients in z-direction if (p == 0) return @@ -200,7 +200,7 @@ contains call s_compute_weno_coefficients(3, is3_weno) @:ALLOCATE(v_rs_ws_z(is3_weno%beg:is3_weno%end, & - is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:sys_size)) + is2_weno%beg:is2_weno%end, is1_weno%beg:is1_weno%end, 1:eqn_idx%sys_size)) end subroutine s_initialize_weno_module @@ -853,7 +853,7 @@ contains ! Fu''s code: https://dx.doi.org/10.13140/RG.2.2.36250.34247 tau = abs(beta(2) - beta(0)) alpha = 1._wp + tau/beta ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6) - alpha = (alpha*alpha*alpha)**2._wp ! Equation 22 cont. (some CPU compilers cannot optimize x**6.0) + alpha = (alpha*alpha*alpha)**2._wp ! Equation 22 eqn_idx%cont. (some CPU compilers cannot optimize x**6.0) omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi) delta = merge(0._wp, 1._wp, omega < teno_CT)! Equation 26 alpha = delta*d_cbL_${XYZ}$ (:, j) ! Equation 27 @@ -1160,7 +1160,7 @@ contains use CuTensorEx !$acc host_data use_device(v_rs_ws_x, v_rs_ws_y) - v_rs_ws_y = reshape(v_rs_ws_x, shape=[n + 1 + 2*buff_size, m + 2*buff_size + 1, p + 1, sys_size], order=[2, 1, 3, 4]) + v_rs_ws_y = reshape(v_rs_ws_x, shape=[n + 1 + 2*buff_size, m + 2*buff_size + 1, p + 1, eqn_idx%sys_size], order=[2, 1, 3, 4]) !$acc end host_data end block else @@ -1168,7 +1168,7 @@ contains use CuTensorEx !$acc host_data use_device(v_rs_ws_x, v_rs_ws_y) - v_rs_ws_y = reshape(v_rs_ws_x, shape=[n + 1 + 2*buff_size, m + 2*buff_size + 1, p + 1 + 2*buff_size, sys_size], order=[2, 1, 3, 4]) + v_rs_ws_y = reshape(v_rs_ws_x, shape=[n + 1 + 2*buff_size, m + 2*buff_size + 1, p + 1 + 2*buff_size, eqn_idx%sys_size], order=[2, 1, 3, 4]) !$acc end host_data end block end if @@ -1199,7 +1199,7 @@ contains use CuTensorEx !$acc host_data use_device(v_rs_ws_x, v_rs_ws_z) - v_rs_ws_z = reshape(v_rs_ws_x, shape=[p + 1 + 2*buff_size, n + 2*buff_size + 1, m + 2*buff_size + 1, sys_size], order=[3, 2, 1, 4]) + v_rs_ws_z = reshape(v_rs_ws_x, shape=[p + 1 + 2*buff_size, n + 2*buff_size + 1, m + 2*buff_size + 1, eqn_idx%sys_size], order=[3, 2, 1, 4]) !$acc end host_data end block else