Skip to content

Commit

Permalink
hdf5 I/O backend (#87)
Browse files Browse the repository at this point in the history 
* Change `load` to `load_all`, and add `load_one` subroutine.`

* WIP: extending the I/O capabilities.

* Added hdf5 xdmf writer (untested).

* Added hdf5 collective I/O.
  • Loading branch information
@p-costa
p-costa authored Aug 28, 2023
1 parent 5123940 commit f159c95
Show file tree
Hide file tree
Showing 3 changed files with 428 additions and 6 deletions.
265 changes: 262 additions & 3 deletions src/load.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,9 @@ module mod_load
use mod_utils, only: f_sizeof
implicit none
private
public load,io_field
public load_all,io_field
contains
subroutine load(io,filename,comm,ng,nh,lo,hi,u,v,w,p,time,istep)
subroutine load_all(io,filename,comm,ng,nh,lo,hi,u,v,w,p,time,istep)
!
! reads/writes a restart file
!
Expand Down Expand Up @@ -149,7 +149,7 @@ subroutine load(io,filename,comm,ng,nh,lo,hi,u,v,w,p,time,istep)
call MPI_FILE_WRITE(fh,fldinfo,nreals_myid,MPI_REAL_RP,MPI_STATUS_IGNORE,ierr)
call MPI_FILE_CLOSE(fh,ierr)
end select
end subroutine load
end subroutine load_all
!
subroutine io_field(io,fh,ng,nh,lo,hi,disp,var)
implicit none
Expand Down Expand Up @@ -345,5 +345,264 @@ subroutine transpose_to_or_from_x_gpu(io,ipencil_axis,nh,var_io,var)
end select
end subroutine transpose_to_or_from_x_gpu
#endif
#endif
subroutine load_one(io,filename,comm,ng,nh,lo,hi,p,time,istep)
!
! reads/writes a restart file for a single field
!
implicit none
character(len=1), intent(in) :: io
character(len=*), intent(in) :: filename
integer , intent(in) :: comm
integer , intent(in), dimension(3) :: ng,nh,lo,hi
real(rp), intent(inout), dimension(lo(1)-nh(1):,lo(2)-nh(2):,lo(3)-nh(3):) :: p
real(rp), intent(inout), optional :: time
integer , intent(inout), optional :: istep
real(rp), dimension(2) :: fldinfo
integer :: fh
integer :: nreals_myid
integer(kind=MPI_OFFSET_KIND) :: filesize,disp,good
!
select case(io)
case('r')
call MPI_FILE_OPEN(comm, filename, &
MPI_MODE_RDONLY, MPI_INFO_NULL,fh,ierr)
!
! check file size first
!
call MPI_FILE_GET_SIZE(fh,filesize,ierr)
good = (product(int(ng(:),MPI_OFFSET_KIND))*1+2)*f_sizeof(1._rp)
if(filesize /= good) then
if(myid == 0) print*, ''
if(myid == 0) print*, '*** Simulation aborted due a checkpoint file with incorrect size ***'
if(myid == 0) print*, ' file: ', filename, ' | expected size: ', good, '| actual size: ', filesize
call MPI_FINALIZE(ierr)
error stop
end if
!
! read
!
disp = 0_MPI_OFFSET_KIND
#if !defined(_DECOMP_X_IO)
call io_field(io,fh,ng,nh,lo,hi,disp,p)
#else
block
!
! I/O over x-aligned pencils
!
use decomp_2d
use mod_common_mpi, only: ipencil => ipencil_axis
real(rp), allocatable, dimension(:,:,:) :: tmp_x,tmp_y,tmp_z
select case(ipencil)
case(1)
allocate(tmp_x(0,0,0),tmp_y(0,0,0),tmp_z(0,0,0))
case(2)
allocate(tmp_x(xstart(1):xend(1),xstart(2):xend(2),xstart(3):xend(3)), &
tmp_y(ystart(1):yend(1),ystart(2):yend(2),ystart(3):yend(3)), &
tmp_z(0,0,0))
case(3)
allocate(tmp_x(xstart(1):xend(1),xstart(2):xend(2),xstart(3):xend(3)), &
tmp_y(ystart(1):yend(1),ystart(2):yend(2),ystart(3):yend(3)), &
tmp_z(zstart(1):zend(1),zstart(2):zend(2),zstart(3):zend(3)))
end select
call io_field(io,fh,ng,[0,0,0],lo,hi,disp,tmp_x)
call transpose_to_or_from_x(io,ipencil,nh,p,tmp_x,tmp_y,tmp_z)
deallocate(tmp_x,tmp_y,tmp_z)
end block
#endif
if(present(time) .and. present(istep)) then
call MPI_FILE_SET_VIEW(fh,disp,MPI_REAL_RP,MPI_REAL_RP,'native',MPI_INFO_NULL,ierr)
nreals_myid = 0
if(myid == 0) nreals_myid = 2
call MPI_FILE_READ(fh,fldinfo,nreals_myid,MPI_REAL_RP,MPI_STATUS_IGNORE,ierr)
call MPI_FILE_CLOSE(fh,ierr)
call MPI_BCAST(fldinfo,2,MPI_REAL_RP,0,comm,ierr)
time = fldinfo(1)
istep = nint(fldinfo(2))
end if
case('w')
!
! write
!
call MPI_FILE_OPEN(comm, filename , &
MPI_MODE_CREATE+MPI_MODE_WRONLY, MPI_INFO_NULL,fh,ierr)
filesize = 0_MPI_OFFSET_KIND
call MPI_FILE_SET_SIZE(fh,filesize,ierr)
disp = 0_MPI_OFFSET_KIND
#if !defined(_DECOMP_X_IO)
call io_field(io,fh,ng,nh,lo,hi,disp,p)
#else
block
!
! I/O over x-aligned pencils
!
use decomp_2d
use mod_common_mpi, only: ipencil => ipencil_axis
real(rp), allocatable, dimension(:,:,:) :: tmp_x,tmp_y,tmp_z
select case(ipencil)
case(1)
allocate(tmp_x(0,0,0),tmp_y(0,0,0),tmp_z(0,0,0))
case(2)
allocate(tmp_x(xstart(1):xend(1),xstart(2):xend(2),xstart(3):xend(3)), &
tmp_y(ystart(1):yend(1),ystart(2):yend(2),ystart(3):yend(3)), &
tmp_z(0,0,0))
case(3)
allocate(tmp_x(xstart(1):xend(1),xstart(2):xend(2),xstart(3):xend(3)), &
tmp_y(ystart(1):yend(1),ystart(2):yend(2),ystart(3):yend(3)), &
tmp_z(zstart(1):zend(1),zstart(2):zend(2),zstart(3):zend(3)))
end select
call transpose_to_or_from_x(io,ipencil,nh,p,tmp_x,tmp_y,tmp_z)
call io_field(io,fh,ng,[0,0,0],lo,hi,disp,tmp_x)
deallocate(tmp_x,tmp_y,tmp_z)
end block
#endif
if(present(time) .and. present(istep)) then
call MPI_FILE_SET_VIEW(fh,disp,MPI_REAL_RP,MPI_REAL_RP,'native',MPI_INFO_NULL,ierr)
fldinfo = [time,1._rp*istep]
nreals_myid = 0
if(myid == 0) nreals_myid = 2
call MPI_FILE_WRITE(fh,fldinfo,nreals_myid,MPI_REAL_RP,MPI_STATUS_IGNORE,ierr)
call MPI_FILE_CLOSE(fh,ierr)
end if
end select
end subroutine load_one
!
#if defined(_USE_HDF5)
subroutine io_field_hdf5(io,filename,varname,ng,nh,lo,hi,var,meta,x_g,y_g,z_g)
!
! collective single field data I/O using HDF5
!
! written with the help of Josh Romero,
! with the field data I/O inspired from the AFiD code
!
implicit none
character(len=1), intent(in) :: io
character(len=*), intent(in) :: filename,varname
integer , intent(in), dimension(3) :: ng,nh,lo,hi
real(rp), intent(inout), dimension(lo(1)-nh(1):,lo(2)-nh(2):,lo(3)-nh(3):) :: var
real(rp), intent(inout), dimension(2), optional :: meta
real(rp), intent(inout), dimension(0:), optional :: x_g,y_g,z_g
integer , dimension(3) :: n
integer , dimension(3) :: sizes,subsizes,starts
!
! HDF5 variables
!
integer :: ndims, ierr
integer(HID_T) :: file_id,group_id
integer(HID_T) :: filespace
integer(HID_T) :: slabspace
integer(HID_T) :: memspace
!
integer(HID_T) :: dset
!
integer(HSIZE_T) :: dims(3)
!
integer(HID_T) :: plist_id
integer(HSIZE_T) , dimension(3) :: data_count
integer(HSSIZE_T), dimension(3) :: data_offset
integer(HSSIZE_T), dimension(3) :: halo_offset
type(MPI_INFO) :: info = MPI_INFO_NULL
!
n(:) = hi(:)-lo(:)+1
sizes(:) = ng(:)
subsizes(:) = n(:)
starts(:) = lo(:) - 1 ! starts from 0
!
ndims = 3
dims(:) = ng(:)
data_count(:) = subsizes(:)
data_offset(:) = starts(:)
halo_offset(:) = nh(:)
!
select case(io)
case('r')
call h5pcreate_f(H5P_FILE_ACCESS_F,plist_id,ierr)
call h5pset_fapl_mpio_f(plist_id,MPI_COMM_WORLD%MPI_VAL,info%MPI_VAL,ierr)
call h5fopen_f(filename,H5F_ACC_RDONLY_F,file_id,ierr,access_prp=plist_id)
call h5pclose_f(plist_id,ierr)
!
call h5dopen_f(file_id,'fields/'//varname,dset,ierr)
call h5screate_simple_f(ndims,data_count+2*nh(:),memspace,ierr)
!
call h5dget_space_f(dset,slabspace,ierr)
call h5sselect_hyperslab_f(slabspace,H5S_SELECT_SET_F,data_offset,data_count,ierr)
call h5sselect_hyperslab_f(memspace,H5S_SELECT_SET_F,halo_offset,data_count,ierr)
call h5pcreate_f(H5P_DATASET_XFER_F,plist_id,ierr)
call h5pset_dxpl_mpio_f(plist_id,H5FD_MPIO_COLLECTIVE_F,ierr)
!
call h5dread_f(dset,H5T_NATIVE_DOUBLE,var,dims,ierr,file_space_id=slabspace,mem_space_id=memspace,xfer_prp=plist_id)
!
call h5pclose_f(plist_id,ierr)
call h5dclose_f(dset,ierr)
call h5sclose_f(memspace,ierr)
call h5fclose_f(file_id,ierr)
!
if(myid == 0) then
call h5fopen_f(filename,H5F_ACC_RDONLY_F,file_id,ierr)
call h5dopen_f(file_id,'meta/time',dset,ierr)
call h5dread_f(dset,H5T_NATIVE_DOUBLE,meta,[int(2,HSIZE_T)],ierr)
call h5dclose_f(dset,ierr)
call h5fclose_f(file_id,ierr)
end if
call MPI_Bcast(meta,2,MPI_REAL_RP,0,MPI_COMM_WORLD)
case('w')
call h5screate_simple_f(ndims,dims,filespace,ierr)
call h5pcreate_f(H5P_FILE_ACCESS_F,plist_id,ierr)
call h5pset_fapl_mpio_f(plist_id,MPI_COMM_WORLD%MPI_VAL,info%MPI_VAL,ierr)
call h5fcreate_f(filename,H5F_ACC_TRUNC_F,file_id,ierr,access_prp=plist_id)
call h5pclose_f(plist_id,ierr)
!
call h5gcreate_f(file_id,'fields',group_id,ierr)
call h5dcreate_f(group_id,varname,H5T_NATIVE_DOUBLE,filespace,dset,ierr)
call h5screate_simple_f(ndims,data_count+2*nh(:),memspace,ierr)
call h5dget_space_f(dset,slabspace,ierr)
call h5sselect_hyperslab_f(slabspace,H5S_SELECT_SET_F,data_offset,data_count,ierr)
call h5sselect_hyperslab_f(memspace,H5S_SELECT_SET_F,halo_offset,data_count,ierr)
call h5pcreate_f(H5P_DATASET_XFER_F,plist_id,ierr)
call h5pset_dxpl_mpio_f(plist_id,H5FD_MPIO_COLLECTIVE_F,ierr)
call h5dwrite_f(dset,H5T_NATIVE_DOUBLE,var,dims,ierr,file_space_id=slabspace,mem_space_id=memspace,xfer_prp=plist_id)
!
call h5pclose_f(plist_id,ierr)
call h5dclose_f(dset,ierr)
call h5sclose_f(memspace,ierr)
call h5sclose_f(slabspace,ierr)
call h5sclose_f(filespace,ierr)
call h5gclose_f(group_id,ierr)
call h5fclose_f(file_id,ierr)
!
! write metadata
!
if(myid == 0) then
call h5fopen_f(filename,H5F_ACC_RDWR_F,file_id,ierr)
!
if(present(x_g) .and. present(y_g) .and. present(z_g)) then
call h5gcreate_f(file_id,'grid',group_id,ierr)
call h5screate_simple_f(1,[int(ng(1),hsize_t)],filespace,ierr)
call h5dcreate_f(group_id,'x',h5t_native_double,filespace,dset,ierr)
call h5dwrite_f(dset,h5t_native_double,x_g(1:ng(1)),[int(ng(1),hsize_t)],ierr)
call h5screate_simple_f(1,[int(ng(2),hsize_t)],filespace,ierr)
call h5dcreate_f(group_id,'y',h5t_native_double,filespace,dset,ierr)
call h5dwrite_f(dset,h5t_native_double,y_g(1:ng(2)),[int(ng(2),hsize_t)],ierr)
call h5screate_simple_f(1,[int(ng(3),hsize_t)],filespace,ierr)
call h5dcreate_f(group_id,'z',h5t_native_double,filespace,dset,ierr)
call h5dwrite_f(dset,h5t_native_double,z_g(1:ng(3)),[int(ng(3),hsize_t)],ierr)
call h5dclose_f(dset,ierr)
call h5gclose_f(group_id,ierr)
call h5sclose_f(filespace,ierr)
end if
!
if(present(meta)) then
call h5gcreate_f(file_id,'meta',group_id,ierr)
call h5screate_simple_f(1,[int(2,hsize_t)],filespace,ierr)
call h5dcreate_f(group_id,'time',h5t_native_double,filespace,dset,ierr)
call h5dwrite_f(dset,h5t_native_double,meta,[int(2,hsize_t)],ierr)
call h5dclose_f(dset,ierr)
call h5gclose_f(group_id,ierr)
call h5sclose_f(filespace,ierr)
end if
call h5fclose_f(file_id,ierr)
end if
end select
end subroutine io_field_hdf5
#endif
end module mod_load
6 changes: 3 additions & 3 deletions src/main.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ program cans
use mod_initgrid , only: initgrid
use mod_initmpi , only: initmpi
use mod_initsolver , only: initsolver
use mod_load , only: load
use mod_load , only: load_all
use mod_mom , only: bulk_forcing
use mod_rk , only: rk
use mod_output , only: out0d,gen_alias,out1d,out1d_chan,out2d,out3d,write_log_output,write_visu_2d,write_visu_3d
Expand Down Expand Up @@ -313,7 +313,7 @@ program cans
call initflow(inivel,ng,lo,zc,dzc,dzf,visc,u,v,w,p)
if(myid == 0) print*, '*** Initial condition succesfully set ***'
else
call load('r',trim(datadir)//'fld.bin',MPI_COMM_WORLD,ng,[1,1,1],lo,hi,u,v,w,p,time,istep)
call load_all('r',trim(datadir)//'fld.bin',MPI_COMM_WORLD,ng,[1,1,1],lo,hi,u,v,w,p,time,istep)
if(myid == 0) print*, '*** Checkpoint loaded at time = ', time, 'time step = ', istep, '. ***'
end if
!$acc enter data copyin(u,v,w,p) create(pp)
Expand Down Expand Up @@ -542,7 +542,7 @@ program cans
end if
end if
!$acc update self(u,v,w,p)
call load('w',trim(datadir)//trim(filename),MPI_COMM_WORLD,ng,[1,1,1],lo,hi,u,v,w,p,time,istep)
call load_all('w',trim(datadir)//trim(filename),MPI_COMM_WORLD,ng,[1,1,1],lo,hi,u,v,w,p,time,istep)
if(.not.is_overwrite_save) then
!
! fld.bin -> last checkpoint file (symbolic link)
Expand Down
Loading

0 comments on commit f159c95

Please sign in to comment.