Cloned library HDF5-1.14.1 with extra build files for internal package management.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

412 lines
14 KiB

2 years ago
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! Copyright by The HDF Group. *
! All rights reserved. *
! *
! This file is part of HDF5. The full HDF5 copyright notice, including *
! terms governing use, modification, and redistribution, is contained in *
! the COPYING file, which can be found at the root of the source code *
! distribution tree, or in https://www.hdfgroup.org/licenses. *
! If you do not have access to either file, you may request a copy from *
! help@hdfgroup.org. *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!
! main program for subfiling HDF5 Fortran tests
!
#include <H5config_f.inc>
PROGRAM subfiling_test
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT64_T
USE HDF5
USE MPI
USE TH5_MISC
IMPLICIT NONE
INTEGER :: total_error = 0 ! sum of the number of errors
INTEGER :: mpierror ! MPI hdferror flag
INTEGER :: mpi_rank ! rank of the calling process in the communicator
#ifdef H5_HAVE_SUBFILING_VFD
CHARACTER(LEN=7), PARAMETER :: filename = "subf.h5"
INTEGER :: hdferror ! HDF hdferror flag
INTEGER :: mpi_size, mpi_size_ret ! number of processes in the group of communicator
INTEGER :: required, provided
LOGICAL :: file_exists
INTEGER(HID_T) :: fapl_id
INTEGER(HID_T) :: file_id
INTEGER :: comm, comm_ret
INTEGER :: info, info_ret
CHARACTER(LEN=3) :: info_val
CHARACTER(LEN=180) :: subfname
INTEGER :: i, sum
INTEGER(C_INT64_T) inode
TYPE(H5FD_subfiling_config_t) :: vfd_config
TYPE(H5FD_ioc_config_t) :: vfd_config_ioc
LOGICAL :: flag
INTEGER :: nerrors = 0
INTEGER(HID_T) :: driver_id
CHARACTER(len=8) :: hex1, hex2
!
! initialize MPI
!
required = MPI_THREAD_MULTIPLE
CALL mpi_init_thread(required, provided, mpierror)
IF (mpierror .NE. MPI_SUCCESS) THEN
WRITE(*,*) "MPI_INIT_THREAD *FAILED*"
nerrors = nerrors + 1
ENDIF
IF (provided .NE. required) THEN
WRITE(*,*) "MPI doesn't support MPI_Init_thread with MPI_THREAD_MULTIPLE *FAILED*"
nerrors = nerrors + 1
ENDIF
CALL mpi_comm_rank( MPI_COMM_WORLD, mpi_rank, mpierror )
IF (mpierror .NE. MPI_SUCCESS) THEN
WRITE(*,*) "MPI_COMM_RANK *FAILED* Process = ", mpi_rank
nerrors = nerrors + 1
ENDIF
CALL mpi_comm_size( MPI_COMM_WORLD, mpi_size, mpierror )
IF (mpierror .NE. MPI_SUCCESS) THEN
WRITE(*,*) "MPI_COMM_SIZE *FAILED* Process = ", mpi_rank
nerrors = nerrors + 1
ENDIF
IF(nerrors.NE.0)THEN
IF(mpi_rank==0) CALL write_test_status(sum, &
'Testing Initializing mpi_init_thread', total_error)
CALL MPI_Barrier(MPI_COMM_WORLD, mpierror)
CALL mpi_abort(MPI_COMM_WORLD, 1, mpierror)
ENDIF
!
! initialize the HDF5 fortran interface
!
CALL h5open_f(hdferror)
IF(mpi_rank==0) CALL write_test_header("SUBFILING FORTRAN TESTING")
! ***********************************
! Test H5Pset/get_mpi_params_f APIs
! ***********************************
nerrors = 0
IF(mpi_size.GT.2)THEN
IF (mpi_rank.LE.1)THEN
CALL MPI_Comm_split(MPI_COMM_WORLD, 1, mpi_rank, comm, mpierror)
ELSE
CALL MPI_Comm_split(MPI_COMM_WORLD, 0, mpi_rank, comm, mpierror)
ENDIF
CALL MPI_Info_create(info, mpierror)
CALL MPI_Info_set( info, "foo", "bar", mpierror)
IF (mpi_rank.LE.1)THEN
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
CALL check("h5pcreate_f", hdferror, nerrors)
CALL H5Pset_mpi_params_f(fapl_id, comm, info, hdferror)
CALL check("H5Pset_mpi_params_f", hdferror, nerrors)
CALL H5Pget_mpi_params_f(fapl_id, comm_ret, info_ret, hdferror)
CALL check("H5Pget_mpi_params_f", hdferror, nerrors)
CALL mpi_comm_size(comm_ret, mpi_size_ret, mpierror)
IF(mpi_size_ret.NE.2)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
nerrors = nerrors + 1
ENDIF
CALL mpi_info_get(info_ret,"foo", 3, info_val, flag, mpierror)
IF(flag .EQV. .TRUE.)THEN
IF(info_val.NE."bar")THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
nerrors = nerrors + 1
ENDIF
ELSE
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed to find info value with mpi_info_get"
nerrors = nerrors + 1
ENDIF
CALL h5pclose_f(fapl_id, hdferror)
ENDIF
CALL MPI_Comm_free(comm, mpierror)
CALL MPI_Info_free(info, mpierror)
ENDIF
CALL MPI_REDUCE(nerrors, sum, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, mpierror)
IF(mpi_rank==0) CALL write_test_status(sum, &
'Testing H5Pset/get_mpi_params_f', total_error)
! *********************************************************
! Setup file access property list with subfiling I/O access
! *********************************************************
nerrors = 0
CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
CALL check("h5pcreate_f", hdferror, nerrors)
CALL H5Pset_mpi_params_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror)
CALL check("H5Pset_mpi_params_f", hdferror, nerrors)
CALL H5Pget_mpi_params_f(fapl_id, comm, info, hdferror)
CALL check("H5Pset_mpi_params_f", hdferror, nerrors)
CALL mpi_comm_size(comm, mpi_size_ret, mpierror)
IF(mpi_size_ret.NE.mpi_size)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Pset/get_mpi_params_f with defaults ', total_error)
! Verify no new enum parameters have been added in C and not updated in Fortran
IF( IOC_SELECTION_OPTIONS_F .NE. 4)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Mismatch between Fortran and C H5FD_subfiling_ioc_select_t definitions"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing Subfiling FD is registered', total_error)
! *********************************************************
! Check the default subfiling parameters
! *********************************************************
nerrors = 0
CALL h5pset_fapl_subfiling_f(fapl_id, hdferror)
CALL check("h5pset_fapl_subfiling_f", hdferror, nerrors)
CALL h5pget_driver_f(fapl_id, driver_id, hdferror)
CALL check("h5pget_driver_f", hdferror, nerrors)
IF( driver_id .NE. H5FD_SUBFILING_F) THEN
WRITE(*,*) "Wrong file driver type returned"
nerrors = nerrors + 1
ENDIF
! *********************************************************
! Check the default parameters for subfiling and ioc
! *********************************************************
CALL h5pget_fapl_subfiling_f(fapl_id, vfd_config, hdferror)
CALL check("h5pget_fapl_subfiling_f", hdferror, nerrors)
CALL h5pset_fapl_ioc_f(vfd_config%ioc_fapl_id, hdferror)
CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)
CALL h5pget_fapl_ioc_f(vfd_config%ioc_fapl_id, vfd_config_ioc, hdferror)
CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)
WRITE(hex1,'(z8)') H5FD_SUBFILING_FAPL_MAGIC_F
WRITE(hex2,'(z8)') vfd_config%magic
IF(hex1 .NE. hex2 .OR. &
vfd_config%version .NE. H5FD_SUBFILING_CURR_FAPL_VERSION_F .OR. &
.NOT.vfd_config%require_ioc .OR. &
vfd_config%shared_cfg%ioc_selection .NE. SELECT_IOC_ONE_PER_NODE_F .OR. &
vfd_config%shared_cfg%stripe_size .NE. H5FD_SUBFILING_DEFAULT_STRIPE_SIZE_F .OR. &
vfd_config%shared_cfg%stripe_count .NE. H5FD_SUBFILING_DEFAULT_STRIPE_COUNT_F &
)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed h5pget_fapl_subfiling_f"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Pset/get_fapl_subfiling_f with defaults', total_error)
WRITE(hex1,'(z8)') H5FD_IOC_FAPL_MAGIC_F
WRITE(hex2,'(z8)') vfd_config_ioc%magic
nerrors = 0
IF(hex1 .NE. hex2 .OR. &
vfd_config_ioc%version .NE. H5FD_IOC_CURR_FAPL_VERSION_F .OR. &
vfd_config_ioc%thread_pool_size .NE. H5FD_IOC_DEFAULT_THREAD_POOL_SIZE_F &
)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed h5pget_fapl_ioc_f"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Pset/get_fapl_ioc_f with defaults', total_error)
! *********************************************************
! Testing creating a file with subfiling, default settings
! *********************************************************
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
CALL check("h5fcreate_f", hdferror, nerrors)
CALL h5fclose_f(file_id, hdferror)
CALL check("h5fclose_f", hdferror, nerrors)
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Fcreate with subfiling with default settings', total_error)
! *********************************************************
! Testing creating a file with subfiling, modified settings
! *********************************************************
! Testing modifying defaults for subfiling FD
vfd_config%magic = H5FD_SUBFILING_FAPL_MAGIC_F
vfd_config%version = H5FD_SUBFILING_CURR_FAPL_VERSION_F
vfd_config%require_ioc = .TRUE.
vfd_config%shared_cfg%ioc_selection = SELECT_IOC_ONE_PER_NODE_F
vfd_config%shared_cfg%stripe_size = 16*1024*1024
vfd_config%shared_cfg%stripe_count = 3
nerrors = 0
CALL h5pset_fapl_subfiling_f(fapl_id, hdferror, vfd_config)
CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)
CALL h5pget_fapl_subfiling_f(fapl_id, vfd_config, hdferror)
CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)
WRITE(hex1,'(z8)') H5FD_SUBFILING_FAPL_MAGIC_F
WRITE(hex2,'(z8)') vfd_config%magic
IF(hex1 .NE. hex2 .OR. &
vfd_config%version .NE. H5FD_SUBFILING_CURR_FAPL_VERSION_F .OR. &
.NOT.vfd_config%require_ioc .OR. &
vfd_config%shared_cfg%ioc_selection .NE. SELECT_IOC_ONE_PER_NODE_F .OR. &
vfd_config%shared_cfg%stripe_size .NE. 16*1024*1024 .OR. &
vfd_config%shared_cfg%stripe_count .NE. 3 &
)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed h5pget_fapl_subfiling_f"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Pset/get_fapl_subfiling_f with custom settings', total_error)
vfd_config_ioc%magic = H5FD_IOC_FAPL_MAGIC_F
vfd_config_ioc%version = H5FD_IOC_CURR_FAPL_VERSION_F
vfd_config_ioc%thread_pool_size = 2
nerrors = 0
CALL h5pset_fapl_ioc_f(vfd_config%ioc_fapl_id, hdferror, vfd_config_ioc)
CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)
CALL h5pget_fapl_ioc_f(vfd_config%ioc_fapl_id, vfd_config_ioc, hdferror)
CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)
IF(& !vfd_config_ioc%magic .NE. H5FD_IOC_FAPL_MAGIC_F .OR. &
vfd_config_ioc%version .NE. H5FD_IOC_CURR_FAPL_VERSION_F .OR. &
vfd_config_ioc%thread_pool_size .NE. 2 &
)THEN
IF(mpi_rank.EQ.0) &
WRITE(*,*) "Failed h5pget_fapl_ioc_f"
nerrors = nerrors + 1
ENDIF
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Pset/get_fapl_ioc_f with custom settings', total_error)
! *********************************************************
! Testing creating a file with subfiling, custom settings
! *********************************************************
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
CALL check("h5pcreate_f", hdferror, nerrors)
CALL h5fclose_f(file_id, hdferror)
CALL check("h5fclose_f", hdferror, nerrors)
IF(mpi_rank.EQ.0)THEN
INQUIRE(FILE=filename, EXIST=file_exists)
IF(.NOT.file_exists)THEN
WRITE(*,"(A,A)") "Failed to find the stub subfile ",TRIM(filename)
nerrors = nerrors + 1
ENDIF
CALL EXECUTE_COMMAND_LINE("stat --format='%i' "//filename//" >> tmp_inode", EXITSTAT=i)
IF(i.ne.0)THEN
WRITE(*,"(A,A)") "Failed to stat the stub subfile ",TRIM(filename)
nerrors = nerrors + 1
ENDIF
OPEN(11,FILE="tmp_inode")
READ(11,*) inode
CLOSE(11,STATUS="delete")
DO i = 1, vfd_config%shared_cfg%stripe_count
WRITE(subfname,'(A,".subfile_",I0,"_",I0,"_of_",I0)') filename,inode,i,vfd_config%shared_cfg%stripe_count
INQUIRE(FILE=subfname, EXIST=file_exists)
IF(.NOT.file_exists)THEN
WRITE(*,"(A,A)") "Failed to create the subfile ",TRIM(subfname)
nerrors = nerrors + 1
ENDIF
ENDDO
ENDIF
CALL h5pclose_f(fapl_id, hdferror)
CALL check("h5pclose_f", hdferror, nerrors)
IF(mpi_rank==0) CALL write_test_status(nerrors, &
'Testing H5Fcreate with subfiling with custom settings', total_error)
!
! close HDF5 interface
!
CALL h5close_f(hdferror)
CALL MPI_ALLREDUCE(total_error, sum, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, mpierror)
!
! close MPI
!
IF (sum == 0) THEN
CALL mpi_finalize(mpierror)
IF (mpierror .NE. MPI_SUCCESS) THEN
WRITE(*,*) "MPI_FINALIZE *FAILED* Process = ", mpi_rank
ENDIF
ELSE
WRITE(*,*) 'Errors detected in process ', mpi_rank
CALL mpi_abort(MPI_COMM_WORLD, 1, mpierror)
IF (mpierror .NE. MPI_SUCCESS) THEN
WRITE(*,*) "MPI_ABORT *FAILED* Process = ", mpi_rank
ENDIF
ENDIF
IF(mpi_rank==0) CALL write_test_footer()
!
! end main program
!
#else
CALL mpi_init(mpierror)
CALL mpi_comm_rank(MPI_COMM_WORLD, mpi_rank, mpierror)
IF(mpi_rank==0) THEN
CALL write_test_header("SUBFILING FORTRAN TESTING")
CALL write_test_status( -1, 'Subfiling not enabled', total_error)
CALL write_test_footer()
ENDIF
CALL mpi_finalize(mpierror)
#endif
END PROGRAM subfiling_test