UVM and down sample

Author: wilfonba

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_helper.fpp

@@ -37,7 +37,8 @@ module m_helper
               double_factorial, &
               factorial, &
               f_cut_on, &
-              f_cut_off
+              f_cut_off, &
+              s_downsample_data
 
 contains
 
@@ -625,4 +626,49 @@ 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
+
 end module m_helper

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
@@ -1223,10 +1223,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
 

src/post_process/m_data_input.f90

@@ -50,6 +50,8 @@ end subroutine s_read_abstract_data_files
     type(scalar_field), allocatable, dimension(:), public :: q_cons_vf !<
     !! Conservative variables
 
+    type(scalar_field), allocatable, dimension(:), public :: q_cons_temp
+
     type(scalar_field), allocatable, dimension(:), public :: q_prim_vf !<
     !! Primitive variables
 
@@ -340,6 +342,7 @@ impure subroutine s_read_parallel_data_files(t_step)
         integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK
         integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK
         integer(KIND=MPI_OFFSET_KIND) :: MOK
+        real(wp) :: delx, dely, delz
 
         character(LEN=path_len + 2*name_len) :: file_loc
         logical :: file_exist
@@ -352,17 +355,25 @@ impure subroutine s_read_parallel_data_files(t_step)
         allocate (y_cb_glb(-1:n_glb))
         allocate (z_cb_glb(-1:p_glb))
 
-        ! Read in cell boundary locations in x-direction
-        file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'x_cb.dat'
-        inquire (FILE=trim(file_loc), EXIST=file_exist)
-
-        if (file_exist) then
-            data_size = m_glb + 2
-            call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
-            call MPI_FILE_READ(ifile, x_cb_glb, data_size, mpi_p, status, ierr)
-            call MPI_FILE_CLOSE(ifile, ierr)
+        if(down_sample) then
+            delx = (x_domain%end - x_domain%beg)/real(m_glb + 1, wp)
+            do i = 0, m_glb
+                x_cb_glb(i - 1) = x_domain%beg + delx*real(i, wp)
+            end do
+            x_cb_glb(m_glb) = x_domain%end
         else
-            call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+            ! Read in cell boundary locations in x-direction
+            file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'x_cb.dat'
+            inquire (FILE=trim(file_loc), EXIST=file_exist)
+
+            if (file_exist) then
+                data_size = m_glb + 2
+                call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+                call MPI_FILE_READ(ifile, x_cb_glb, data_size, mpi_p, status, ierr)
+                call MPI_FILE_CLOSE(ifile, ierr)
+            else
+                call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+            end if
         end if
 
         ! Assigning local cell boundary locations
@@ -373,17 +384,25 @@ impure subroutine s_read_parallel_data_files(t_step)
         x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp
 
         if (n > 0) then
-            ! Read in cell boundary locations in y-direction
-            file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'y_cb.dat'
-            inquire (FILE=trim(file_loc), EXIST=file_exist)
-
-            if (file_exist) then
-                data_size = n_glb + 2
-                call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
-                call MPI_FILE_READ(ifile, y_cb_glb, data_size, mpi_p, status, ierr)
-                call MPI_FILE_CLOSE(ifile, ierr)
+            if(down_sample) then
+                dely = (y_domain%end - y_domain%beg)/real(n_glb + 1, wp)
+                do i = 0, n_glb
+                    y_cb_glb(i - 1) = y_domain%beg + dely*real(i, wp)
+                end do
+                y_cb_glb(n_glb) = y_domain%end
             else
-                call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+                ! Read in cell boundary locations in y-direction
+                file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'y_cb.dat'
+                inquire (FILE=trim(file_loc), EXIST=file_exist)
+
+                if (file_exist) then
+                    data_size = n_glb + 2
+                    call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+                    call MPI_FILE_READ(ifile, y_cb_glb, data_size, mpi_p, status, ierr)
+                    call MPI_FILE_CLOSE(ifile, ierr)
+                else
+                    call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+                end if
             end if
 
             ! Assigning local cell boundary locations
@@ -394,17 +413,25 @@ impure subroutine s_read_parallel_data_files(t_step)
             y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp
 
             if (p > 0) then
-                ! Read in cell boundary locations in z-direction
-                file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'z_cb.dat'
-                inquire (FILE=trim(file_loc), EXIST=file_exist)
-
-                if (file_exist) then
-                    data_size = p_glb + 2
-                    call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
-                    call MPI_FILE_READ(ifile, z_cb_glb, data_size, mpi_p, status, ierr)
-                    call MPI_FILE_CLOSE(ifile, ierr)
+                if(down_sample) then
+                    delz = (z_domain%end - z_domain%beg)/real(p_glb + 1, wp)
+                    do i = 0, p_glb
+                        z_cb_glb(i - 1) = z_domain%beg + delz*real(i, wp)
+                    end do
+                    z_cb_glb(p_glb) = z_domain%end
                 else
