Skip to content

Commit d7e0574

Browse files
danieljvickersdanieljvickers
committed
Intermitent commit,
1 parent 40af4f1 commit d7e0574

8 files changed

Lines changed: 310 additions & 99 deletions

File tree

‎src/common/m_helper.fpp‎

Lines changed: 44 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module m_helper
1010

1111
use m_derived_types
1212
use m_global_parameters
13+
use m_constants
1314
use ieee_arithmetic !< For checking NaN
1415

1516
implicit none
@@ -18,7 +19,8 @@ module m_helper
1819
public :: s_comp_n_from_prim, s_comp_n_from_cons, s_initialize_bubbles_model, s_initialize_nonpoly, s_simpson, s_transcoeff, &
1920
& s_int_to_str, s_transform_vec, s_transform_triangle, s_transform_model, s_swap, f_cross, f_create_transform_matrix, &
2021
& f_create_bbox, s_print_2D_array, f_xor, f_logical_to_int, associated_legendre, real_ylm, double_factorial, factorial, &
21-
& f_cut_on, f_cut_off, s_downsample_data, s_upsample_data, s_cross_product, f_unit_vector, s_prng, modmul
22+
& f_cut_on, f_cut_off, s_downsample_data, s_upsample_data, s_cross_product, f_unit_vector, s_prng, modmul, &
23+
& f_local_rank_owns_location
2224

2325
contains
2426

@@ -699,4 +701,45 @@ contains
699701
700702
end subroutine s_upsample_data
701703
704+
!> @brief True if `location` falls within this rank's own subdomain (a strict partition - each location is owned by exactly one
705+
!! rank, unlike an overlapping multi-rank ghost-stencil neighborhood). Used by both pre_process (to decide which
706+
!! generated/namelist IBs a rank writes to its own restart_data/ib_state_0.dat chunk) and simulation (to decide which IBs a rank
707+
!! owns for its own periodic IB-state writes) so the two stay consistent. glb_bounds_in is the global domain extent, used only
708+
!! to project a location that falls just outside the domain (floating-point edge case) onto the domain so some rank still claims
709+
!! it.
710+
function f_local_rank_owns_location(location, glb_bounds_in) result(owns_location)
711+
712+
$:GPU_ROUTINE(parallelism='[seq]')
713+
714+
real(wp), dimension(3), intent(in) :: location
715+
type(bounds_info), dimension(3), intent(in) :: glb_bounds_in
716+
logical :: owns_location
717+
real(wp), dimension(3) :: projected_location
718+
719+
owns_location = .true.
720+
721+
#ifdef MFC_MPI
722+
if (num_procs > 1) then
723+
projected_location(:) = location(:)
724+
725+
! catch the edge case where the location lies just outside the computational domain
726+
#:for X, ID, DIM in [('x', 1, 'm'), ('y', 2, 'n'), ('z', 3, 'p')]
727+
if (num_dims >= ${ID}$) then
728+
if (bc_${X}$%beg /= BC_PERIODIC) then
729+
! if it is outside the domain in one direction, project it somewhere inside so at least one rank owns it
730+
if (location(${ID}$) < glb_bounds_in(${ID}$)%beg) then
731+
projected_location(${ID}$) = glb_bounds_in(${ID}$)%beg
732+
else if (glb_bounds_in(${ID}$)%end < location(${ID}$)) then
733+
projected_location(${ID}$) = glb_bounds_in(${ID}$)%end - 1.0e-10_wp
734+
end if
735+
end if
736+
owns_location = owns_location .and. ${X}$_cb(-1) <= projected_location(${ID}$) &
737+
& .and. projected_location(${ID}$) < ${X}$_cb(${DIM}$)
738+
end if
739+
#:endfor
740+
end if
741+
#endif
742+
743+
end function f_local_rank_owns_location
744+
702745
end module m_helper

‎src/pre_process/m_data_output.fpp‎

Lines changed: 166 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ module m_data_output
2828

2929
private
3030
public :: s_write_serial_data_files, s_write_parallel_data_files, s_write_data_files, s_initialize_data_output_module, &
31-
& s_finalize_data_output_module, s_write_ib_state_0
31+
& s_finalize_data_output_module, s_write_ib_state_0_file
3232

3333
type(scalar_field), allocatable, dimension(:) :: q_cons_temp
3434

@@ -733,35 +733,186 @@ contains
733733

734734
end subroutine s_initialize_data_output_module
735735

