From c4cd250408c7f973c909a56c3cae18ed6a0118f2 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 4 May 2022 18:29:49 -0500 Subject: changes parallel tests to .F90 ext. and fixes the CALL check strings (#1725) --- fortran/testpar/CMakeLists.txt | 6 +- fortran/testpar/Makefile.am | 2 +- fortran/testpar/hyper.F90 | 372 +++++++++++++++++++++++++++++++++++++++++ fortran/testpar/hyper.f90 | 372 ----------------------------------------- fortran/testpar/mdset.F90 | 317 +++++++++++++++++++++++++++++++++++ fortran/testpar/mdset.f90 | 318 ----------------------------------- fortran/testpar/ptest.F90 | 103 ++++++++++++ fortran/testpar/ptest.f90 | 103 ------------ 8 files changed, 796 insertions(+), 797 deletions(-) create mode 100644 fortran/testpar/hyper.F90 delete mode 100644 fortran/testpar/hyper.f90 create mode 100644 fortran/testpar/mdset.F90 delete mode 100644 fortran/testpar/mdset.f90 create mode 100644 fortran/testpar/ptest.F90 delete mode 100644 fortran/testpar/ptest.f90 diff --git a/fortran/testpar/CMakeLists.txt b/fortran/testpar/CMakeLists.txt index 12489528..c37e84c 100644 --- a/fortran/testpar/CMakeLists.txt +++ b/fortran/testpar/CMakeLists.txt @@ -17,9 +17,9 @@ endif () #-- Adding test for parallel_test add_executable (parallel_test - ptest.f90 - hyper.f90 - mdset.f90 + ptest.F90 + hyper.F90 + mdset.F90 ) target_include_directories (parallel_test PRIVATE ${TESTPAR_INCLUDES} diff --git a/fortran/testpar/Makefile.am b/fortran/testpar/Makefile.am index f4bb73f..00538f4 100644 --- a/fortran/testpar/Makefile.am +++ b/fortran/testpar/Makefile.am @@ -40,7 +40,7 @@ check_PROGRAMS=$(TEST_PROG_PARA) CHECK_CLEANFILES+=parf[12].h5 # Test source files -parallel_test_SOURCES=ptest.f90 hyper.f90 mdset.f90 +parallel_test_SOURCES=ptest.F90 hyper.F90 mdset.F90 # The tests depend on several libraries. LDADD=$(LIBH5FTEST) $(LIBH5TEST) $(LIBH5F) $(LIBHDF5) diff --git a/fortran/testpar/hyper.F90 b/fortran/testpar/hyper.F90 new file mode 100644 index 0000000..4dc18a7 --- /dev/null +++ b/fortran/testpar/hyper.F90 @@ -0,0 +1,372 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + +! +! writes/reads dataset by hyperslabs +! + +SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) + USE HDF5 + USE MPI + USE TH5_MISC + + IMPLICIT NONE + + INTEGER, INTENT(in) :: length ! array length + LOGICAL, INTENT(in) :: do_collective ! use collective I/O + LOGICAL, INTENT(in) :: do_chunk ! use chunking + INTEGER, INTENT(in) :: mpi_size ! number of processes in the group of communicator + INTEGER, INTENT(in) :: mpi_rank ! rank of the calling process in the communicator + INTEGER, INTENT(inout) :: nerrors ! number of errors + INTEGER :: mpierror ! MPI hdferror flag + INTEGER :: hdferror ! HDF hdferror flag + INTEGER(hsize_t), DIMENSION(1) :: dims ! dataset dimensions + INTEGER(hsize_t), DIMENSION(1) :: cdims ! chunk dimensions + INTEGER, ALLOCATABLE :: wbuf(:) ! write buffer + INTEGER, ALLOCATABLE :: rbuf(:) ! read buffer + INTEGER(hsize_t), DIMENSION(1) :: counti ! hyperslab selection + INTEGER(hsize_t), DIMENSION(1) :: start ! hyperslab selection + INTEGER(hid_t) :: fapl_id ! file access identifier + INTEGER(hid_t) :: dxpl_id ! dataset transfer property list + INTEGER(hid_t) :: dcpl_id ! dataset creation property list + INTEGER(hid_t) :: file_id ! file identifier + INTEGER(hid_t) :: dset_id ! dataset identifier + INTEGER(hid_t) :: fspace_id ! file space identifier + INTEGER(hid_t) :: mspace_id ! memory space identifier + INTEGER(hid_t) :: driver_id ! low-level file driver identifier + INTEGER :: istart ! start position in array + INTEGER :: iend ! end position in array + INTEGER :: icount ! number of elements in array + CHARACTER(len=80) :: filename ! filename + INTEGER :: i + INTEGER :: actual_io_mode ! The type of I/O performed by this process + LOGICAL :: is_coll + LOGICAL :: is_coll_true = .TRUE. + ! + ! initialize the array data between the processes (3) + ! for the 12 size array we get + ! p0 = 1,2,3,4 + ! p1 = 5,6,7,8 + ! p2 = 9,10,11,12 + ! + + ALLOCATE(wbuf(0:length-1),stat=hdferror) + IF (hdferror /= 0) THEN + WRITE(*,*) 'allocate error' + RETURN + ENDIF + + ALLOCATE(rbuf(0:length-1),stat=hdferror) + IF (hdferror /= 0) THEN + WRITE(*,*) 'allocate error' + RETURN + ENDIF + + icount = length/mpi_size ! divide the array by the number of processes + istart = mpi_rank*icount ! start position + iend = istart + icount ! end position + + DO i = istart, iend-1 + wbuf(i) = i + ENDDO + + ! + ! HDF5 I/O + ! + + dims(1) = length + cdims(1) = length/mpi_size ! define chunks as the number of processes + + ! + ! setup file access property list with parallel I/O access + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) + + CALL h5pget_driver_f(fapl_id, driver_id, hdferror) + CALL check("h5pget_driver_f", hdferror, nerrors) + + IF( driver_id /= H5FD_MPIO_F) THEN + WRITE(*,*) "Wrong driver information returned" + nerrors = nerrors + 1 + ENDIF + + ! + ! create the file collectively + ! + CALL h5_fixname_f("parf1", filename, fapl_id, hdferror) + + IF(do_collective)THEN + ! verify settings for file access properties + + ! Collective metadata writes + CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror) + CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors) + IF(is_coll .NEQV. .FALSE.)THEN + PRINT*, "Incorrect property setting for coll metadata writes" + nerrors = nerrors + 1 + ENDIF + + ! Collective metadata read API calling requirement + CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror) + CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors) + IF(is_coll .NEQV. .FALSE.)THEN + PRINT*, "Incorrect property setting for coll metadata API calls requirement" + nerrors = nerrors + 1 + ENDIF + + ! Collective metadata writes + CALL h5pset_coll_metadata_write_f(fapl_id, .TRUE., hdferror) + CALL check("h5pset_coll_metadata_write_f", hdferror, nerrors) + ! Collective metadata READ API calling requirement + CALL h5pset_all_coll_metadata_ops_f(fapl_id, is_coll_true, hdferror) + CALL check("h5pset_all_coll_metadata_ops_f", hdferror, nerrors) + + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) + CALL check("h5fcreate_f", hdferror, nerrors) + + ! close fapl and retrieve it from file + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + CALL h5fget_access_plist_f(file_id, fapl_id, hdferror) + CALL check("h5fget_access_plist_f", hdferror, nerrors) + + ! verify settings for file access properties + + ! Collective metadata writes + CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror) + CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors) + IF(is_coll .NEQV. .TRUE.)THEN + PRINT*, "Incorrect property setting for coll metadata writes" + nerrors = nerrors + 1 + ENDIF + + ! Collective metadata read API calling requirement + CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror) + CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors) + IF(is_coll .NEQV. .TRUE.)THEN + PRINT*, "Incorrect property setting for coll metadata API calls requirement" + nerrors = nerrors + 1 + ENDIF + ELSE + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) + CALL check("h5fcreate_f", hdferror, nerrors) + ENDIF + + CALL h5screate_simple_f(1, dims, fspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, mspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + ! + ! modify dataset creation properties to enable chunking + ! + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_chunk) THEN + CALL h5pset_chunk_f(dcpl_id, 1, cdims, hdferror) + CALL check("h5pset_chunk_f", hdferror, nerrors) + ENDIF + + ! + ! create the dataset + ! + + CALL h5dcreate_f(file_id, "dset", H5T_NATIVE_INTEGER, fspace_id, dset_id, hdferror, dcpl_id) + CALL check("h5dcreate_f", hdferror, nerrors) + + ! + ! define hyperslab + ! + + counti(1) = icount + start(1) = istart + + ! + ! select hyperslab in memory + ! + + CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + ! + ! select hyperslab in the file + ! + + CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + + ! + ! create a property list for collective dataset write + ! + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_collective) THEN + CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) + CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors) + ENDIF + + ! + ! write dataset + ! + + CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) + CALL check("h5dwrite_f", hdferror, nerrors) + + + ! Check h5pget_mpio_actual_io_mode_f function + CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror) + CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors) + + IF(do_collective.AND.do_chunk)THEN + IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF(.NOT.do_collective)THEN + IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN + IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN + CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) + ENDIF + ENDIF + + ! + ! close HDF5 I/O + ! + + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5pclose_f(dcpl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5pclose_f(dxpl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5sclose_f(mspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5sclose_f(fspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5dclose_f(dset_id, hdferror) + CALL check("h5dclose_f", hdferror, nerrors) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5fclose_f", hdferror, nerrors) + + ! + ! reopen file with read access + ! + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, fspace_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, mspace_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5dopen_f(file_id, "dset", dset_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + ! + ! select hyperslab in memory + ! + + CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + ! + ! select hyperslab in the file + ! + + CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + ! + ! create a property list for collective dataset read + ! + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_collective) THEN + CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + ENDIF + + ! + ! read dataset + ! + + CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,rbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) + CALL check("h5pcreate_f", hdferror, nerrors) + + ! + ! close HDF5 I/O + ! + + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pclose_f(dxpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5sclose_f(fspace_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5sclose_f(mspace_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5dclose_f(dset_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + ! + ! compare read and write data. each process compares a subset of the array + ! + + DO i = istart, iend-1 + IF( wbuf(i) /= rbuf(i)) THEN + WRITE(*,*) 'buffers differs at ', i, rbuf(i), wbuf(i) + nerrors = nerrors + 1 + ENDIF + ENDDO + + DEALLOCATE(wbuf) + DEALLOCATE(rbuf) + +END SUBROUTINE hyper + diff --git a/fortran/testpar/hyper.f90 b/fortran/testpar/hyper.f90 deleted file mode 100644 index 4dc18a7..0000000 --- a/fortran/testpar/hyper.f90 +++ /dev/null @@ -1,372 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * - - -! -! writes/reads dataset by hyperslabs -! - -SUBROUTINE hyper(length,do_collective,do_chunk, mpi_size, mpi_rank, nerrors) - USE HDF5 - USE MPI - USE TH5_MISC - - IMPLICIT NONE - - INTEGER, INTENT(in) :: length ! array length - LOGICAL, INTENT(in) :: do_collective ! use collective I/O - LOGICAL, INTENT(in) :: do_chunk ! use chunking - INTEGER, INTENT(in) :: mpi_size ! number of processes in the group of communicator - INTEGER, INTENT(in) :: mpi_rank ! rank of the calling process in the communicator - INTEGER, INTENT(inout) :: nerrors ! number of errors - INTEGER :: mpierror ! MPI hdferror flag - INTEGER :: hdferror ! HDF hdferror flag - INTEGER(hsize_t), DIMENSION(1) :: dims ! dataset dimensions - INTEGER(hsize_t), DIMENSION(1) :: cdims ! chunk dimensions - INTEGER, ALLOCATABLE :: wbuf(:) ! write buffer - INTEGER, ALLOCATABLE :: rbuf(:) ! read buffer - INTEGER(hsize_t), DIMENSION(1) :: counti ! hyperslab selection - INTEGER(hsize_t), DIMENSION(1) :: start ! hyperslab selection - INTEGER(hid_t) :: fapl_id ! file access identifier - INTEGER(hid_t) :: dxpl_id ! dataset transfer property list - INTEGER(hid_t) :: dcpl_id ! dataset creation property list - INTEGER(hid_t) :: file_id ! file identifier - INTEGER(hid_t) :: dset_id ! dataset identifier - INTEGER(hid_t) :: fspace_id ! file space identifier - INTEGER(hid_t) :: mspace_id ! memory space identifier - INTEGER(hid_t) :: driver_id ! low-level file driver identifier - INTEGER :: istart ! start position in array - INTEGER :: iend ! end position in array - INTEGER :: icount ! number of elements in array - CHARACTER(len=80) :: filename ! filename - INTEGER :: i - INTEGER :: actual_io_mode ! The type of I/O performed by this process - LOGICAL :: is_coll - LOGICAL :: is_coll_true = .TRUE. - ! - ! initialize the array data between the processes (3) - ! for the 12 size array we get - ! p0 = 1,2,3,4 - ! p1 = 5,6,7,8 - ! p2 = 9,10,11,12 - ! - - ALLOCATE(wbuf(0:length-1),stat=hdferror) - IF (hdferror /= 0) THEN - WRITE(*,*) 'allocate error' - RETURN - ENDIF - - ALLOCATE(rbuf(0:length-1),stat=hdferror) - IF (hdferror /= 0) THEN - WRITE(*,*) 'allocate error' - RETURN - ENDIF - - icount = length/mpi_size ! divide the array by the number of processes - istart = mpi_rank*icount ! start position - iend = istart + icount ! end position - - DO i = istart, iend-1 - wbuf(i) = i - ENDDO - - ! - ! HDF5 I/O - ! - - dims(1) = length - cdims(1) = length/mpi_size ! define chunks as the number of processes - - ! - ! setup file access property list with parallel I/O access - ! - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) - CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) - - CALL h5pget_driver_f(fapl_id, driver_id, hdferror) - CALL check("h5pget_driver_f", hdferror, nerrors) - - IF( driver_id /= H5FD_MPIO_F) THEN - WRITE(*,*) "Wrong driver information returned" - nerrors = nerrors + 1 - ENDIF - - ! - ! create the file collectively - ! - CALL h5_fixname_f("parf1", filename, fapl_id, hdferror) - - IF(do_collective)THEN - ! verify settings for file access properties - - ! Collective metadata writes - CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror) - CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors) - IF(is_coll .NEQV. .FALSE.)THEN - PRINT*, "Incorrect property setting for coll metadata writes" - nerrors = nerrors + 1 - ENDIF - - ! Collective metadata read API calling requirement - CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror) - CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors) - IF(is_coll .NEQV. .FALSE.)THEN - PRINT*, "Incorrect property setting for coll metadata API calls requirement" - nerrors = nerrors + 1 - ENDIF - - ! Collective metadata writes - CALL h5pset_coll_metadata_write_f(fapl_id, .TRUE., hdferror) - CALL check("h5pset_coll_metadata_write_f", hdferror, nerrors) - ! Collective metadata READ API calling requirement - CALL h5pset_all_coll_metadata_ops_f(fapl_id, is_coll_true, hdferror) - CALL check("h5pset_all_coll_metadata_ops_f", hdferror, nerrors) - - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) - CALL check("h5fcreate_f", hdferror, nerrors) - - ! close fapl and retrieve it from file - CALL h5pclose_f(fapl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - CALL h5fget_access_plist_f(file_id, fapl_id, hdferror) - CALL check("h5fget_access_plist_f", hdferror, nerrors) - - ! verify settings for file access properties - - ! Collective metadata writes - CALL h5pget_coll_metadata_write_f(fapl_id, is_coll, hdferror) - CALL check("h5pget_coll_metadata_write_f", hdferror, nerrors) - IF(is_coll .NEQV. .TRUE.)THEN - PRINT*, "Incorrect property setting for coll metadata writes" - nerrors = nerrors + 1 - ENDIF - - ! Collective metadata read API calling requirement - CALL h5pget_all_coll_metadata_ops_f(fapl_id, is_coll, hdferror) - CALL check("h5pget_all_coll_metadata_ops_f", hdferror, nerrors) - IF(is_coll .NEQV. .TRUE.)THEN - PRINT*, "Incorrect property setting for coll metadata API calls requirement" - nerrors = nerrors + 1 - ENDIF - ELSE - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) - CALL check("h5fcreate_f", hdferror, nerrors) - ENDIF - - CALL h5screate_simple_f(1, dims, fspace_id, hdferror) - CALL check("h5screate_simple_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, mspace_id, hdferror) - CALL check("h5screate_simple_f", hdferror, nerrors) - - ! - ! modify dataset creation properties to enable chunking - ! - - CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_chunk) THEN - CALL h5pset_chunk_f(dcpl_id, 1, cdims, hdferror) - CALL check("h5pset_chunk_f", hdferror, nerrors) - ENDIF - - ! - ! create the dataset - ! - - CALL h5dcreate_f(file_id, "dset", H5T_NATIVE_INTEGER, fspace_id, dset_id, hdferror, dcpl_id) - CALL check("h5dcreate_f", hdferror, nerrors) - - ! - ! define hyperslab - ! - - counti(1) = icount - start(1) = istart - - ! - ! select hyperslab in memory - ! - - CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5sselect_hyperslab_f", hdferror, nerrors) - - ! - ! select hyperslab in the file - ! - - CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5sselect_hyperslab_f", hdferror, nerrors) - - - ! - ! create a property list for collective dataset write - ! - - CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_collective) THEN - CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) - CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors) - ENDIF - - ! - ! write dataset - ! - - CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) - CALL check("h5dwrite_f", hdferror, nerrors) - - - ! Check h5pget_mpio_actual_io_mode_f function - CALL h5pget_mpio_actual_io_mode_f(dxpl_id, actual_io_mode, hdferror) - CALL check("h5pget_mpio_actual_io_mode_f", hdferror, nerrors) - - IF(do_collective.AND.do_chunk)THEN - IF(actual_io_mode.NE.H5D_MPIO_CHUNK_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ELSEIF(.NOT.do_collective)THEN - IF(actual_io_mode.NE.H5D_MPIO_NO_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ELSEIF( do_collective.AND.(.NOT.do_chunk))THEN - IF(actual_io_mode.NE.H5D_MPIO_CONTIG_COLLECTIVE_F)THEN - CALL check("h5pget_mpio_actual_io_mode_f", -1, nerrors) - ENDIF - ENDIF - - ! - ! close HDF5 I/O - ! - - CALL h5pclose_f(fapl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5pclose_f(dcpl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5pclose_f(dxpl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5sclose_f(mspace_id, hdferror) - CALL check("h5sclose_f", hdferror, nerrors) - - CALL h5sclose_f(fspace_id, hdferror) - CALL check("h5sclose_f", hdferror, nerrors) - - CALL h5dclose_f(dset_id, hdferror) - CALL check("h5dclose_f", hdferror, nerrors) - - CALL h5fclose_f(file_id, hdferror) - CALL check("h5fclose_f", hdferror, nerrors) - - ! - ! reopen file with read access - ! - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, fspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, mspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5dopen_f(file_id, "dset", dset_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! - ! select hyperslab in memory - ! - - CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! - ! select hyperslab in the file - ! - - CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! - ! create a property list for collective dataset read - ! - - CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_collective) THEN - CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - ENDIF - - ! - ! read dataset - ! - - CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,rbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! - ! close HDF5 I/O - ! - - CALL h5pclose_f(fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pclose_f(dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5sclose_f(fspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5sclose_f(mspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5dclose_f(dset_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5fclose_f(file_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! - ! compare read and write data. each process compares a subset of the array - ! - - DO i = istart, iend-1 - IF( wbuf(i) /= rbuf(i)) THEN - WRITE(*,*) 'buffers differs at ', i, rbuf(i), wbuf(i) - nerrors = nerrors + 1 - ENDIF - ENDDO - - DEALLOCATE(wbuf) - DEALLOCATE(rbuf) - -END SUBROUTINE hyper - diff --git a/fortran/testpar/mdset.F90 b/fortran/testpar/mdset.F90 new file mode 100644 index 0000000..9aa7b9e --- /dev/null +++ b/fortran/testpar/mdset.F90 @@ -0,0 +1,317 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + +!////////////////////////////////////////////////////////// +! writes/reads dataset by hyperslabs +!////////////////////////////////////////////////////////// + +SUBROUTINE multiple_dset_write(length, do_collective, do_chunk, mpi_size, mpi_rank, nerrors) + USE HDF5 + USE MPI + USE TH5_MISC + + IMPLICIT NONE + + INTEGER, INTENT(in) :: length ! array length + LOGICAL, INTENT(in) :: do_collective ! use collective I/O + LOGICAL, INTENT(in) :: do_chunk ! use chunking + INTEGER, INTENT(in) :: mpi_size ! number of processes in the group of communicator + INTEGER, INTENT(in) :: mpi_rank ! rank of the calling process in the communicator + INTEGER, INTENT(inout) :: nerrors ! number of errors + INTEGER :: mpierror ! MPI hdferror flag + INTEGER :: hdferror ! HDF hdferror flag + INTEGER(hsize_t), DIMENSION(1) :: dims ! dataset dimensions + INTEGER(hsize_t), DIMENSION(1) :: cdims ! chunk dimensions + INTEGER, ALLOCATABLE :: wbuf(:) ! write buffer + INTEGER, ALLOCATABLE :: rbuf(:) ! read buffer + INTEGER(hsize_t), DIMENSION(1) :: counti ! hyperslab selection + INTEGER(hsize_t), DIMENSION(1) :: start ! hyperslab selection + INTEGER(hid_t) :: fapl_id ! file access identifier + INTEGER(hid_t) :: dxpl_id ! dataset transfer property list + INTEGER(hid_t) :: dcpl_id ! dataset creation property list + INTEGER(hid_t) :: file_id ! file identifier + INTEGER(hid_t) :: dset_id ! dataset identifier + INTEGER(hid_t) :: fspace_id ! file space identifier + INTEGER(hid_t) :: mspace_id ! memory space identifier + INTEGER(hid_t) :: driver_id ! low-level file driver identifier + INTEGER :: istart ! start position in array + INTEGER :: iend ! end position in array + INTEGER :: icount ! number of elements in array + CHARACTER(len=80) :: filename ! filename + CHARACTER(len=80) :: dsetname ! dataset name + INTEGER :: n, i + + !////////////////////////////////////////////////////////// + ! initialize the array data between the processes (3) + ! for the 12 size array we get + ! p0 = 1,2,3,4 + ! p1 = 5,6,7,8 + ! p2 = 9,10,11,12 + !////////////////////////////////////////////////////////// + + ALLOCATE(wbuf(0:length-1),stat=hdferror) + IF (hdferror /= 0) THEN + WRITE(*,*) 'allocate error' + RETURN + ENDIF + + ALLOCATE(rbuf(0:length-1),stat=hdferror) + IF (hdferror /= 0) THEN + WRITE(*,*) 'allocate error' + RETURN + ENDIF + + icount = length/mpi_size ! divide the array by the number of processes + istart = mpi_rank*icount ! start position + iend = istart + icount ! end position + + !////////////////////////////////////////////////////////// + ! HDF5 I/O + !////////////////////////////////////////////////////////// + + dims(1) = length + cdims(1) = length/mpi_size ! define chunks as the number of processes + + !////////////////////////////////////////////////////////// + ! setup file access property list with parallel I/O access + !////////////////////////////////////////////////////////// + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) + + CALL h5pget_driver_f(fapl_id, driver_id, hdferror) + CALL check("h5pget_driver_f", hdferror, nerrors) + + IF( driver_id /= H5FD_MPIO_F) THEN + WRITE(*,*) "Wrong driver information returned" + nerrors = nerrors + 1 + ENDIF + + !////////////////////////////////////////////////////////// + ! create the file collectively + !////////////////////////////////////////////////////////// + + CALL h5_fixname_f("parf2", filename, fapl_id, hdferror) + + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) + CALL check("h5fcreate_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, fspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, mspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! modify dataset creation properties to enable chunking + !////////////////////////////////////////////////////////// + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_chunk) THEN + CALL h5pset_chunk_f(dcpl_id, 1, cdims, hdferror) + CALL check("h5pset_chunk_f", hdferror, nerrors) + ENDIF + + !////////////////////////////////////////////////////////// + ! create a property list for collective dataset write + !////////////////////////////////////////////////////////// + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_collective) THEN + CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) + CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors) + ENDIF + + !////////////////////////////////////////////////////////// + ! define hyperslab + !////////////////////////////////////////////////////////// + + counti(1) = icount + start(1) = istart + + !////////////////////////////////////////////////////////// + ! select hyperslab in memory + !////////////////////////////////////////////////////////// + + CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! select hyperslab in the file + !////////////////////////////////////////////////////////// + + CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! create and write the datasets + !////////////////////////////////////////////////////////// + + DO n = 1, 300 + + ! direct the output of the write statement to unit "dsetname" + WRITE(dsetname,*) 'dataset', n + + ! create this dataset + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, fspace_id, dset_id, hdferror, dcpl_id) + CALL check("h5dcreate_f", hdferror, nerrors) + + DO i = istart, iend-1 + wbuf(i) = n + mpi_rank + ENDDO + + ! write this dataset + CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) + CALL check("h5dwrite_f", hdferror, nerrors) + + ! close this dataset + CALL h5dclose_f(dset_id, hdferror) + CALL check("h5dclose_f", hdferror, nerrors) + + ENDDO + + !////////////////////////////////////////////////////////// + ! close HDF5 I/O + !////////////////////////////////////////////////////////// + + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5pclose_f(dcpl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5pclose_f(dxpl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5sclose_f(mspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5sclose_f(fspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5fclose_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! reopen file with read access + !////////////////////////////////////////////////////////// + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id) + CALL check("h5fopen_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, fspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + CALL h5screate_simple_f(1, dims, mspace_id, hdferror) + CALL check("h5screate_simple_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! select hyperslab in memory + !////////////////////////////////////////////////////////// + + CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! select hyperslab in the file + !////////////////////////////////////////////////////////// + + CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, nerrors) + + !////////////////////////////////////////////////////////// + ! create a property list for collective dataset read + !////////////////////////////////////////////////////////// + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) + CALL check("h5pcreate_f", hdferror, nerrors) + + IF (do_collective) THEN + CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) + CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors) + ENDIF + + !////////////////////////////////////////////////////////// + ! read dataset + !////////////////////////////////////////////////////////// + + DO n = 1, 300 + + ! direct the output of the write statement to unit "dsetname" + WRITE(dsetname,*) 'dataset', n + + ! create this dataset + CALL h5dopen_f(file_id, dsetname, dset_id, hdferror) + CALL check("h5dopen_f", hdferror, nerrors) + + ! read this dataset + CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,rbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) + CALL check("h5dread_f", hdferror, nerrors) + + ! close this dataset + CALL h5dclose_f(dset_id, hdferror) + CALL check("h5dclose_f", hdferror, nerrors) + + DO i = istart, iend-1 + wbuf(i) = n + mpi_rank + ENDDO + + ! compare read and write data. each process compares a subset of the array + DO i = istart, iend-1 + IF( wbuf(i) /= rbuf(i)) THEN + WRITE(*,*) 'buffers differs at ', i, rbuf(i), wbuf(i) + nerrors = nerrors + 1 + ENDIF + ENDDO + + ENDDO + + + !////////////////////////////////////////////////////////// + ! close HDF5 I/O + !////////////////////////////////////////////////////////// + + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5pclose_f(dxpl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL h5sclose_f(fspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5sclose_f(mspace_id, hdferror) + CALL check("h5sclose_f", hdferror, nerrors) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5fclose_f", hdferror, nerrors) + + DEALLOCATE(wbuf) + DEALLOCATE(rbuf) + +END SUBROUTINE multiple_dset_write + diff --git a/fortran/testpar/mdset.f90 b/fortran/testpar/mdset.f90 deleted file mode 100644 index 22b7a6c..0000000 --- a/fortran/testpar/mdset.f90 +++ /dev/null @@ -1,318 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! 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. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * - - -!////////////////////////////////////////////////////////// -! writes/reads dataset by hyperslabs -!////////////////////////////////////////////////////////// - -SUBROUTINE multiple_dset_write(length, do_collective, do_chunk, mpi_size, mpi_rank, nerrors) - USE HDF5 - USE MPI - USE TH5_MISC - - IMPLICIT NONE - - INTEGER, INTENT(in) :: length ! array length - LOGICAL, INTENT(in) :: do_collective ! use collective I/O - LOGICAL, INTENT(in) :: do_chunk ! use chunking - INTEGER, INTENT(in) :: mpi_size ! number of processes in the group of communicator - INTEGER, INTENT(in) :: mpi_rank ! rank of the calling process in the communicator - INTEGER, INTENT(inout) :: nerrors ! number of errors - INTEGER :: mpierror ! MPI hdferror flag - INTEGER :: hdferror ! HDF hdferror flag - INTEGER(hsize_t), DIMENSION(1) :: dims ! dataset dimensions - INTEGER(hsize_t), DIMENSION(1) :: cdims ! chunk dimensions - INTEGER, ALLOCATABLE :: wbuf(:) ! write buffer - INTEGER, ALLOCATABLE :: rbuf(:) ! read buffer - INTEGER(hsize_t), DIMENSION(1) :: counti ! hyperslab selection - INTEGER(hsize_t), DIMENSION(1) :: start ! hyperslab selection - INTEGER(hid_t) :: fapl_id ! file access identifier - INTEGER(hid_t) :: dxpl_id ! dataset transfer property list - INTEGER(hid_t) :: dcpl_id ! dataset creation property list - INTEGER(hid_t) :: file_id ! file identifier - INTEGER(hid_t) :: dset_id ! dataset identifier - INTEGER(hid_t) :: fspace_id ! file space identifier - INTEGER(hid_t) :: mspace_id ! memory space identifier - INTEGER(hid_t) :: driver_id ! low-level file driver identifier - INTEGER :: istart ! start position in array - INTEGER :: iend ! end position in array - INTEGER :: icount ! number of elements in array - CHARACTER(len=80) :: filename ! filename - CHARACTER(len=80) :: dsetname ! dataset name - INTEGER :: n, i - - !////////////////////////////////////////////////////////// - ! initialize the array data between the processes (3) - ! for the 12 size array we get - ! p0 = 1,2,3,4 - ! p1 = 5,6,7,8 - ! p2 = 9,10,11,12 - !////////////////////////////////////////////////////////// - - ALLOCATE(wbuf(0:length-1),stat=hdferror) - IF (hdferror /= 0) THEN - WRITE(*,*) 'allocate error' - RETURN - ENDIF - - ALLOCATE(rbuf(0:length-1),stat=hdferror) - IF (hdferror /= 0) THEN - WRITE(*,*) 'allocate error' - RETURN - ENDIF - - icount = length/mpi_size ! divide the array by the number of processes - istart = mpi_rank*icount ! start position - iend = istart + icount ! end position - - !////////////////////////////////////////////////////////// - ! HDF5 I/O - !////////////////////////////////////////////////////////// - - dims(1) = length - cdims(1) = length/mpi_size ! define chunks as the number of processes - - !////////////////////////////////////////////////////////// - ! setup file access property list with parallel I/O access - !////////////////////////////////////////////////////////// - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) - CALL check("h5pset_fapl_mpio_f", hdferror, nerrors) - - CALL h5pget_driver_f(fapl_id, driver_id, hdferror) - CALL check("h5pget_driver_f", hdferror, nerrors) - - IF( driver_id /= H5FD_MPIO_F) THEN - WRITE(*,*) "Wrong driver information returned" - nerrors = nerrors + 1 - ENDIF - - !////////////////////////////////////////////////////////// - ! create the file collectively - !////////////////////////////////////////////////////////// - - CALL h5_fixname_f("parf2", filename, fapl_id, hdferror) - - CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id) - CALL check("h5fcreate_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, fspace_id, hdferror) - CALL check("h5screate_simple_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, mspace_id, hdferror) - CALL check("h5screate_simple_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! modify dataset creation properties to enable chunking - !////////////////////////////////////////////////////////// - - CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_chunk) THEN - CALL h5pset_chunk_f(dcpl_id, 1, cdims, hdferror) - CALL check("h5pset_chunk_f", hdferror, nerrors) - ENDIF - - !////////////////////////////////////////////////////////// - ! create a property list for collective dataset write - !////////////////////////////////////////////////////////// - - CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_collective) THEN - CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) - CALL check("h5pset_dxpl_mpio_f", hdferror, nerrors) - ENDIF - - !////////////////////////////////////////////////////////// - ! define hyperslab - !////////////////////////////////////////////////////////// - - counti(1) = icount - start(1) = istart - - !////////////////////////////////////////////////////////// - ! select hyperslab in memory - !////////////////////////////////////////////////////////// - - CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5sselect_hyperslab_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! select hyperslab in the file - !////////////////////////////////////////////////////////// - - CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5sselect_hyperslab_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! create and write the datasets - !////////////////////////////////////////////////////////// - - DO n = 1, 300 - - ! direct the output of the write statement to unit "dsetname" - WRITE(dsetname,*) 'dataset', n - - ! create this dataset - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, fspace_id, dset_id, hdferror, dcpl_id) - CALL check("h5dcreate_f", hdferror, nerrors) - - DO i = istart, iend-1 - wbuf(i) = n + mpi_rank - ENDDO - - ! write this dataset - CALL h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,wbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) - CALL check("h5dwrite_f", hdferror, nerrors) - - ! close this dataset - CALL h5dclose_f(dset_id, hdferror) - CALL check("h5dclose_f", hdferror, nerrors) - - ENDDO - - !////////////////////////////////////////////////////////// - ! close HDF5 I/O - !////////////////////////////////////////////////////////// - - CALL h5pclose_f(fapl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5pclose_f(dcpl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5pclose_f(dxpl_id, hdferror) - CALL check("h5pclose_f", hdferror, nerrors) - - CALL h5sclose_f(mspace_id, hdferror) - CALL check("h5sclose_f", hdferror, nerrors) - - CALL h5sclose_f(fspace_id, hdferror) - CALL check("h5sclose_f", hdferror, nerrors) - - CALL h5fclose_f(file_id, hdferror) - CALL check("h5fclose_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! reopen file with read access - !////////////////////////////////////////////////////////// - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, fspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5screate_simple_f(1, dims, mspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! select hyperslab in memory - !////////////////////////////////////////////////////////// - - CALL h5sselect_hyperslab_f(mspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! select hyperslab in the file - !////////////////////////////////////////////////////////// - - CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, start, counti, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - !////////////////////////////////////////////////////////// - ! create a property list for collective dataset read - !////////////////////////////////////////////////////////// - - CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - IF (do_collective) THEN - CALL h5pset_dxpl_mpio_f(dxpl_id, H5FD_MPIO_COLLECTIVE_F, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - ENDIF - - !////////////////////////////////////////////////////////// - ! read dataset - !////////////////////////////////////////////////////////// - - DO n = 1, 300 - - ! direct the output of the write statement to unit "dsetname" - WRITE(dsetname,*) 'dataset', n - - ! create this dataset - CALL h5dopen_f(file_id, dsetname, dset_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! read this dataset - CALL h5dread_f(dset_id,H5T_NATIVE_INTEGER,rbuf,dims,hdferror,file_space_id=fspace_id,mem_space_id=mspace_id,xfer_prp=dxpl_id) - CALL check("h5pcreate_f", hdferror, nerrors) - - ! close this dataset - CALL h5dclose_f(dset_id, hdferror) - CALL check("h5dclose_f", hdferror, nerrors) - - DO i = istart, iend-1 - wbuf(i) = n + mpi_rank - ENDDO - - ! compare read and write data. each process compares a subset of the array - DO i = istart, iend-1 - IF( wbuf(i) /= rbuf(i)) THEN - WRITE(*,*) 'buffers differs at ', i, rbuf(i), wbuf(i) - nerrors = nerrors + 1 - ENDIF - ENDDO - - ENDDO - - - !////////////////////////////////////////////////////////// - ! close HDF5 I/O - !////////////////////////////////////////////////////////// - - CALL h5pclose_f(fapl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5pclose_f(dxpl_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5sclose_f(fspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5sclose_f(mspace_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - CALL h5fclose_f(file_id, hdferror) - CALL check("h5pcreate_f", hdferror, nerrors) - - - DEALLOCATE(wbuf) - DEALLOCATE(rbuf) - -END SUBROUTINE multiple_dset_write - diff --git a/fortran/testpar/ptest.F90 b/fortran/testpar/ptest.F90 new file mode 100644 index 0000000..30abb88 --- /dev/null +++ b/fortran/testpar/ptest.F90 @@ -0,0 +1,103 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! Copyright by The HDF Group. * +! Copyright by the Board of Trustees of the University of Illinois. * +! 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 parallel HDF5 Fortran tests +! + +PROGRAM parallel_test + USE HDF5 + USE MPI + USE TH5_MISC + + IMPLICIT NONE + + INTEGER :: mpierror ! MPI hdferror flag + INTEGER :: hdferror ! HDF hdferror flag + INTEGER :: ret_total_error = 0 ! number of errors in subroutine + INTEGER :: total_error = 0 ! sum of the number of errors + INTEGER :: mpi_size ! number of processes in the group of communicator + INTEGER :: mpi_rank ! rank of the calling process in the communicator + INTEGER :: length = 12000 ! length of array + INTEGER :: i,j + ! use collective MPI I/O + LOGICAL, DIMENSION(1:2) :: do_collective = (/.FALSE.,.TRUE./) + CHARACTER(LEN=11), DIMENSION(1:2) :: chr_collective =(/"independent", "collective "/) + ! use chunking + LOGICAL, DIMENSION(1:2) :: do_chunk = (/.FALSE.,.TRUE./) + CHARACTER(LEN=10), DIMENSION(1:2) :: chr_chunk =(/"contiguous", "chunk "/) + + ! + ! initialize MPI + ! + CALL mpi_init(mpierror) + IF (mpierror .NE. MPI_SUCCESS) THEN + WRITE(*,*) "MPI_INIT *FAILED*" + 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 + 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 + ENDIF + ! + ! initialize the HDF5 fortran interface + ! + CALL h5open_f(hdferror) + ! + ! test write/read dataset by hyperslabs (contiguous/chunk) with independent/collective MPI I/O + ! + DO i = 1, 2 + DO j = 1, 2 + ret_total_error = 0 + CALL hyper(length, do_collective(j), do_chunk(i), mpi_size, mpi_rank, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + "Writing/reading dataset by hyperslabs ("//TRIM(chr_chunk(i))//" layout, "//TRIM(chr_collective(j))//" MPI I/O)", & + total_error) + ENDDO + ENDDO + + ! + ! test write/read several datasets (independent MPI I/O) + ! + ret_total_error = 0 + CALL multiple_dset_write(length, do_collective(1), do_chunk(1), mpi_size, mpi_rank, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'Writing/reading several datasets (contiguous layout, independent MPI I/O)', total_error) + + ! + ! close HDF5 interface + ! + CALL h5close_f(hdferror) + + ! + ! close MPI + ! + IF (total_error == 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 + ! + ! end main program + ! +END PROGRAM parallel_test diff --git a/fortran/testpar/ptest.f90 b/fortran/testpar/ptest.f90 deleted file mode 100644 index 30abb88..0000000 --- a/fortran/testpar/ptest.f90 +++ /dev/null @@ -1,103 +0,0 @@ -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! Copyright by the Board of Trustees of the University of Illinois. * -! 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 parallel HDF5 Fortran tests -! - -PROGRAM parallel_test - USE HDF5 - USE MPI - USE TH5_MISC - - IMPLICIT NONE - - INTEGER :: mpierror ! MPI hdferror flag - INTEGER :: hdferror ! HDF hdferror flag - INTEGER :: ret_total_error = 0 ! number of errors in subroutine - INTEGER :: total_error = 0 ! sum of the number of errors - INTEGER :: mpi_size ! number of processes in the group of communicator - INTEGER :: mpi_rank ! rank of the calling process in the communicator - INTEGER :: length = 12000 ! length of array - INTEGER :: i,j - ! use collective MPI I/O - LOGICAL, DIMENSION(1:2) :: do_collective = (/.FALSE.,.TRUE./) - CHARACTER(LEN=11), DIMENSION(1:2) :: chr_collective =(/"independent", "collective "/) - ! use chunking - LOGICAL, DIMENSION(1:2) :: do_chunk = (/.FALSE.,.TRUE./) - CHARACTER(LEN=10), DIMENSION(1:2) :: chr_chunk =(/"contiguous", "chunk "/) - - ! - ! initialize MPI - ! - CALL mpi_init(mpierror) - IF (mpierror .NE. MPI_SUCCESS) THEN - WRITE(*,*) "MPI_INIT *FAILED*" - 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 - 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 - ENDIF - ! - ! initialize the HDF5 fortran interface - ! - CALL h5open_f(hdferror) - ! - ! test write/read dataset by hyperslabs (contiguous/chunk) with independent/collective MPI I/O - ! - DO i = 1, 2 - DO j = 1, 2 - ret_total_error = 0 - CALL hyper(length, do_collective(j), do_chunk(i), mpi_size, mpi_rank, ret_total_error) - IF(mpi_rank==0) CALL write_test_status(ret_total_error, & - "Writing/reading dataset by hyperslabs ("//TRIM(chr_chunk(i))//" layout, "//TRIM(chr_collective(j))//" MPI I/O)", & - total_error) - ENDDO - ENDDO - - ! - ! test write/read several datasets (independent MPI I/O) - ! - ret_total_error = 0 - CALL multiple_dset_write(length, do_collective(1), do_chunk(1), mpi_size, mpi_rank, ret_total_error) - IF(mpi_rank==0) CALL write_test_status(ret_total_error, & - 'Writing/reading several datasets (contiguous layout, independent MPI I/O)', total_error) - - ! - ! close HDF5 interface - ! - CALL h5close_f(hdferror) - - ! - ! close MPI - ! - IF (total_error == 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 - ! - ! end main program - ! -END PROGRAM parallel_test -- cgit v0.12