Frontier UVM and other preparations to reproduce 100T (#967)

Co-authored-by: Anand <[email protected]>
Co-authored-by: Anand Radhakrishnan <[email protected]>
Co-authored-by: Spencer Bryngelson <[email protected]>

Author: 4 people

.typos.toml

@@ -18,6 +18,7 @@ Gam = "Gam"
 strang = "strang"
 Strang = "Strang"
 TKE = "TKE"
+HSA = "HSA"
 
 [files]
 extend-exclude = ["docs/documentation/references*", "tests/", "toolchain/cce_simulation_workgroup_256.sh"]

CMakeLists.txt

@@ -506,6 +506,12 @@ function(MFC_SETUP_TARGET)
                     )
                 endif()
             elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray")
+                # Frontier Unified Memory Support
+                if (MFC_Unified)
+                    target_compile_options(${ARGS_TARGET}
+                        PRIVATE -DFRONTIER_UNIFIED)
+                endif()
+
                 find_package(hipfort COMPONENTS hip CONFIG REQUIRED)
                 target_link_libraries(${a_target} PRIVATE hipfort::hip hipfort::hipfort-amdgcn)
             endif()

src/common/m_boundary_common.fpp

@@ -1626,7 +1626,7 @@ contains
 
     impure subroutine s_create_mpi_types(bc_type)
 
-        type(integer_field), dimension(1:num_dims, -1:1) :: bc_type
+        type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type
 
 #ifdef MFC_MPI
         integer :: dir, loc
@@ -1659,9 +1659,9 @@ contains
 
     subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath, old_grid_in)
 
-        type(scalar_field), dimension(sys_size) :: q_prim_vf
-        type(integer_field), dimension(1:num_dims, -1:1) :: bc_type
-        logical :: old_grid_in
+        type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+        type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type
+        logical, intent(in) :: old_grid_in
 
         character(LEN=*), intent(in) :: step_dirpath
 
@@ -1700,8 +1700,8 @@ contains
 
     subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type)
 
-        type(scalar_field), dimension(sys_size) :: q_prim_vf
-        type(integer_field), dimension(1:num_dims, -1:1) :: bc_type
+        type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
+        type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type
 
         integer :: dir, loc
         character(len=path_len) :: file_loc, file_path
@@ -1870,7 +1870,7 @@ contains
 
     subroutine s_pack_boundary_condition_buffers(q_prim_vf)
 
-        type(scalar_field), dimension(sys_size) :: q_prim_vf
+        type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
         integer :: i, j, k
 
         do k = 0, p

src/common/m_helper.fpp

@@ -37,7 +37,9 @@ module m_helper
               double_factorial, &
               factorial, &
               f_cut_on, &
-              f_cut_off
+              f_cut_off, &
+              s_downsample_data, &
+              s_upsample_data
 
 contains
 
@@ -625,4 +627,87 @@ contains
 
     end function f_gx
 
