diff options
Diffstat (limited to 'fortran/testpar/async.F90')
| -rw-r--r-- | fortran/testpar/async.F90 | 1417 |
1 files changed, 1417 insertions, 0 deletions
diff --git a/fortran/testpar/async.F90 b/fortran/testpar/async.F90 new file mode 100644 index 0000000..e3a80ad --- /dev/null +++ b/fortran/testpar/async.F90 @@ -0,0 +1,1417 @@ +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! 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. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +! Tests async Fortran wrappers. It needs an async VOL. It will skip the tests if +! HDF5_VOL_CONNECTOR is not set or is set to a non-supporting async VOL. +! +MODULE test_async_APIs + + USE MPI + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + + INTEGER(C_INT), PARAMETER :: op_data_type = 200 + INTEGER(C_INT), PARAMETER :: op_data_command = 99 + + LOGICAL :: async_enabled = .TRUE. + LOGICAL :: mpi_thread_mult = .TRUE. + + ! Custom group iteration callback data + TYPE, bind(c) :: iter_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:12) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value + END TYPE iter_info + + CHARACTER(LEN=10), TARGET :: app_file = "async.F90"//C_NULL_CHAR + CHARACTER(LEN=10), TARGET :: app_func = "func_name"//C_NULL_CHAR + INTEGER :: app_line = 42 + +CONTAINS + + INTEGER(KIND=C_INT) FUNCTION liter_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:12) :: name + TYPE (H5L_info_t) :: link_info + TYPE(iter_info) :: op_data + + liter_cb = 0 + + op_data%name(1:12) = name(1:12) + + SELECT CASE (op_data%command) + + CASE(0) + liter_cb = 0 + CASE(2) + liter_cb = op_data%command*10 + END SELECT + op_data%command = op_data_command + op_data%type = op_data_type + + END FUNCTION liter_cb + + SUBROUTINE H5ES_tests(cleanup, total_error) + ! + ! Test H5ES routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER :: nerrors = 0 + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5es_tests.h5" + INTEGER :: hdferror + + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: count + INTEGER(C_INT64_T) :: counter + INTEGER(SIZE_T) :: num_not_canceled + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + 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 H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, nerrors) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + + CALL H5EScancel_f(es_id, num_not_canceled, err_occurred, hdferror) + CALL check("H5EScancel_f", hdferror, nerrors) + CALL VERIFY("H5EScancel_f", num_not_canceled, 0_size_t, total_error) + CALL VERIFY("H5EScancel_f", err_occurred, .FALSE., total_error) + + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp = fapl_id) + CALL check("h5fcreate_f", hdferror, nerrors) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_count_f", count, 2_SIZE_T,total_error) + ELSE + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + ENDIF + + CALL H5ESget_op_counter_f(es_id, counter, hdferror) + CALL check("H5ESget_op_counter_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_op_counter_f", counter, 2_C_INT64_T, total_error) + ELSE + CALL VERIFY("H5ESget_op_counter_f", counter, 0_C_INT64_T, total_error) + ENDIF + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f", hdferror, nerrors) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_f", hdferror, nerrors) + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + IF(async_enabled)THEN + CALL VERIFY("H5ESget_count_f", count, 3_SIZE_T,total_error) + ELSE + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + ENDIF + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, nerrors) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL H5ESget_count_f(es_id, count, hdferror) + CALL check("H5ESget_count_f", hdferror, nerrors) + CALL VERIFY("H5ESget_count_f", count, 0_SIZE_T,total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, nerrors) + + END SUBROUTINE H5ES_tests + + SUBROUTINE H5A_async_tests(cleanup, total_error) + ! + ! Test H5A async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5a_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=4), PARAMETER :: attr_name = "ATTR" + INTEGER, TARGET :: attr_data0 = 100 + INTEGER, TARGET :: attr_data1 = 101 + INTEGER, TARGET :: attr_data2 = 101 + INTEGER, TARGET :: attr_rdata0 + INTEGER, TARGET :: attr_rdata1 + INTEGER, TARGET :: attr_rdata2 + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: attr_id0, attr_id1, attr_id2 + LOGICAL :: exists + LOGICAL(C_BOOL), TARGET :: exists0 = .FALSE., exists1 = .FALSE., exists2 = .FALSE., exists3 = .FALSE. + TYPE(C_PTR) :: f_ptr, f_ptr1, f_ptr2 + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, space_id, hdferror) + CALL check("H5Screate_f", hdferror, total_error) + + f_ptr1 = C_LOC(app_file) + f_ptr2 = C_LOC(app_func) + CALL h5acreate_async_f(file_id, attr_name, H5T_NATIVE_INTEGER, space_id, attr_id0, es_id, hdferror, & + file=f_ptr1, func=f_ptr2, line=app_line) + CALL check("h5acreate_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data0) + CALL H5Awrite_async_f(attr_id0, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id0, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL h5acreate_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", & + H5T_NATIVE_INTEGER, space_id, attr_id1, es_id, hdferror) + CALL check("h5acreate_by_name_async_f",hdferror,total_error) + + CALL h5acreate_by_name_async_f(file_id, "/", TRIM(attr_name)//"01", & + H5T_NATIVE_INTEGER, space_id, attr_id2, es_id, hdferror) + CALL check("h5acreate_by_name_async_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data1) + CALL H5Awrite_async_f(attr_id1, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id1, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + f_ptr = C_LOC(attr_data2) + CALL H5Awrite_async_f(attr_id2, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Awrite_async_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Sclose_f(space_id, hdferror) + CALL check("H5Sclose_f",hdferror,total_error) + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f",hdferror, total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists0) + CALL H5Aexists_async_f(file_id, attr_name, f_ptr, es_id, hdferror) + CALL check("H5Aexists_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists1) + CALL H5Aexists_async_f(file_id, TRIM(attr_name)//"00", f_ptr, es_id, hdferror) + CALL check("H5Aexists_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists2) + CALL H5Aexists_by_name_async_f(file_id, "/", attr_name, f_ptr, es_id, hdferror) + CALL check("H5Aexists_by_name_async_f",hdferror, total_error) + + f_ptr = C_LOC(exists3) + CALL H5Aexists_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", f_ptr, es_id, hdferror) + CALL check("H5Aexists_by_name_async_f",hdferror, total_error) + + CALL H5Aopen_async_f(file_id, attr_name, attr_id0, es_id, hdferror) + CALL check("H5Aopen_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata0) + CALL H5Aread_async_f(attr_id0, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id0, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Aopen_by_name_async_f(file_id, "/", TRIM(attr_name)//"00", attr_id1, es_id, hdferror) + CALL check("H5Aopen_by_name_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata1) + CALL H5Aread_async_f(attr_id1, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id1, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Aopen_by_idx_async_f(file_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(2,HSIZE_T), attr_id2, es_id, hdferror) + CALL check("H5Aopen_by_idx_async_f", hdferror, total_error) + + f_ptr = C_LOC(attr_rdata2) + CALL H5Aread_async_f(attr_id2, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror) + CALL check("H5Aread_async_f", hdferror, total_error) + + CALL H5Aclose_async_f(attr_id2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL H5Arename_async_f(file_id, TRIM(attr_name)//"00", TRIM(attr_name)//"05", es_id, hdferror) + CALL check("H5Arename_async_f",hdferror,total_error) + + CALL H5Arename_by_name_async_f(file_id, ".", TRIM(attr_name)//"01", TRIM(attr_name)//"06", es_id, hdferror) + CALL check("H5Arename_by_name_async_f",hdferror,total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL VERIFY("H5Aexists_async_f", LOGICAL(exists0), .TRUE., total_error) + CALL VERIFY("H5Aexists_async_f", LOGICAL(exists1), .TRUE., total_error) + CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists2), .TRUE., total_error) + CALL VERIFY("H5Aexists_by_name_async_f", LOGICAL(exists3), .TRUE., total_error) + + CALL VERIFY("H5Aread_async_f", attr_rdata0, attr_data0, total_error) + CALL VERIFY("H5Aread_async_f", attr_rdata1, attr_data1, total_error) + CALL VERIFY("H5Aread_async_f", attr_rdata2, attr_data2, total_error) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",hdferror, total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"05", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_async_f", exists, .TRUE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"06", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_by_name_async_f", exists, .TRUE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"01", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_async_f", exists, .FALSE., total_error) + + CALL H5Aexists_f(file_id, TRIM(attr_name)//"02", exists, hdferror) + CALL check("H5Aexist_f",hdferror, total_error) + CALL VERIFY("H5Arename_by_name_async_f", exists, .FALSE., total_error) + + CALL H5Fclose_f(file_id, hdferror) + CALL check("H5Fclose_f",hdferror,total_error) + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check(" H5Pclose_f",hdferror, total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + END SUBROUTINE H5A_async_tests + + SUBROUTINE H5D_async_tests(cleanup, total_error) + ! + ! Test H5D async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5d_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=8), PARAMETER :: dsetname = "IntArray" + INTEGER(HID_T) :: crp_list ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + + INTEGER(HID_T) :: filespace ! Dataspace identifier in file + INTEGER(HID_T) :: memspace ! Dataspace identifier in memory + INTEGER(HID_T) :: xfer_prp ! Property list identifier + TYPE(C_PTR) :: f_ptr + + INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/4/) + INTEGER(HSIZE_T), DIMENSION(1) :: dimsf + + INTEGER(HSIZE_T), DIMENSION(1) :: count + INTEGER(HSSIZE_T), DIMENSION(1) :: offset + INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: idata + INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: rdata + INTEGER(HSIZE_T), DIMENSION(1) :: idims, imaxdims + INTEGER(HSIZE_T), DIMENSION(1) :: maxdims + INTEGER(HSIZE_T) :: i + INTEGER(HSIZE_T), DIMENSION(1) :: extend_dim + INTEGER, TARGET :: fillvalue = 99 + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + dimsf(1) = dims(1)*mpi_size + ALLOCATE(idata(1:dims(1))) + + idata(:) = mpi_rank + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, hdferror) + CALL h5pset_chunk_f(crp_list, 1, dims, error) + f_ptr = C_LOC(fillvalue) + CALL h5pset_fill_value_f(crp_list, H5T_NATIVE_INTEGER, f_ptr, hdferror) + + ! + ! Create data space for the dataset. + ! + maxdims(1) = H5S_UNLIMITED_F + CALL h5screate_simple_f(1, dimsf, filespace, hdferror, maxdims) + CALL check("h5screate_simple_f", hdferror, total_error) + + ! + ! create contiguous dataset in the file. + CALL h5dcreate_async_f(file_id, dsetname, H5T_NATIVE_INTEGER, filespace, & + dset_id, es_id, hdferror, crp_list) + CALL check("h5dcreate_async_f", hdferror, total_error) + + COUNT(1) = dims(1) + offset(1) = mpi_rank * COUNT(1) + CALL h5screate_simple_f(1, dims(1), memspace, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + + CALL h5sselect_hyperslab_f (filespace, H5S_SELECT_SET_F, offset, count, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, total_error) + + CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_prp, error) + CALL h5pset_dxpl_mpio_f(xfer_prp, H5FD_MPIO_COLLECTIVE_F, error) + + ! + ! Write data to the dataset + ! + f_ptr = C_LOC(idata) + CALL h5dwrite_async_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror, & + mem_space_id = memspace, file_space_id = filespace, xfer_prp = xfer_prp) + CALL check("h5dwrite_async_f", hdferror, total_error) + ! + ! Terminate access to the dataset. + ! + CALL h5dclose_async_f(dset_id, es_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + ! Close dataspaces. + ! + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + CALL h5sclose_f(memspace, error) + CALL check("h5sclose_f",hdferror,total_error) + CALL h5pclose_f(crp_list, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL h5dopen_async_f(file_id, dsetname, dset_id, es_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Dget_space_async_f(dset_id, filespace, es_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL h5sget_simple_extent_dims_f(filespace, idims, imaxdims, hdferror) + CALL check("h5sget_simple_extent_dims_f", hdferror, total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", idims(1), dimsf(1), total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", imaxdims(1), H5S_UNLIMITED_F, total_error) + + ! Check reading the data back + ALLOCATE(rdata(1:dims(1))) + + CALL h5screate_simple_f(1, dims(1), memspace, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + + CALL h5sselect_hyperslab_f (filespace, H5S_SELECT_SET_F, offset, count, hdferror) + CALL check("h5sselect_hyperslab_f", hdferror, total_error) + + f_ptr = C_LOC(rdata) + CALL h5dread_async_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, es_id, hdferror, & + mem_space_id = memspace, file_space_id = filespace, xfer_prp = xfer_prp) + CALL check("h5dread_async_f", hdferror, total_error) + + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + CALL h5sclose_f(memspace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + ! Extend the dataset + extend_dim(1) = dimsf(1)*2 + CALL H5Dset_extent_async_f(dset_id, extend_dim, es_id, hdferror) + CALL check("H5Dset_extent_async_f", error, total_error) + + CALL h5dclose_async_f(dset_id, es_id, error) + CALL check("h5dclose_async_f",error,total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + ! Verify the data read + DO i = 1, dims(1) + CALL VERIFY("h5dread_f", idata(i), rdata(i), total_error) + ENDDO + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",error,total_error) + + CALL h5dopen_f(file_id, dsetname, dset_id, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Dget_space_f(dset_id, filespace, hdferror) + CALL check("h5dopen_async_f",hdferror,total_error) + + CALL H5Sget_simple_extent_dims_f(filespace, idims, imaxdims, hdferror) + CALL check("h5sget_simple_extent_dims_f", hdferror, total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", idims(1), extend_dim(1), total_error) + CALL VERIFY("h5sget_simple_extent_dims_f", imaxdims(1), H5S_UNLIMITED_F, total_error) + + CALL h5sclose_f(filespace, hdferror) + CALL check("h5sclose_f",hdferror,total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + CALL h5fclose_f(file_id, hdferror) + CALL check("h5fclose_f",hdferror,total_error) + + END SUBROUTINE H5D_async_tests + + + SUBROUTINE H5G_async_tests(cleanup, total_error) + ! + ! Test H5G async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5g_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + CHARACTER(LEN=6), PARAMETER:: grpname="group1" + + INTEGER(HID_T) :: group_id, group_id1 + INTEGER(HID_T) :: gcpl_id + CHARACTER(LEN=2) :: chr2 + CHARACTER(LEN=7) :: objname ! Object name + INTEGER :: v, i + + TYPE(H5G_info_t), DIMENSION(1:3) :: ginfo + + INTEGER :: error + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + ! Test group API + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + CALL H5Gcreate_async_f (file_id, grpname, group_id, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Create objects in new group created + DO v = 0, 2 + ! Make name for link + WRITE(chr2,'(I2.2)') v + objname = 'fill '//chr2 + + ! Create hard link, with group object + CALL H5Gcreate_async_f(group_id, objname, group_id1, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Close group created + CALL H5Gclose_async_f(group_id1, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ENDDO + + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL h5fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL h5gopen_async_f(file_id, grpname, group_id, es_id, hdferror) + CALL check("h5gopen_async_f",hdferror,total_error) + + CALL h5gget_info_async_f(group_id, ginfo(1), es_id, hdferror) + CALL check("H5Gget_info_async_f", hdferror, total_error) + + CALL H5Gget_info_by_name_async_f(group_id, ".", ginfo(2), es_id, hdferror) + CALL check("H5Gget_info_by_name_async_f", hdferror, total_error) + + CALL H5Gget_info_by_idx_async_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, & + INT(0,HSIZE_T), ginfo(3), es_id, error) + CALL check("H5Gget_info_by_idx_async_f", hdferror, total_error) + + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + ! Verify the group APIs + DO i = 1, 2 + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo(i)%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f.max_corder", ginfo(i)%max_corder, 3_C_INT64_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.nlinks", ginfo(i)%nlinks, 3_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_f.mounted", LOGICAL(ginfo(i)%mounted),.FALSE.,total_error) + ENDDO + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo(3)%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f.max_corder", ginfo(3)%max_corder, 0_C_INT64_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.nlinks", ginfo(3)%nlinks, 0_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_f.mounted", LOGICAL(ginfo(3)%mounted),.FALSE.,total_error) + + END SUBROUTINE H5G_async_tests + + SUBROUTINE H5F_async_tests(cleanup, total_error) + ! + ! Test H5F async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5f_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + INTEGER(HID_T) :: ret_file_id + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm, info + INTEGER :: mpi_size, mpi_rank + + comm = MPI_COMM_WORLD + info = MPI_INFO_NULL + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL H5Fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + CALL H5Freopen_async_f(file_id, ret_file_id, es_id, hdferror) + CALL check("H5Freopen_async_f", hdferror, total_error) + + CALL H5Fclose_async_f(ret_file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5Fflush_async_f(file_id, H5F_SCOPE_GLOBAL_F, es_id, hdferror) + CALL check("h5fflush_async_f",hdferror, total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + END SUBROUTINE H5F_async_tests + + SUBROUTINE H5L_async_tests(cleanup, total_error) + ! + ! Test H5L async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: file_id + CHARACTER(len=80) :: filename = "h5l_tests.h5" + INTEGER :: hdferror + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + INTEGER(hid_t) :: gid = -1, gid2 = -1, gid3 = -1 ! Group IDs + INTEGER(hid_t) :: aid = -1, aid2 = -1, aid3 = -1 ! Attribute ID + INTEGER(hid_t) :: sid = -1 ! Dataspace ID + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group" + CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME2 = "corder_grp00" + LOGICAL(C_BOOL), TARGET :: exists1, exists2 + LOGICAL :: exists + TYPE(C_PTR) :: f_ptr + + INTEGER(HID_T) :: group_id ! Group ID + INTEGER(HID_T) :: gcpl_id ! Group creation property list ID + + INTEGER :: idx_type ! Type of index to operate on + LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) + ! Use index on creation order values + INTEGER :: max_compact ! Maximum # of links to store in group compactly + INTEGER :: min_dense ! Minimum # of links to store in group "densely" + + CHARACTER(LEN=7) :: objname ! Object name + + INTEGER :: u ! Local index variable + INTEGER :: Input1, i + INTEGER(HID_T) :: group_id2 + INTEGER :: iorder ! Order within in the index + CHARACTER(LEN=2) :: chr2 + ! + INTEGER(hsize_t) idx ! Index in the group + TYPE(iter_info), TARGET :: info + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + INTEGER(C_INT) :: ret_value + + INTEGER :: error ! Error flags + INTEGER :: mpierror ! MPI error flag + INTEGER :: comm + INTEGER :: mpi_size, mpi_rank + + INTEGER(SIZE_T) :: count + + comm = MPI_COMM_WORLD + + CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) + CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + ! + ! Create the file. + ! + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror) + CALL check("h5pcreate_f", hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + CALL check("h5pset_fapl_mpio_f", hdferror, total_error) + + CALL h5fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, error, access_prp = fapl_id ) + CALL check("h5fcreate_f",hdferror, total_error) + + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + ! Create group with creation order tracking on + CALL H5Gcreate_async_f(file_id, CORDER_GROUP_NAME, gid3, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_f", hdferror, total_error) + + ! Create group + CALL H5Gcreate_async_f(file_id, "/Group1", gid, es_id, hdferror) + CALL check("H5Gcreate_async_f",hdferror, total_error) + + ! Create nested group + CALL H5Gcreate_async_f(gid, "Group2", gid2, es_id, hdferror) + CALL check("H5Gcreate_async_f",hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, sid, hdferror) + CALL check("H5Screate_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr1", H5T_NATIVE_INTEGER, sid, aid, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr2", H5T_NATIVE_INTEGER, sid, aid2, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Acreate_async_f(gid2, "Attr3", H5T_NATIVE_INTEGER, sid, aid3, es_id, hdferror) + CALL check("H5Acreate_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid2, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Aclose_async_f(aid3, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror, total_error) + CALL H5Sclose_f(sid,hdferror) + CALL check("H5Sclose_f",hdferror, total_error) + + ! Close groups + CALL h5gclose_async_f(gid2, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + CALL h5gclose_async_f(gid, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + CALL h5gclose_async_f(gid3, es_id, hdferror) + CALL check("h5gclose_async_f",hdferror, total_error) + + ! Close the group creation property list + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + + ! Create soft links to groups created + CALL H5Lcreate_soft_async_f("/Group1", file_id, "/soft_one", es_id, hdferror) + CALL H5Lcreate_soft_async_f("/Group1/Group2", file_id, "/soft_two", es_id, hdferror) + + ! Create hard links to all groups + CALL H5Lcreate_hard_async_f(file_id, "/", file_id, "hard_zero", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + CALL H5Lcreate_hard_async_f(file_id, "/Group1", file_id, "hard_one", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + CALL H5Lcreate_hard_async_f(file_id, "/Group1/Group2", file_id, "hard_two", es_id, hdferror) + CALL check("H5Lcreate_hard_async_f",hdferror, total_error) + + ! + ! Close the file. + ! + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + CALL H5Fopen_async_f(filename, H5F_ACC_RDWR_F, file_id, es_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_async_f",hdferror,total_error) + + exists1 = .FALSE. + f_ptr = C_LOC(exists1) + CALL H5Lexists_async_f(file_id, "hard_zero", f_ptr, es_id, hdferror) + CALL check("H5Lexists_async_f",hdferror,total_error) + + exists2 = .FALSE. + f_ptr = C_LOC(exists2) + CALL H5Lexists_async_f(file_id, "hard_two", f_ptr, es_id, hdferror) + CALL check("H5Lexists_async_f",hdferror,total_error) + + CALL H5Ldelete_async_f(file_id, "hard_two", es_id, hdferror) + CALL check("H5Ldelete_async_f",hdferror,total_error) + + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_async_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + CALL VERIFY("H5Lexists_async_f", LOGICAL(exists1), .TRUE., total_error) + CALL VERIFY("H5Lexists_async_f", LOGICAL(exists2), .TRUE., total_error) + + CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, hdferror, access_prp = fapl_id ) + CALL check("h5fopen_f",hdferror, total_error) + + ! Verify the link was deleted + CALL H5Lexists_f(file_id, "hard_two", exists, hdferror) + CALL check("H5Lexist_f",hdferror, total_error) + CALL VERIFY("H5Ldelete_async_f", exists, .FALSE., total_error) + + CALL H5Fclose_f(file_id, hdferror) + CALL check("H5Fclose_f", hdferror,total_error) + + ! Loop over operating on different indices on link fields + DO idx_type = H5_INDEX_NAME_F, H5_INDEX_CRT_ORDER_F + ! Loop over operating in different orders + DO iorder = H5_ITER_INC_F, H5_ITER_DEC_F + ! Loop over using index for creation order value + DO i = 1, 2 + ! Create file + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, access_prp=fapl_id) + CALL check("H5Fcreate_async_f", hdferror, total_error) + + ! Create group creation property list + CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, hdferror ) + CALL check("H5Pcreate_f", hdferror, total_error) + + ! Set creation order tracking & indexing on group + IF(use_index(i))THEN + Input1 = H5P_CRT_ORDER_INDEXED_F + ELSE + Input1 = 0 + ENDIF + + CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), hdferror) + CALL check("H5Pset_link_creation_order_f", hdferror, total_error) + + ! Create group with creation order tracking on + CALL H5Gcreate_async_f(file_id, CORDER_GROUP_NAME2, group_id, es_id, hdferror, gcpl_id=gcpl_id) + CALL check("H5Gcreate_async_f", hdferror, total_error) + + ! Query the group creation properties + CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, hdferror) + CALL check("H5Pget_link_phase_change_f", hdferror, total_error) + + ! Create several links, up to limit of compact form + DO u = 0, max_compact-1 + ! Make name for link + WRITE(chr2,'(I2.2)') u + objname = 'fill '//chr2 + + ! Create hard link, with group object + CALL H5Gcreate_async_f(group_id, objname, group_id2, es_id, hdferror) + CALL check("H5Gcreate_async_f", hdferror, total_error) + CALL H5Gclose_async_f(group_id2, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ENDDO + + ! Delete links from compact group + DO u = 0, (max_compact - 1) -1 + ! Delete first link in appropriate order + CALL H5Ldelete_by_idx_async_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), es_id, hdferror) + CALL check("H5Ldelete_by_idx_async_f", hdferror, total_error) + ENDDO + + idx = 0 + info%command = 2 + f1 = C_FUNLOC(liter_cb) + f2 = C_LOC(info) + + CALL H5Literate_async_f(file_id, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, es_id, hdferror) + CALL check("H5Literate_async_f", error, total_error) + + ! Close the group + CALL H5Gclose_async_f(group_id, es_id, hdferror) + CALL check("H5Gclose_async_f", hdferror, total_error) + ! Close the group creation property list + CALL H5Pclose_f(gcpl_id, hdferror) + CALL check("H5Pclose_f", hdferror, total_error) + ! Close the file + CALL H5Fclose_async_f(file_id, es_id, hdferror) + CALL check("H5Fclose_async_f", hdferror, total_error) + + CALL H5ESget_count_f(es_id, count, hdferror) + + ! Complete the operations + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror); + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + CALL VERIFY("H5ESwait_f", num_in_progress, 0_size_t , total_error) + + ! NOTE: ret_value will not be correct since H5Literate_async is not returning a pointer return value, herr_t. + CALL VERIFY("H5Literate_async_f", info%type, op_data_type, total_error) + CALL VERIFY("H5Literate_async_f", info%command, op_data_command, total_error) + CALL VERIFY("H5Literate_async_f", info%name(1)(1:1), CORDER_GROUP_NAME2(1:1), total_error) + + ENDDO + ENDDO + + ENDDO + + CALL H5Pclose_f(fapl_id, hdferror) + CALL check(" H5Pclose_f",hdferror, total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + + END SUBROUTINE H5L_async_tests + + SUBROUTINE H5O_async_tests(cleanup, total_error) + ! + ! Test H5O async routines + ! + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: file_id + INTEGER(HID_T) :: group_id, group_id1, group_id2, group_id3 + INTEGER(HID_T) :: space_id + INTEGER(HID_T) :: attr_id + INTEGER(HID_T) :: dset_id + INTEGER(HID_T) :: fapl_id + INTEGER(HID_T) :: lcpl_id + INTEGER(HID_T) :: ocpypl_id + TYPE(C_H5O_INFO_T), TARGET :: oinfo_f + TYPE(C_PTR) :: f_ptr + CHARACTER(len=80) :: filename = "h5o_tests.h5" + + INTEGER :: hdferror ! Value returned from API calls + + ! Data for tested h5ocopy_async_f + CHARACTER(LEN=3) , PARAMETER :: dataset = "DS1" + INTEGER , PARAMETER :: dim0 = 4 + + INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer + INTEGER(C_INT), DIMENSION(1:8) :: atime, btime, ctime, mtime + + INTEGER(HID_T) :: es_id + INTEGER(SIZE_T) :: num_in_progress + LOGICAL :: err_occurred + + ! Make a FAPL that uses the "use the latest version of the format" bounds + CALL H5Pcreate_f(H5P_FILE_ACCESS_F,fapl_id,hdferror) + CALL check("h5Pcreate_f",hdferror,total_error) + + ! Set the "use the latest version of the format" bounds for creating objects in the file + CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, hdferror) + CALL check("H5Pset_libver_bounds_f",hdferror, total_error) + + CALL h5pset_fapl_mpio_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror) + + CALL H5EScreate_f(es_id, hdferror) + CALL check("H5EScreate_f", hdferror, total_error) + + ! Create a new HDF5 file + CALL H5Fcreate_async_f(filename, H5F_ACC_TRUNC_F, file_id, es_id, hdferror, H5P_DEFAULT_F, fapl_id) + CALL check("H5Fcreate_f", hdferror, total_error) + + ! Close the FAPL + CALL h5pclose_f(fapl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + ! + ! Create dataspace. Setting size to be the current size. + ! + CALL h5screate_simple_f(1, dims2, space_id, hdferror) + CALL check("h5screate_simple_f", hdferror, total_error) + ! + ! Create intermediate groups + ! + CALL h5gcreate_async_f(file_id,"/G1",group_id1,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + CALL h5gcreate_async_f(file_id,"/G1/G2",group_id2,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + CALL h5gcreate_async_f(file_id,"/G1/G2/G3",group_id3,es_id,hdferror) + CALL check("h5gcreate_f", hdferror, total_error) + + ! + ! Create the dataset + ! + CALL h5dcreate_async_f(group_id3, dataset, H5T_STD_I32LE, space_id, dset_id, es_id, hdferror) + CALL check("h5dcreate_f", hdferror, total_error) + + ! Create a soft link to /G1 + CALL h5lcreate_soft_async_f("/G1", file_id, "/G1_LINK", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + + ! Create a soft link to /G1000, does not exist + CALL h5lcreate_soft_async_f("/G1000", file_id, "/G1_FALSE", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + + ! Create a soft link to /G1_LINK + CALL h5lcreate_soft_async_f("/G1_FALSE", file_id, "/G2_FALSE", es_id, hdferror) + CALL check("h5lcreate_soft_f", hdferror, total_error) + ! + ! Close and release resources. + ! + CALL h5dclose_async_f(dset_id, es_id, hdferror) + CALL check(" h5dclose_f", hdferror, total_error) + CALL h5sclose_f(space_id, hdferror) + CALL check("h5sclose_f", hdferror, total_error) + CALL h5gclose_async_f(group_id1, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + CALL h5gclose_async_f(group_id2, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + CALL h5gclose_async_f(group_id3, es_id, hdferror) + CALL check("h5gclose_async_f", hdferror, total_error) + + ! Test opening an object by index + CALL h5oopen_by_idx_async_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, es_id, hdferror) + CALL check("h5oopen_by_idx_f", hdferror, total_error) + + CALL h5oclose_async_f(group_id, es_id, hdferror) + CALL check("h5gclose_f", hdferror, total_error) + + ! Test opening an object + CALL h5oopen_async_f(file_id, "/G1/G2/G3", group_id, es_id, hdferror) + CALL check("h5oopen_by_idx_f", hdferror, total_error) + + CALL H5Screate_f(H5S_SCALAR_F, space_id, hdferror) + CALL check("H5Screate_f", hdferror, total_error) + + CALL h5acreate_async_f(group_id, "ATTR", H5T_NATIVE_INTEGER, space_id, attr_id, es_id, hdferror) + CALL check("h5acreate_f",hdferror,total_error) + + CALL H5Aclose_async_f(attr_id, es_id, hdferror) + CALL check("H5Aclose_async_f",hdferror,total_error) + + CALL h5oclose_async_f(group_id, es_id, hdferror) + CALL check("h5gclose_f", hdferror, total_error) + + f_ptr = C_LOC(oinfo_f) + CALL H5Oget_info_by_name_async_f(file_id, "/G1/G2/G3", f_ptr, es_id, hdferror, fields=H5O_INFO_ALL_F) + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + ! + ! create property to pass copy options + ! + CALL h5pcreate_f(H5P_LINK_CREATE_F, lcpl_id, hdferror) + CALL check("h5Pcreate_f", hdferror, total_error) + + CALL h5pset_create_inter_group_f(lcpl_id, 1, hdferror) + CALL check("H5Pset_create_inter_group_f", hdferror, total_error) + ! + ! Check optional parameter lcpl_id, this would fail if lcpl_id was not specified + ! + CALL h5ocopy_async_f(file_id, "/G1/G2/G3/DS1", file_id, "/G1/G_cp1/DS2", es_id, hdferror, lcpl_id=lcpl_id) + CALL check("h5ocopy_f -- W/ OPTION: lcpl_id", hdferror ,total_error) + + CALL h5pclose_f(lcpl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + CALL h5pcreate_f(H5P_OBJECT_COPY_F, ocpypl_id, hdferror) + CALL check("h5Pcreate_f",hdferror,total_error) + + CALL h5pset_copy_object_f(ocpypl_id, H5O_COPY_SHALLOW_HIERARCHY_F, hdferror) + CALL check("H5Pset_copy_object_f",hdferror,total_error) + + CALL h5ocopy_async_f(file_id, "/G1/G2", file_id, "/G1/G_cp2", es_id, hdferror, ocpypl_id=ocpypl_id) + CALL check("h5ocopy_f",hdferror,total_error) + + CALL h5pclose_f(ocpypl_id, hdferror) + CALL check("h5pclose_f",hdferror,total_error) + + CALL h5fclose_async_f(file_id, es_id, hdferror) + CALL check("h5fclose_f",hdferror,total_error) + + CALL H5ESwait_f(es_id, H5ES_WAIT_FOREVER_F, num_in_progress, err_occurred, hdferror) + CALL check("H5ESwait_f", hdferror, total_error) + CALL VERIFY("H5ESwait_f", err_occurred, .FALSE., total_error) + + IF( oinfo_f%fileno.LE.0 )THEN + hdferror = -1 + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + ENDIF + + atime(1:8) = h5gmtime(oinfo_f%atime) + btime(1:8) = h5gmtime(oinfo_f%btime) + ctime(1:8) = h5gmtime(oinfo_f%ctime) + mtime(1:8) = h5gmtime(oinfo_f%mtime) + + IF( atime(1) .LT. 2021 .OR. & + btime(1).LT. 2021 .OR. & + ctime(1) .LT. 2021 .OR. & + mtime(1) .LT. 2021 )THEN + hdferror = -1 + ENDIF + CALL check("H5Oget_info_by_name_async_f", hdferror, total_error) + + CALL VERIFY("H5Oget_info_by_name_async_f", oinfo_f%num_attrs, 1_HSIZE_T, total_error) + CALL VERIFY("H5Oget_info_by_name_async_f", oinfo_f%type, INT(H5G_GROUP_F, C_INT), total_error) + + CALL H5ESclose_f(es_id, hdferror) + CALL check("H5ESclose_f", hdferror, total_error) + + END SUBROUTINE H5O_async_tests + +END MODULE test_async_APIs + +! +! The main program for async HDF5 Fortran tests +! +PROGRAM async_test + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT64_T + USE HDF5 + USE MPI + USE TH5_MISC + USE TH5_MISC_GEN + USE test_async_APIs + + IMPLICIT NONE + + INTEGER :: total_error = 0 ! sum of the number of errors + INTEGER :: mpierror ! MPI hdferror flag + INTEGER :: mpi_size ! number of processes in the group of communicator + INTEGER :: mpi_rank ! rank of the calling process in the communicator + INTEGER :: required, provided + + INTEGER(HID_T) :: vol_id + INTEGER :: hdferror + LOGICAL :: registered + INTEGER :: sum + INTEGER :: nerrors = 0 + + LOGICAL :: cleanup + INTEGER :: ret_total_error = 0 + + ! + ! 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 + mpi_thread_mult = .FALSE. + 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 + + IF(mpi_rank==0) CALL write_test_header("ASYNC FORTRAN TESTING") + + ! + ! Initialize the HDF5 fortran interface + ! + CALL h5open_f(hdferror) + + + ! CHECK ASYNC VOLS AVAILABILITY + ! + ! (1) Check if ASYNC VOL is available + CALL H5VLis_connector_registered_by_name_f("async", registered, hdferror) + CALL check("H5VLis_connector_registered_by_name_f", hdferror, total_error) + + IF(.NOT.registered)THEN + + ! (2) check if the DAOS VOL is available + CALL H5VLis_connector_registered_by_name_f("daos", registered, hdferror) + CALL check("H5VLis_connector_registered_by_name_f", hdferror, total_error) + + IF(.NOT.registered)THEN + ! No async compatible VOL found + async_enabled = .FALSE. + ELSE + CALL H5Vlregister_connector_by_name_f("daos", vol_id, hdferror) + CALL check("H5Vlregister_connector_by_name_f", hdferror, total_error) + ENDIF + + ELSE + CALL H5Vlregister_connector_by_name_f("async", vol_id, hdferror) + CALL check("H5Vlregister_connector_by_name_f", hdferror, total_error) + ENDIF + + IF ( (async_enabled .EQV. .TRUE.) .AND. (mpi_thread_mult .EQV. .FALSE.) ) THEN + total_error = -1 ! Skip test + IF(mpi_rank==0) CALL write_test_status(total_error, & + "No MPI_Init_thread support for MPI_THREAD_MULTIPLE", total_error) + CALL MPI_Barrier(MPI_COMM_WORLD, mpierror) + CALL MPI_Finalize(mpierror) + STOP + ENDIF + +! IF(total_error.LT.0)THEN +! IF(mpi_rank==0) CALL write_test_status(total_error, & +! 'Testing async APIs', total_error) +! STOP +! ENDIF + + ! H5ES API TESTING + ret_total_error = 0 + CALL H5ES_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5ES API tests', total_error) + + ! H5A ASYNC API TESTING + ret_total_error = 0 + CALL H5A_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5A async API tests', total_error) + + ! H5D ASYNC API TESTING + ret_total_error = 0 + CALL H5D_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5D async API tests', total_error) + + ! H5G ASYNC API TESTING + ret_total_error = 0 + CALL H5G_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5G async API tests', total_error) + + ! H5F ASYNC API TESTING + ret_total_error = 0 + CALL H5F_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5F async API tests', total_error) + + ! H5L ASYNC API TESTING + ret_total_error = 0 + CALL H5L_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5L async API tests', total_error) + + ! H5O ASYNC API TESTING + ret_total_error = 0 + CALL H5O_async_tests(cleanup, ret_total_error) + IF(mpi_rank==0) CALL write_test_status(ret_total_error, & + 'H5O async API tests', total_error) + + IF(async_enabled)THEN + CALL H5VLclose_f(vol_id, hdferror) + CALL check("H5VLclose_f", hdferror, total_error) + ENDIF + + ! + ! close HDF5 interface + ! + CALL h5close_f(hdferror) + + CALL MPI_ALLREDUCE(total_error, sum, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, mpierror) + + IF(mpi_rank==0) CALL write_test_footer() + + ! + ! 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 + + ! + ! end main program + ! + +END PROGRAM async_test |