736-
!> @brief Writes restart_data/ib_state_0.dat: the initial IB layout (namelist patch_ib entries, then any generated
737-
!! particle-cloud beds). Rank-0-only. Read back by simulation at startup via s_read_ib_restart_data(0, ...)
738-
!! (src/simulation/m_start_up.fpp). Uses the same 20-field record layout s_write_serial_ib_state
739-
!! (src/simulation/m_data_output.fpp) writes, so simulation's own writers can freely overwrite this file later at t_step_start
740-
!! == 0 without changing its layout - only position (fields 17:19) and radius (field 20) are populated here; everything else
741-
!! (time, force, torque, vel, angular_vel, angles) is zero for a freshly generated IB.
742-
impure subroutine s_write_ib_state_0(particle_cloud_ibs, num_particle_cloud_ibs)
736+
!> @brief Writes restart_data/ib_state_0.dat (or, under file_per_process, one restart_data/lustre_0/ib_state_0_<rank>.dat chunk
737+
!! per rank): the initial IB layout - namelist patch_ib entries, then any generated particle-cloud beds - with each rank writing
738+
!! only the entries f_local_rank_owns_location says are its own. Read back by simulation at startup via
739+
!! s_read_ib_restart_data(0, ...) (src/simulation/m_start_up.fpp), which dispatches on the same file_per_process flag, so the
740+
!! two writers must stay format-compatible: this mirrors s_write_parallel_ib_state/s_write_serial_ib_state
741+
!! (src/simulation/m_data_output.fpp) exactly, just sourcing entries from this rank's local subset instead of patch_ib/
742+
!! local_ib_patch_ids post-reduce. Only position (fields 17:19) and radius (field 20) are populated here; everything else (time,
743+
!! force, torque, vel, angular_vel, angles) is zero for a freshly generated IB.
744+
impure subroutine s_write_ib_state_0_file(glb_bounds, particle_cloud_ibs, num_particle_cloud_ibs)
745+
746+
type(bounds_info), dimension(3), intent(in) :: glb_bounds
747+
type(ib_patch_parameters), dimension(:), intent(in) :: particle_cloud_ibs
748+
integer, intent(in) :: num_particle_cloud_ibs
749+
integer, allocatable :: local_namelist_ids(:)
750+
integer :: num_local_namelist
751+
integer :: i
752+
real(wp), dimension(3) :: centroid
753+
754+
allocate (local_namelist_ids(max(1, num_ibs)))
755+
num_local_namelist = 0
756+
do i = 1, num_ibs
757+
centroid = [patch_ib(i)%x_centroid, patch_ib(i)%y_centroid, 0._wp]
758+
if (num_dims == 3) centroid(3) = patch_ib(i)%z_centroid
759+
if (f_local_rank_owns_location(centroid, glb_bounds)) then
760+
num_local_namelist = num_local_namelist + 1
761+
local_namelist_ids(num_local_namelist) = i
762+
end if
763+
end do
764+
765+
if (.not. parallel_io) then
766+
! Mirrors s_write_serial_ib_state (src/simulation/m_data_output.fpp): "must be called only on rank 0" - parallel_io
767+
! = F is not MPI-aware for ib_state, so this combined with num_procs > 1 is a pre-existing limitation, not one
768+
! introduced here.
769+
if (proc_rank == 0) call s_write_ib_state_0_serial(local_namelist_ids, num_local_namelist, particle_cloud_ibs, &
770+
& num_particle_cloud_ibs)
771+
else if (file_per_process) then
772+
call s_write_ib_state_0_file_per_process(local_namelist_ids, num_local_namelist, particle_cloud_ibs, &
773+
& num_particle_cloud_ibs)
774+
else
775+
call s_write_ib_state_0_shared(local_namelist_ids, num_local_namelist, particle_cloud_ibs, num_particle_cloud_ibs)
776+
end if
743777
778+
deallocate (local_namelist_ids)
779+
780+
end subroutine s_write_ib_state_0_file
781+
782+
!> Writes this rank's local entries into its own restart_data/lustre_0/ib_state_0_<rank>.dat chunk file - mirrors
783+
!! s_write_parallel_ib_state's file_per_process branch (src/simulation/m_data_output.fpp).
784+
subroutine s_write_ib_state_0_file_per_process(local_namelist_ids, num_local_namelist, particle_cloud_ibs, &
785+
& num_particle_cloud_ibs)
786+
787+
integer, dimension(:), intent(in) :: local_namelist_ids
788+
integer, intent(in) :: num_local_namelist
744789
type(ib_patch_parameters), dimension(:), intent(in) :: particle_cloud_ibs
745790
integer, intent(in) :: num_particle_cloud_ibs
746791
character(LEN=len_trim(case_dir) + 2*name_len) :: file_loc
747792
integer :: i, ios, file_unit
748793
integer, parameter :: NFIELDS_PER_IB = 20
749794
real(wp) :: ib_buf(NFIELDS_PER_IB)
750795
751-
call s_create_directory(trim(case_dir) // '/restart_data')
796+
if (proc_rank == 0) call s_create_directory(trim(case_dir) // '/restart_data/lustre_0')
797+
call s_mpi_barrier()
798+
call s_delay_file_access(proc_rank)
799+
800+
write (file_loc, '(A,i7.7,A)') 'ib_state_0_', proc_rank, '.dat'
801+
file_loc = trim(case_dir) // '/restart_data/lustre_0/' // trim(file_loc)
802+
803+
open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='replace', iostat=ios)
804+
if (ios /= 0) call s_mpi_abort('Cannot open IB state output file: ' // trim(file_loc))
805+
806+
ib_buf = 0._wp
807+
808+
write (file_unit) num_local_namelist + num_particle_cloud_ibs
809+
810+
do i = 1, num_local_namelist
811+
ib_buf(17) = patch_ib(local_namelist_ids(i))%x_centroid
812+
ib_buf(18) = patch_ib(local_namelist_ids(i))%y_centroid
813+
ib_buf(19) = patch_ib(local_namelist_ids(i))%z_centroid
814+
ib_buf(20) = patch_ib(local_namelist_ids(i))%radius
815+
write (file_unit) local_namelist_ids(i)
816+
write (file_unit) ib_buf
817+
end do
818+
819+
do i = 1, num_particle_cloud_ibs
820+
ib_buf(17) = particle_cloud_ibs(i)%x_centroid
821+
ib_buf(18) = particle_cloud_ibs(i)%y_centroid
822+
ib_buf(19) = particle_cloud_ibs(i)%z_centroid
823+
ib_buf(20) = particle_cloud_ibs(i)%radius
824+
write (file_unit) particle_cloud_ibs(i)%gbl_patch_id
825+
write (file_unit) ib_buf
826+
end do
827+
828+
close (file_unit)
829+
830+
end subroutine s_write_ib_state_0_file_per_process
752831
832+
!> Writes this rank's local entries into the single shared restart_data/ib_state_0.dat, each rank placing its own records at
833+
!! their gbl_patch_id-based offset via MPI-IO - mirrors s_write_parallel_ib_state's non-file_per_process branch
834+
!! (src/simulation/m_data_output.fpp). Only reached when parallel_io = T (see s_write_ib_state_0_file), matching that
835+
!! routine's own precondition of running under MFC_MPI.
836+
subroutine s_write_ib_state_0_shared(local_namelist_ids, num_local_namelist, particle_cloud_ibs, num_particle_cloud_ibs)
837+
838+
integer, dimension(:), intent(in) :: local_namelist_ids
839+
integer, intent(in) :: num_local_namelist
840+
type(ib_patch_parameters), dimension(:), intent(in) :: particle_cloud_ibs
841+
integer, intent(in) :: num_particle_cloud_ibs
842+
integer, parameter :: NFIELDS_PER_IB = 20
843+
real(wp) :: ib_buf(NFIELDS_PER_IB)
844+
integer :: i
845+
#ifdef MFC_MPI
846+
character(LEN=len_trim(case_dir) + 2*name_len) :: file_loc
847+
integer(kind=MPI_OFFSET_KIND) :: disp, WP_MOK
848+
integer :: ifile, ierr
849+
integer, dimension(MPI_STATUS_SIZE) :: status
850+
logical :: file_exist
851+
852+
if (proc_rank == 0) call s_create_directory(trim(case_dir) // '/restart_data')
853+
call s_mpi_barrier()
854+
855+
WP_MOK = int(storage_size(0._wp)/8, MPI_OFFSET_KIND)
856+
file_loc = trim(case_dir) // '/restart_data/ib_state_0.dat'
857+
858+
inquire (FILE=trim(file_loc), EXIST=file_exist)
859+
if (file_exist .and. proc_rank == 0) call MPI_FILE_DELETE(file_loc, mpi_info_int, ierr)
860+
call s_mpi_barrier()
861+
862+
call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, ior(MPI_MODE_WRONLY, MPI_MODE_CREATE), mpi_info_int, ifile, ierr)
863+
864+
ib_buf = 0._wp
865+
866+
do i = 1, num_local_namelist
867+
ib_buf(17) = patch_ib(local_namelist_ids(i))%x_centroid
868+
ib_buf(18) = patch_ib(local_namelist_ids(i))%y_centroid
869+
ib_buf(19) = patch_ib(local_namelist_ids(i))%z_centroid
870+
ib_buf(20) = patch_ib(local_namelist_ids(i))%radius
871+
disp = int(local_namelist_ids(i) - 1, MPI_OFFSET_KIND)*int(NFIELDS_PER_IB, MPI_OFFSET_KIND)*WP_MOK
872+
call MPI_FILE_WRITE_AT(ifile, disp, ib_buf, NFIELDS_PER_IB, mpi_p, status, ierr)
873+
end do
874+
875+
do i = 1, num_particle_cloud_ibs
876+
ib_buf(17) = particle_cloud_ibs(i)%x_centroid
877+
ib_buf(18) = particle_cloud_ibs(i)%y_centroid
878+
ib_buf(19) = particle_cloud_ibs(i)%z_centroid
879+
ib_buf(20) = particle_cloud_ibs(i)%radius
880+
disp = int(particle_cloud_ibs(i)%gbl_patch_id - 1, MPI_OFFSET_KIND)*int(NFIELDS_PER_IB, MPI_OFFSET_KIND)*WP_MOK
881+
call MPI_FILE_WRITE_AT(ifile, disp, ib_buf, NFIELDS_PER_IB, mpi_p, status, ierr)
882+
end do
883+
884+
call MPI_FILE_CLOSE(ifile, ierr)
885+
#endif
886+
887+
end subroutine s_write_ib_state_0_shared
888+
889+
!> Writes ALL of this rank's local entries directly into restart_data/ib_state_0.dat with plain Fortran I/O - mirrors
890+
!! s_write_serial_ib_state (src/simulation/m_data_output.fpp). Used only when parallel_io = F; the caller (rank 0 only) mirrors
891+
!! that routine's "must be called only on rank 0" precondition, so this is a plain sequential write, no MPI needed.
892+
subroutine s_write_ib_state_0_serial(local_namelist_ids, num_local_namelist, particle_cloud_ibs, num_particle_cloud_ibs)
893+
894+
integer, dimension(:), intent(in) :: local_namelist_ids
895+
integer, intent(in) :: num_local_namelist
896+
type(ib_patch_parameters), dimension(:), intent(in) :: particle_cloud_ibs
897+
integer, intent(in) :: num_particle_cloud_ibs
898+
character(LEN=len_trim(case_dir) + 2*name_len) :: file_loc
899+
integer :: i, ios, file_unit
900+
integer, parameter :: NFIELDS_PER_IB = 20
901+
real(wp) :: ib_buf(NFIELDS_PER_IB)
902+
903+
call s_create_directory(trim(case_dir) // '/restart_data')
753904
file_loc = trim(case_dir) // '/restart_data/ib_state_0.dat'
754905

755906
open (newunit=file_unit, file=trim(file_loc), form='unformatted', access='stream', status='replace', iostat=ios)
756907
if (ios /= 0) call s_mpi_abort('Cannot open IB state output file: ' // trim(file_loc))
757908

758909
ib_buf = 0._wp
759910

760-
do i = 1, num_ibs
761-
ib_buf(17) = patch_ib(i)%x_centroid
762-
ib_buf(18) = patch_ib(i)%y_centroid
763-
ib_buf(19) = patch_ib(i)%z_centroid
764-
ib_buf(20) = patch_ib(i)%radius
911+
do i = 1, num_local_namelist
912+
ib_buf(17) = patch_ib(local_namelist_ids(i))%x_centroid
913+
ib_buf(18) = patch_ib(local_namelist_ids(i))%y_centroid
914+
ib_buf(19) = patch_ib(local_namelist_ids(i))%z_centroid
915+
ib_buf(20) = patch_ib(local_namelist_ids(i))%radius
765916
write (file_unit) ib_buf
766917
end do
767918

@@ -775,7 +926,7 @@ contains
775926

776927
close (file_unit)
777928

778-
end subroutine s_write_ib_state_0
929+
end subroutine s_write_ib_state_0_serial
779930

780931
!> Resets s_write_data_files pointer
781932
impure subroutine s_finalize_data_output_module

0 commit comments

Comments
 (0)