+    subroutine s_downsample_data(q_cons_vf, q_cons_temp, m_ds, n_ds, p_ds, m_glb_ds, n_glb_ds, p_glb_ds)
+
+        type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf, q_cons_temp
+
+        ! Down sampling variables
+        integer :: i, j, k, l
+        integer :: ix, iy, iz, x_id, y_id, z_id
+        integer, intent(inout) :: m_ds, n_ds, p_ds, m_glb_ds, n_glb_ds, p_glb_ds
+
+        m_ds = int((m + 1)/3) - 1
+        n_ds = int((n + 1)/3) - 1
+        p_ds = int((p + 1)/3) - 1
+
+        m_glb_ds = int((m_glb + 1)/3) - 1
+        n_glb_ds = int((n_glb + 1)/3) - 1
+        p_glb_ds = int((p_glb + 1)/3) - 1
+
+        do i = 1, sys_size
+            $:GPU_UPDATE(host='[q_cons_vf(i)%sf]')
+        end do
+
+        do l = -1, p_ds + 1
+            do k = -1, n_ds + 1
+                do j = -1, m_ds + 1
+                    x_id = 3*j + 1
+                    y_id = 3*k + 1
+                    z_id = 3*l + 1
+                    do i = 1, sys_size
+                        q_cons_temp(i)%sf(j, k, l) = 0
+
+                        do iz = -1, 1
+                            do iy = -1, 1
+                                do ix = -1, 1
+                                    q_cons_temp(i)%sf(j, k, l) = q_cons_temp(i)%sf(j, k, l) &
+                                                                 + (1._wp/27._wp)*q_cons_vf(i)%sf(x_id + ix, y_id + iy, z_id + iz)
+                                end do
+                            end do
+                        end do
+                    end do
+                end do
+            end do
+        end do
+
+    end subroutine s_downsample_data
+
+    subroutine s_upsample_data(q_cons_vf, q_cons_temp)
+
+        type(scalar_field), intent(inout), dimension(sys_size) :: q_cons_vf, q_cons_temp
+        integer :: i, j, k, l
+        integer :: ix, iy, iz
+        integer :: x_id, y_id, z_id
+        real(wp), dimension(4) :: temp
+
+        do l = 0, p
+            do k = 0, n
+                do j = 0, m
+                    do i = 1, sys_size
+
+                        ix = int(j/3._wp)
+                        iy = int(k/3._wp)
+                        iz = int(l/3._wp)
+
+                        x_id = j - int(3*ix) - 1
+                        y_id = k - int(3*iy) - 1
+                        z_id = l - int(3*iz) - 1
+
+                        temp(1) = (2._wp/3._wp)*q_cons_temp(i)%sf(ix, iy, iz) + (1._wp/3._wp)*q_cons_temp(i)%sf(ix + x_id, iy, iz)
+                        temp(2) = (2._wp/3._wp)*q_cons_temp(i)%sf(ix, iy + y_id, iz) + (1._wp/3._wp)*q_cons_temp(i)%sf(ix + x_id, iy + y_id, iz)
+                        temp(3) = (2._wp/3._wp)*temp(1) + (1._wp/3._wp)*temp(2)
+
+                        temp(1) = (2._wp/3._wp)*q_cons_temp(i)%sf(ix, iy, iz + z_id) + (1._wp/3._wp)*q_cons_temp(i)%sf(ix + x_id, iy, iz + z_id)
+                        temp(2) = (2._wp/3._wp)*q_cons_temp(i)%sf(ix, iy + y_id, iz + z_id) + (1._wp/3._wp)*q_cons_temp(i)%sf(ix + x_id, iy + y_id, iz + z_id)
+                        temp(4) = (2._wp/3._wp)*temp(1) + (1._wp/3._wp)*temp(2)
+
+                        q_cons_vf(i)%sf(j, k, l) = (2._wp/3._wp)*temp(3) + (1._wp/3._wp)*temp(4)
+
+                    end do
+                end do
+            end do
+        end do
+
+    end subroutine s_upsample_data
+
 end module m_helper

src/common/m_helper_basic.fpp

@@ -110,9 +110,12 @@ contains
         res = f_approx_equal(var, real(nint(var), wp))
     end function f_is_integer
 