-                    call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+                    ! Read in cell boundary locations in z-direction
+                    file_loc = trim(case_dir)//'/restart_data'//trim(mpiiofs)//'z_cb.dat'
+                    inquire (FILE=trim(file_loc), EXIST=file_exist)
+
+                    if (file_exist) then
+                        data_size = p_glb + 2
+                        call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
+                        call MPI_FILE_READ(ifile, z_cb_glb, data_size, mpi_p, status, ierr)
+                        call MPI_FILE_CLOSE(ifile, ierr)
+                    else
+                        call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
+                    end if
                 end if
 
                 ! Assigning local cell boundary locations
@@ -459,7 +486,42 @@ impure subroutine s_read_parallel_conservative_data(t_step, m_MOK, n_MOK, p_MOK,
             if (file_exist) then
                 call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
 
-                call s_setup_mpi_io_params(data_size, m_MOK, n_MOK, p_MOK, WP_MOK, MOK, str_MOK, NVARS_MOK)
+                if(down_sample) then
+                    call s_initialize_mpi_data_ds(q_cons_temp)
+                else
+                    ! Initialize MPI data I/O
+                    if (ib) then
+                        call s_initialize_mpi_data(q_cons_vf, ib_markers)
+                    else
+                        call s_initialize_mpi_data(q_cons_vf)
+                    end if
+                end if
+
+                if(down_sample) then
+                    ! Size of local arrays
+                    data_size = (m + 3)*(n + 3)*(p + 3)
+
+                    ! Resize some integers so MPI can read even the biggest file
+                    m_MOK = int(m_glb + 1, MPI_OFFSET_KIND)
+                    n_MOK = int(n_glb + 1, MPI_OFFSET_KIND)
+                    p_MOK = int(p_glb + 1, MPI_OFFSET_KIND)
+                    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)
+                else
+                    ! Size of local arrays
+                    data_size = (m + 1)*(n + 1)*(p + 1)
+
+                    ! Resize some integers so MPI can read even the biggest file
+                    m_MOK = int(m_glb + 1, MPI_OFFSET_KIND)
+                    n_MOK = int(n_glb + 1, MPI_OFFSET_KIND)
+                    p_MOK = int(p_glb + 1, MPI_OFFSET_KIND)
+                    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)
+                end if
 
                 ! Read the data for each variable
                 if (bubbles_euler .or. elasticity .or. mhd) then
@@ -479,6 +541,12 @@ impure subroutine s_read_parallel_conservative_data(t_step, m_MOK, n_MOK, p_MOK,
                 call s_mpi_barrier()
                 call MPI_FILE_CLOSE(ifile, ierr)
 
+                if(down_sample) then
+                    do i = 1, sys_size
+                        q_cons_vf(i)%sf(0:m,0:n,0:p) = q_cons_temp(i)%sf(0:m,0:n,0:p)
+                    end do
+                end if
+
                 call s_read_ib_data_files(trim(case_dir)//'/restart_data'//trim(mpiiofs))
             else
                 call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting.')
@@ -529,6 +597,7 @@ impure subroutine s_initialize_data_input_module
         ! the simulation
         allocate (q_cons_vf(1:sys_size))
         allocate (q_prim_vf(1:sys_size))
+        allocate (q_cons_temp(1:sys_size))
 
         ! Allocating the parts of the conservative and primitive variables
         ! that do require the direct knowledge of the dimensionality of
@@ -539,6 +608,9 @@ impure subroutine s_initialize_data_input_module
             ! Simulation is 3D
             if (p > 0) then
                 call s_allocate_field_arrays(-buff_size, m + buff_size, n + buff_size, p + buff_size)
+                if(down_sample) then
+                    allocate(q_cons_temp(i)%sf(-1:m+1,-1:n+1,-1:p+1))
+                end if
             else
                 ! Simulation is 2D
                 call s_allocate_field_arrays(-buff_size, m + buff_size, n + buff_size, 0)
@@ -579,10 +651,14 @@ impure subroutine s_finalize_data_input_module
         do i = 1, sys_size
             deallocate (q_cons_vf(i)%sf)
             deallocate (q_prim_vf(i)%sf)
+            if (down_sample) then
+                deallocate (q_cons_temp(i)%sf)
+            end if
         end do
 
         deallocate (q_cons_vf)
         deallocate (q_prim_vf)
+        deallocate (q_cons_temp)
 
         if (ib) then
             deallocate (ib_markers%sf)