-    pure subroutine s_configure_coordinate_bounds(recon_type, weno_polyn, muscl_polyn, buff_size, idwint, idwbuff, &
+    pure subroutine s_configure_coordinate_bounds(recon_type, weno_polyn, muscl_polyn, &
+                                                  igr_order, buff_size, idwint, idwbuff, &
                                                   viscous, bubbles_lagrange, m, n, p, num_dims, igr)
-        integer, intent(in) :: recon_type, weno_polyn, muscl_polyn, m, n, p, num_dims
+
+        integer, intent(in) :: recon_type, weno_polyn, muscl_polyn
+        integer, intent(in) :: m, n, p, num_dims, igr_order
         integer, intent(inout) :: buff_size
         type(int_bounds_info), dimension(3), intent(inout) :: idwint, idwbuff
         logical, intent(in) :: viscous, bubbles_lagrange
@@ -123,11 +126,7 @@ contains
         ! the physical computational domain from one time-step iteration to
         ! the next one
         if (igr) then
-            if (viscous) then
-                buff_size = 6
-            else
-                buff_size = 4
-            end if
+            buff_size = (igr_order - 1)/2 + 2
         elseif (recon_type == WENO_TYPE) then
             if (viscous) then
                 buff_size = 2*weno_polyn + 2

src/common/m_mpi_common.fpp

@@ -282,6 +282,57 @@ contains
 
     end subroutine s_initialize_mpi_data
 
+    !! @param q_cons_vf Conservative variables
+    subroutine s_initialize_mpi_data_ds(q_cons_vf)
+
+        type(scalar_field), &
+            dimension(sys_size), &
+            intent(in) :: q_cons_vf
+
+        integer, dimension(num_dims) :: sizes_glb, sizes_loc
+        integer, dimension(3) :: sf_start_idx
+
+#ifdef MFC_MPI
+
+        ! Generic loop iterator
+        integer :: i, j, q, k, l, m_ds, n_ds, p_ds, ierr
+
+        sf_start_idx = (/0, 0, 0/)
+
+#ifndef MFC_POST_PROCESS
+        m_ds = int((m + 1)/3) - 1
+        n_ds = int((n + 1)/3) - 1
+        p_ds = int((p + 1)/3) - 1
+#else
+        m_ds = m
+        n_ds = n
+        p_ds = p
+#endif
+
+#ifdef MFC_POST_PROCESS
+        do i = 1, sys_size
+            MPI_IO_DATA%var(i)%sf => q_cons_vf(i)%sf(-1:m_ds + 1, -1:n_ds + 1, -1:p_ds + 1)
+        end do
+#endif
+        ! Define global(g) and local(l) sizes for flow variables
+        sizes_loc(1) = m_ds + 3
+        if (n > 0) then
+            sizes_loc(2) = n_ds + 3
+            if (p > 0) then
+                sizes_loc(3) = p_ds + 3
+            end if
+        end if
+
+        ! Define the view for each variable
+        do i = 1, sys_size
+            call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_loc, sizes_loc, sf_start_idx, &
+                                          MPI_ORDER_FORTRAN, mpi_p, MPI_IO_DATA%view(i), ierr)
+            call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr)
+        end do
+#endif
+
+    end subroutine s_initialize_mpi_data_ds
+
     impure subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root)
 
         integer, intent(in) :: counts          ! Array of vector lengths for each process

src/common/m_variables_conversion.fpp

@@ -392,7 +392,7 @@ contains
         if (igr) then
             if (num_fluids == 1) then
                 alpha_rho_K(1) = q_vf(contxb)%sf(k, l, r)
-                alpha_K(1) = q_vf(advxb)%sf(k, l, r)
+                alpha_K(1) = 1._wp
             else
                 do i = 1, num_fluids - 1
                     alpha_rho_K(i) = q_vf(i)%sf(k, l, r)
@@ -884,7 +884,7 @@ contains
                     if (igr) then
                         if (num_fluids == 1) then
                             alpha_rho_K(1) = qK_cons_vf(contxb)%sf(j, k, l)
-                            alpha_K(1) = qK_cons_vf(advxb)%sf(j, k, l)
+                            alpha_K(1) = 1._wp
                         else
                             $:GPU_LOOP(parallelism='[seq]')
                             do i = 1, num_fluids - 1
@@ -1147,10 +1147,12 @@ contains
                         end do
                     end if
 
-                    $:GPU_LOOP(parallelism='[seq]')
-                    do i = advxb, advxe
-                        qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)
-                    end do
+                    if (.not. igr .or. num_fluids > 1) then
+                        $:GPU_LOOP(parallelism='[seq]')
+                        do i = advxb, advxe
+                            qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)
+                        end do
+                    end if
 
                     if (surface_tension) then
                         qK_prim_vf(c_idx)%sf(j, k, l) = qK_cons_vf(c_idx)%sf(j, k, l)
@@ -1223,10 +1225,12 @@ contains
                     call s_convert_to_mixture_variables(q_prim_vf, j, k, l, &
                                                         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
-                        q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
-                    end do
+                    if (.not. igr .or. num_fluids > 1) then
+                        ! Transferring the advection equation(s) variable(s)
+                        do i = adv_idx%beg, adv_idx%end
+                            q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
+                        end do
+                    end if
 
                     if (relativity) then