summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2015-03-19 17:11:47 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2015-03-19 17:11:47 (GMT)
commit8f8cbb62257a2df11f14801f09df6500f589c506 (patch)
tree4b662554b414819ad30a01a872ca6458981f1f0f
parentc2c3294c2152a95e58ba595d65f0e7a1d1ca3e26 (diff)
downloadhdf5-8f8cbb62257a2df11f14801f09df6500f589c506.zip
hdf5-8f8cbb62257a2df11f14801f09df6500f589c506.tar.gz
hdf5-8f8cbb62257a2df11f14801f09df6500f589c506.tar.bz2
[svn-r26479] Fix for: HDFFV-9162
h5pget_class_f should return hid_t for classtype Also removed all left over C comment artifacts /* and */ in the Fortran comments. Tested: h5committest
Diffstat
-rw-r--r--fortran/src/H5Pf.c27
-rw-r--r--fortran/src/H5Pff.f9031
-rw-r--r--fortran/src/H5f90proto.h2
-rw-r--r--fortran/test/fortranlib_test_1_8.f906
-rw-r--r--fortran/test/tH5A_1_8.f90688
-rw-r--r--fortran/test/tH5E_F03.f908
-rw-r--r--fortran/test/tH5G_1_8.f90620
-rw-r--r--fortran/test/tH5MISC_1_8.f9070
-rw-r--r--fortran/test/tH5O.f908
-rw-r--r--fortran/test/tH5O_F03.f904
-rw-r--r--fortran/test/tH5P_F03.f9092
-rw-r--r--fortran/test/tH5Sselect.f90340
-rw-r--r--fortran/test/tH5T.f9024
-rw-r--r--fortran/test/tH5T_F03.f904
14 files changed, 963 insertions, 961 deletions
diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c
index fa4dc5b..e9082d6 100644
--- a/fortran/src/H5Pf.c
+++ b/fortran/src/H5Pf.c
@@ -160,41 +160,32 @@ done:
/****if* H5Pf/h5pget_class_c
* NAME
- * h5pget_class_c
+ * h5pget_class_c
* PURPOSE
- * Call H5Pget_class to determine property list class
+ * Call H5Pget_class to determine property list class
* INPUTS
- * prp_id - identifier of the dataspace
+ * prp_id - identifier of the dataspace
* OUTPUTS
- * classtype - class type; possible values are:
- * H5P_ROOT_F -1
- * H5P_FILE_CREATE_F 0
- * H5P_FILE_ACCESS_F 1
- * H5P_DATASET_CREATE_F 2
- * H5P_DATASET_XFER_F 3
- * H5P_FILE_MOUNT_F 4
+ * classtype - class type
* RETURNS
- * 0 on success, -1 on failure
+ * 0 on success, -1 on failure
* AUTHOR
* Elena Pourmal
- * Saturday, August 14, 1999
+ * Saturday, August 14, 1999
* SOURCE
*/
int_f
-nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype)
+nh5pget_class_c ( hid_t_f *prp_id , hid_t_f *classtype)
/******/
{
hid_t c_classtype;
int_f ret_value = 0;
- c_classtype = H5Pget_class((hid_t)*prp_id);
- if(c_classtype == H5P_ROOT) {
- *classtype = H5P_ROOT;
+ if( (c_classtype = H5Pget_class((hid_t)*prp_id)) < 0)
HGOTO_DONE(FAIL)
- }
- *classtype = (int_f)c_classtype;
+ *classtype = (hid_t_f)c_classtype;
done:
return ret_value;
diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90
index 2103415..3409f15 100644
--- a/fortran/src/H5Pff.f90
+++ b/fortran/src/H5Pff.f90
@@ -237,18 +237,10 @@ CONTAINS
! Returns the property list class for a property list.
!
! INPUTS
-!
! prp_id - property list identifier
+!
! OUTPUTS
-!
! classtype - property list class
-! Possible values are:
-! H5P_ROOT_F
-! H5P_FILE_CREATE_F
-! H5P_FILE_ACCESS_F
-! H5P_DATASET_CREATE_F
-! H5P_DATASET_XFER_F
-! H5P_FILE_MOUNT_F
! hdferr: - error code
! Success: 0
! Failure: -1
@@ -265,30 +257,21 @@ CONTAINS
! Fortran90 Interface:
SUBROUTINE h5pget_class_f(prp_id, classtype, hdferr)
IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
- INTEGER, INTENT(OUT) :: classtype ! The type of the property list
- ! to be created. Possible values are:
- ! H5P_ROOT_F
- ! H5P_FILE_CREATE_F
- ! H5P_FILE_ACCESS_F
- ! H5P_DATASET_CREATE_F
- ! H5P_DATASET_XFER_F
- ! H5P_FILE_MOUNT_F
+ INTEGER(HID_T), INTENT(IN) :: prp_id ! Property list identifier
+ INTEGER(HID_T), INTENT(OUT) :: classtype ! The type of the property list
+ ! to be created.
INTEGER, INTENT(OUT) :: hdferr ! Error code
! 0 on success and -1 on failure
!*****
-! INTEGER, EXTERNAL :: h5pget_class_c
-! MS FORTRAN needs explicit interface for C functions called here.
-!
INTERFACE
INTEGER FUNCTION h5pget_class_c(prp_id, classtype)
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_CLASS_C'::h5pget_class_c
!DEC$ENDIF
- INTEGER(HID_T), INTENT(IN) :: prp_id
- INTEGER, INTENT(OUT) :: classtype
+ INTEGER(HID_T), INTENT(IN) :: prp_id
+ INTEGER(HID_T), INTENT(OUT) :: classtype
END FUNCTION h5pget_class_c
END INTERFACE
@@ -3641,7 +3624,7 @@ CONTAINS
! size - Actual length of the class name
! NOTE: If provided buffer "name" is smaller,
! than name will be truncated to fit into
-! provided user buffer
+! provided user buffer.
! hdferr: - error code
! Success: 0
! Failure: -1
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index b5e40a8..6bde877 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -995,7 +995,7 @@ H5_FCDLL int_f nh5pcreate_c ( hid_t_f *cls, hid_t_f *prp_id );
H5_FCDLL int_f nh5pclose_c ( hid_t_f *prp_id );
H5_FCDLL int_f nh5pcopy_c ( hid_t_f *prp_id , hid_t_f *new_prp_id);
H5_FCDLL int_f nh5pequal_c ( hid_t_f *plist1_id , hid_t_f *plist2_id, int_f *c_flag);
-H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype);
+H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , hid_t_f *classtype);
H5_FCDLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level);
H5_FCDLL int_f nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims );
H5_FCDLL int_f nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims );
diff --git a/fortran/test/fortranlib_test_1_8.f90 b/fortran/test/fortranlib_test_1_8.f90
index 039dc6c..94f4c6f 100644
--- a/fortran/test/fortranlib_test_1_8.f90
+++ b/fortran/test/fortranlib_test_1_8.f90
@@ -100,6 +100,12 @@ PROGRAM fortranlibtest
' Testing scaleoffset filter', &
total_error)
+ ret_total_error = 0
+ CALL test_genprop_basic_class(cleanup, ret_total_error )
+ CALL write_test_status(ret_total_error, &
+ ' Testing basic generic property list class creation functionality', &
+ total_error)
+
WRITE(*,*)
WRITE(*,*) ' ============================================ '
diff --git a/fortran/test/tH5A_1_8.f90 b/fortran/test/tH5A_1_8.f90
index 02bef53..8e20100 100644
--- a/fortran/test/tH5A_1_8.f90
+++ b/fortran/test/tH5A_1_8.f90
@@ -157,7 +157,7 @@ SUBROUTINE attribute_test_1_8(cleanup, total_error)
' - Testing creating attributes by name', &
total_error)
- ! /* More complex tests with both "new format" and "shared" attributes */
+ ! More complex tests with both "new format" and "shared" attributes
IF( use_shared(j) ) THEN
ret_total_error = 0
CALL test_attr_shared_rename(my_fcpl, my_fapl, ret_total_error)
@@ -190,12 +190,12 @@ END SUBROUTINE attribute_test_1_8
SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_corder_create_compact(): Test basic H5A (attribute) code.
!** Tests compact attribute storage on objects with attribute creation order info
!**
-!****************************************************************/
+!***************************************************************
! Needed for get_info_by_name
@@ -245,17 +245,17 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
data_dims = 0
! WRITE(*,*) " - Testing Compact Storage of Attributes with Creation Order Info"
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Create dataset creation property list */
+ ! Create dataset creation property list
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
CALL H5Pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error)
CALL check("H5Pset_attr_creation_order",error,total_error)
- ! /* Query the attribute creation properties */
+ ! Query the attribute creation properties
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
@@ -281,7 +281,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
my_dataset = dset3
END SELECT
DO u = 0, max_compact - 1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
@@ -298,7 +298,7 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
END DO
END DO
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dset2, error)
@@ -306,15 +306,15 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL h5dclose_f(dset3, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl, error)
CALL check("h5pclose_f",error,total_error)
@@ -341,34 +341,34 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
DO u = 0,max_compact-1
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
- ! /* Retrieve information for attribute */
+ ! Retrieve information for attribute
CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, &
f_corder_valid, corder, cset, data_size, error, lapl_id = H5P_DEFAULT_F ) !with optional
CALL check("H5Aget_info_by_name_f", error, total_error)
- ! /* Verify creation order of attribute */
+ ! Verify creation order of attribute
CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
- ! /* Retrieve information for attribute */
+ ! Retrieve information for attribute
CALL H5Aget_info_by_name_f(my_dataset, ".", attrname, &
f_corder_valid, corder, cset, data_size, error) ! without optional
CALL check("H5Aget_info_by_name_f", error, total_error)
- ! /* Verify creation order of attribute */
+ ! Verify creation order of attribute
CALL verifyLogical("H5Aget_info_by_name_f", f_corder_valid, .TRUE., total_error)
CALL verify("H5Aget_info_by_name_f", corder, u, total_error)
END DO
END DO
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dset2, error)
@@ -376,19 +376,19 @@ SUBROUTINE test_attr_corder_create_compact(fcpl,fapl, total_error)
CALL h5dclose_f(dset3, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
END SUBROUTINE test_attr_corder_create_compact
SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_null_space(): Test basic H5A (attribute) code.
!** Tests storing attribute with "null" dataspace
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -426,41 +426,41 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
data_dims = 0
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Re-open file */
+ ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error)
CALL check("h5open_f",error,total_error)
- ! /* Create dataspace for dataset attributes */
+ ! Create dataspace for dataset attributes
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create "null" dataspace for attribute */
+ ! Create "null" dataspace for attribute
CALL h5screate_f(H5S_NULL_F, null_sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error)
CALL check("h5dcreate_f",error,total_error)
- ! /* Add attribute with 'null' dataspace */
+ ! Add attribute with 'null' dataspace
- ! /* Create attribute */
+ ! Create attribute
CALL h5acreate_f(dataset, "null attr", H5T_NATIVE_INTEGER, null_sid, attr, error)
CALL check("h5acreate_f",error,total_error)
- ! /* Try to read data from the attribute */
- ! /* (shouldn't fail, but should leave buffer alone) */
+ ! Try to read data from the attribute
+ ! (shouldn't fail, but should leave buffer alone)
value(1) = 103
data_dims(1) = 1
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL check("h5aread_f",error,total_error)
CALL verify("h5aread_f",value(1),103,total_error)
-! /* Try to read data from the attribute again but*/
-! /* for a scalar */
+! Try to read data from the attribute again but
+! for a scalar
value_scalar = 104
data_dims(1) = 1
@@ -482,7 +482,7 @@ SUBROUTINE test_attr_null_space(fcpl, fapl, total_error)
CALL h5aget_info_f(attr, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f", error, total_error)
- ! /* Check the attribute's information */
+ ! Check the attribute's information
CALL VERIFY("h5aget_info_f.corder",corder,0,total_error)
CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
@@ -513,12 +513,12 @@ END SUBROUTINE test_attr_null_space
SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_create_by_name(): Test basic H5A (attribute) code.
!** Tests creating attributes by name
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -563,32 +563,32 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
data_dims = 0
- ! /* Create dataspace for dataset & attributes */
+ ! Create dataspace for dataset & attributes
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create dataset creation property list */
+ ! Create dataset creation property list
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Query the attribute creation properties */
+ ! Query the attribute creation properties
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- ! /* Loop over using index for creation order value */
+ ! Loop over using index for creation order value
DO i = 1, 2
- ! /* Print appropriate test message */
+ ! Print appropriate test message
IF(use_index(i))THEN
WRITE(*,*) " - Testing Creating Attributes By Name w/Creation Order Index"
ELSE
WRITE(*,*) " - Testing Creating Attributes By Name w/o Creation Order Index"
ENDIF
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Set attribute creation order tracking & indexing for object */
+ ! Set attribute creation order tracking & indexing for object
IF(new_format)THEN
IF(use_index(i))THEN
@@ -602,7 +602,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
ENDIF
- ! /* Create datasets */
+ ! Create datasets
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl_id=dcpl )
CALL check("h5dcreate_f2",error,total_error)
@@ -614,7 +614,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
CALL check("h5dcreate_f4",error,total_error)
- ! /* Work on all the datasets */
+ ! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
@@ -632,39 +632,39 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
END SELECT
- !/* Create attributes, up to limit of compact form */
+ ! Create attributes, up to limit of compact form
DO u = 0, max_compact - 1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
CALL H5Acreate_by_name_f(fid, dsetname, attrname, H5T_NATIVE_INTEGER, sid, &
attr, error, lapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F)
CALL check("H5Acreate_by_name_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Verify information for NEW attribute */
+ ! Verify information for NEW attribute
CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error)
! CALL check("FAILED IN attr_info_by_idx_check",total_error)
ENDDO
- ! /* Test opening attributes stored compactly */
+ ! Test opening attributes stored compactly
CALL attr_open_check(fid, dsetname, my_dataset, u, total_error)
ENDDO
- ! /* Work on all the datasets */
+ ! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
CASE (0)
@@ -678,7 +678,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
dsetname = DSET3_NAME
END SELECT
- ! /* Create more attributes, to push into dense form */
+ ! Create more attributes, to push into dense form
DO u = max_compact, max_compact* 2 - 1
WRITE(chr2,'(I2.2)') u
@@ -688,12 +688,12 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
attr, error, lapl_id=H5P_DEFAULT_F)
CALL check("H5Acreate_by_name",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
@@ -701,7 +701,7 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
ENDDO
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dset2, error)
@@ -710,16 +710,16 @@ SUBROUTINE test_attr_create_by_name(new_format,fcpl,fapl, total_error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
ENDDO
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl, error)
CALL check("h5pclose_f",error,total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
@@ -728,12 +728,12 @@ END SUBROUTINE test_attr_create_by_name
SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_info_by_idx(): Test basic H5A (attribute) code.
!** Tests querying attribute info by index
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -790,31 +790,31 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
data_dims = 0
- ! /* Create dataspace for dataset & attributes */
+ ! Create dataspace for dataset & attributes
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create dataset creation property list */
+ ! Create dataset creation property list
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Query the attribute creation properties */
+ ! Query the attribute creation properties
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- ! /* Loop over using index for creation order value */
+ ! Loop over using index for creation order value
DO i = 1, 2
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Set attribute creation order tracking & indexing for object */
+ ! Set attribute creation order tracking & indexing for object
IF(new_format)THEN
IF(use_index(i))THEN
Input1 = H5P_CRT_ORDER_INDEXED_F
@@ -825,7 +825,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL check("H5Pset_attr_creation_order",error,total_error)
ENDIF
- ! /* Create datasets */
+ ! Create datasets
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error )
CALL check("h5dcreate_f",error,total_error)
@@ -836,7 +836,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error )
CALL check("h5dcreate_f",error,total_error)
- ! /* Work on all the datasets */
+ ! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
@@ -849,7 +849,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
my_dataset = dset3
END SELECT
- ! /* Check for query on non-existant attribute */
+ ! Check for query on non-existant attribute
n = 0
@@ -879,10 +879,10 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("h5aget_name_by_idx_f",error,minusone,total_error)
- ! /* Create attributes, up to limit of compact form */
+ ! Create attributes, up to limit of compact form
DO j = 0, max_compact-1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') j
attrname = 'attr '//chr2
@@ -890,19 +890,19 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = j
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Verify information for new attribute */
+ ! Verify information for new attribute
!EP CALL attr_info_by_idx_check(my_dataset, attrname, INT(j,HSIZE_T), use_index(i), total_error )
htmp = j
@@ -914,7 +914,7 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
ENDDO
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dset2, error)
@@ -922,17 +922,17 @@ SUBROUTINE test_attr_info_by_idx(new_format, fcpl, fapl, total_error)
CALL h5dclose_f(dset3, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
END DO
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl,error)
CALL check("h5pclose_f", error, total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
@@ -962,13 +962,13 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T
- ! /* Verify the information for first attribute, in increasing creation order */
+ ! Verify the information for first attribute, in increasing creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL verify("h5aget_info_by_idx_f",corder,0,total_error)
- ! /* Verify the information for new attribute, in increasing creation order */
+ ! Verify the information for new attribute, in increasing creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, n, &
f_corder_valid, corder, cset, data_size, error)
@@ -976,7 +976,7 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
- ! /* Verify the name for new link, in increasing creation order */
+ ! Verify the name for new link, in increasing creation order
! Try with the correct buffer size
@@ -990,24 +990,24 @@ SUBROUTINE attr_info_by_idx_check(obj_id, attrname, n, use_index, total_error )
ENDIF
CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
- ! /* Don't test "native" order if there is no creation order index, since
+ ! Don't test "native" order if there is no creation order index, since
! * there's not a good way to easily predict the attribute's order in the name
! * index.
- ! */
+ !
IF (use_index) THEN
- ! /* Verify the information for first attribute, in native creation order */
+ ! Verify the information for first attribute, in native creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, hzero, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,0,total_error)
- ! /* Verify the information for new attribute, in native creation order */
+ ! Verify the information for new attribute, in native creation order
CALL h5aget_info_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, n, &
f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_by_idx_f",error,total_error)
CALL VERIFY("h5aget_info_by_idx_f",corder,INT(n),total_error)
- ! /* Verify the name for new link, in increasing native order */
+ ! Verify the name for new link, in increasing native order
CALL h5aget_name_by_idx_f(obj_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_NATIVE_F, &
n, tmpname, error) ! check with no optional parameters
CALL check("h5aget_name_by_idx_f",error,total_error)
@@ -1075,12 +1075,12 @@ END SUBROUTINE attr_info_by_idx_check
SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_shared_rename(): Test basic H5A (attribute) code.
!** Tests renaming shared attributes in "compact" & "dense" storage
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -1128,114 +1128,114 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension
INTEGER :: arank = 1 ! Attribure rank
- ! /* Initialize "big" attribute data */
+ ! Initialize "big" attribute data
- ! /* Create dataspace for dataset */
+ ! Create dataspace for dataset
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create "big" dataspace for "large" attributes */
+ ! Create "big" dataspace for "large" attributes
CALL h5screate_simple_f(arank, adims2, big_sid, error)
CALL check("h5screate_simple_f",error,total_error)
- ! /* Loop over type of shared components */
+ ! Loop over type of shared components
DO test_shared = 0, 2
- ! /* Make copy of file creation property list */
+ ! Make copy of file creation property list
CALL H5Pcopy_f(fcpl, my_fcpl, error)
CALL check("H5Pcopy",error,total_error)
- ! /* Set up datatype for attributes */
+ ! Set up datatype for attributes
CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error)
CALL check("H5Tcopy",error,total_error)
- ! /* Special setup for each type of shared components */
+ ! Special setup for each type of shared components
IF( test_shared .EQ. 0) THEN
- ! /* Make attributes > 500 bytes shared */
+ ! Make attributes > 500 bytes shared
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error)
CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
CALL check(" H5Pset_shared_mesg_index_f",error, total_error)
ELSE
- ! /* Set up copy of file creation property list */
+ ! Set up copy of file creation property list
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error)
- ! /* Make attributes > 500 bytes shared */
+ ! Make attributes > 500 bytes shared
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
- ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */
+ ! Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error)
ENDIF
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Close FCPL copy */
+ ! Close FCPL copy
CALL h5pclose_f(my_fcpl, error)
CALL check("h5pclose_f", error, total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Re-open file */
+ ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
CALL check("h5open_f",error,total_error)
- ! /* Commit datatype to file */
+ ! Commit datatype to file
IF(test_shared.EQ.2) THEN
CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("H5Tcommit",error,total_error)
ENDIF
- ! /* Set up to query the object creation properties */
+ ! Set up to query the object creation properties
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Create datasets */
+ ! Create datasets
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
- ! /* Retrieve limits for compact/dense attribute storage */
+ ! Retrieve limits for compact/dense attribute storage
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl,error)
CALL check("h5pclose_f", error, total_error)
- ! /* Add attributes to each dataset, until after converting to dense storage */
+ ! Add attributes to each dataset, until after converting to dense storage
DO u = 0, (max_compact * 2) - 1
- ! /* Create attribute name */
+ ! Create attribute name
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
- ! /* Alternate between creating "small" & "big" attributes */
+ ! Alternate between creating "small" & "big" attributes
IF(MOD(u+1,2).EQ.0)THEN
- ! /* Create "small" attribute on first dataset */
+ ! Create "small" attribute on first dataset
CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u + 1
data_dims(1) = 1
CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
ELSE
- ! Create "big" attribute on first dataset */
+ ! Create "big" attribute on first dataset
CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! Write data into the attribute */
+ ! Write data into the attribute
data_dims(1) = 1
attr_integer_data(1) = u + 1
@@ -1244,19 +1244,19 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
ENDIF
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Alternate between creating "small" & "big" attributes */
+ ! Alternate between creating "small" & "big" attributes
IF(MOD(u+1,2).EQ.0)THEN
- ! /* Create "small" attribute on second dataset */
+ ! Create "small" attribute on second dataset
CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u + 1
data_dims(1) = 1
@@ -1264,12 +1264,12 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
CALL check("h5awrite_f",error,total_error)
ELSE
- ! /* Create "big" attribute on second dataset */
+ ! Create "big" attribute on second dataset
CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
-! /* Write data into the attribute */
+! Write data into the attribute
attr_integer_data(1) = u + 1
@@ -1278,103 +1278,103 @@ SUBROUTINE test_attr_shared_rename( fcpl, fapl, total_error)
! CALL check("h5awrite_f",error,total_error)
-! /* Check refcount for attribute */
+! Check refcount for attribute
ENDIF
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Create new attribute name */
+ ! Create new attribute name
WRITE(chr2,'(I2.2)') u
attrname2 = 'new attr '//chr2
- ! /* Change second dataset's attribute's name */
+ ! Change second dataset's attribute's name
CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname, attrname2, error, lapl_id=H5P_DEFAULT_F)
CALL check("H5Arename_by_name_f",error,total_error)
- ! /* Check refcount on attributes now */
+ ! Check refcount on attributes now
- ! /* Check refcount on renamed attribute */
+ ! Check refcount on renamed attribute
CALL H5Aopen_f(dataset2, attrname2, attr, error, aapl_id=H5P_DEFAULT_F)
CALL check("H5Aopen_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Check refcount on original attribute */
+ ! Check refcount on original attribute
CALL H5Aopen_f(dataset, attrname, attr, error)
CALL check("H5Aopen",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Change second dataset's attribute's name back to original */
+ ! Change second dataset's attribute's name back to original
CALL H5Arename_by_name_f(fid, DSET2_NAME, attrname2, attrname, error)
CALL check("H5Arename_by_name_f",error,total_error)
- ! /* Check refcount on attributes now */
+ ! Check refcount on attributes now
- ! /* Check refcount on renamed attribute */
+ ! Check refcount on renamed attribute
CALL H5Aopen_f(dataset2, attrname, attr, error)
CALL check("H5Aopen",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Check refcount on original attribute */
+ ! Check refcount on original attribute
- ! /* Check refcount on renamed attribute */
+ ! Check refcount on renamed attribute
CALL H5Aopen_f(dataset, attrname, attr, error)
CALL check("H5Aopen",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
- ! /* Close attribute's datatype */
+ ! Close attribute's datatype
CALL h5tclose_f(attr_tid, error)
CALL check("h5tclose_f",error,total_error)
- ! /* Close attribute's datatype */
+ ! Close attribute's datatype
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dataset2, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Unlink datasets with attributes */
+ ! Unlink datasets with attributes
CALL H5Ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F)
CALL check("HLdelete",error,total_error)
CALL H5Ldelete_f(fid, DSET2_NAME, error)
CALL check("HLdelete",error,total_error)
- !/* Unlink committed datatype */
+ ! Unlink committed datatype
IF(test_shared == 2)THEN
CALL H5Ldelete_f(fid, TYPE1_NAME, error)
CALL check("HLdelete_f",error,total_error)
ENDIF
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Check size of file */
+ ! Check size of file
!filesize = h5_get_file_size(FILENAME);
!VERIFY(filesize, empty_filesize, "h5_get_file_size");
ENDDO
- ! /* Close dataspaces */
+ ! Close dataspaces
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
CALL h5sclose_f(big_sid, error)
@@ -1385,12 +1385,12 @@ END SUBROUTINE test_attr_shared_rename
SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_delete_by_idx(): Test basic H5A (attribute) code.
!** Tests deleting attribute by index
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -1402,9 +1402,9 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
INTEGER(HID_T), INTENT(IN) :: fapl
INTEGER, INTENT(INOUT) :: total_error
CHARACTER(LEN=8) :: FileName = "tattr.h5"
- INTEGER(HID_T) :: fid ! /* HDF5 File ID */
- INTEGER(HID_T) :: dcpl ! /* Dataset creation property list ID */
- INTEGER(HID_T) :: sid ! /* Dataspace ID */
+ INTEGER(HID_T) :: fid ! HDF5 File ID
+ INTEGER(HID_T) :: dcpl ! Dataset creation property list ID
+ INTEGER(HID_T) :: sid ! Dataspace ID
CHARACTER(LEN=8) :: DSET1_NAME = "Dataset1"
CHARACTER(LEN=8) :: DSET2_NAME = "Dataset2"
@@ -1442,40 +1442,40 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
INTEGER :: idx_type
INTEGER :: order
- INTEGER :: u ! /* Local index variable */
+ INTEGER :: u ! Local index variable
INTEGER :: Input1
INTEGER(HSIZE_T) :: hzero = 0_HSIZE_T
INTEGER :: minusone = -1
data_dims = 0
- ! /* Create dataspace for dataset & attributes */
+ ! Create dataspace for dataset & attributes
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create dataset creation property list */
+ ! Create dataset creation property list
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Query the attribute creation properties */
+ ! Query the attribute creation properties
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- !/* Loop over operating on different indices on link fields */
+ ! 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 */
+ ! Loop over operating in different orders
DO order = H5_ITER_INC_F, H5_ITER_DEC_F
- ! /* Loop over using index for creation order value */
+ ! Loop over using index for creation order value
DO i = 1, 2
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Set attribute creation order tracking & indexing for object */
+ ! Set attribute creation order tracking & indexing for object
IF(new_format)THEN
IF(use_index(i))THEN
@@ -1489,7 +1489,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
ENDIF
- ! /* Create datasets */
+ ! Create datasets
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dset1, error, dcpl )
CALL check("h5dcreate_f2",error,total_error)
@@ -1500,7 +1500,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL h5dcreate_f(fid, DSET3_NAME, H5T_NATIVE_CHARACTER, sid, dset3, error, dcpl )
CALL check("h5dcreate_f4",error,total_error)
- ! /* Work on all the datasets */
+ ! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
@@ -1515,36 +1515,36 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
END SELECT
- ! /* Check for deleting non-existant attribute */
+ ! Check for deleting non-existant attribute
!EP CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, 0_HSIZE_T,error, lapl_id=H5P_DEFAULT_F)
CALL H5Adelete_by_idx_f(my_dataset, '.', idx_type, order, hzero,error, lapl_id=H5P_DEFAULT_F)
CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
- ! /* Create attributes, up to limit of compact form */
+ ! Create attributes, up to limit of compact form
DO u = 0, max_compact - 1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
CALL h5acreate_f(my_dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Verify information for new attribute */
+ ! Verify information for new attribute
CALL attr_info_by_idx_check(my_dataset, attrname, INT(u,HSIZE_T), use_index(i), total_error )
ENDDO
- !/* Check for out of bound deletions */
+ ! Check for out of bound deletions
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error, lapl_id=H5P_DEFAULT_F)
CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
@@ -1563,11 +1563,11 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! CALL HDassert(0.AND."Toomanydatasets!")
END SELECT
- ! /* Delete attributes from compact storage */
+ ! Delete attributes from compact storage
DO u = 0, max_compact - 2
- ! /* Delete first attribute in appropriate order */
+ ! Delete first attribute in appropriate order
!EP CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error)
@@ -1575,7 +1575,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL check("H5Adelete_by_idx_f",error,total_error)
- ! /* Verify the attribute information for first attribute in appropriate order */
+ ! Verify the attribute information for first attribute in appropriate order
! HDmemset(&ainfo, 0, sizeof(ainfo));
!EP CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, &
@@ -1590,7 +1590,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("H5Aget_info_by_idx_f",corder, max_compact-(u + 2),total_error)
ENDIF
- ! /* Verify the name for first attribute in appropriate order */
+ ! Verify the name for first attribute in appropriate order
size = 7 ! *CHECK* IF NOT THE SAME SIZE
CALL h5aget_name_by_idx_f(my_dataset, ".", idx_type, order,INT(0,hsize_t), &
@@ -1607,7 +1607,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("h5aget_name_by_idx_f",error,0,total_error)
ENDDO
- ! /* Delete last attribute */
+ ! Delete last attribute
!EP CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, 0_HSIZE_T, error)
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, hzero, error)
@@ -1615,7 +1615,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
ENDDO
-! /* Work on all the datasets */
+! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
@@ -1629,11 +1629,11 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
! CALL HDassert(0.AND."Toomanydatasets!")
END SELECT
- ! /* Create more attributes, to push into dense form */
+ ! Create more attributes, to push into dense form
DO u = 0, (max_compact * 2) - 1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
@@ -1641,24 +1641,24 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
- ! /* Check for out of bound deletion */
+ ! Check for out of bound deletion
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(u,HSIZE_T), error)
CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
- ! /* Work on all the datasets */
+ ! Work on all the datasets
DO curr_dset = 0,NUM_DSETS-1
SELECT CASE (curr_dset)
@@ -1670,15 +1670,15 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
my_dataset = dset3
END SELECT
- ! /* Delete attributes from dense storage */
+ ! Delete attributes from dense storage
DO u = 0, (max_compact * 2) - 1 - 1
- ! /* Delete first attribute in appropriate order */
+ ! Delete first attribute in appropriate order
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error)
CALL check("H5Adelete_by_idx_f",error,total_error)
- ! /* Verify the attribute information for first attribute in appropriate order */
+ ! Verify the attribute information for first attribute in appropriate order
CALL h5aget_info_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), &
f_corder_valid, corder, cset, data_size, error)
@@ -1690,7 +1690,7 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL VERIFY("H5Aget_info_by_idx_f",corder, ((max_compact * 2) - (u + 2)), total_error)
ENDIF
- ! /* Verify the name for first attribute in appropriate order */
+ ! Verify the name for first attribute in appropriate order
! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
size = 7 ! *CHECK* if not the correct size
@@ -1709,17 +1709,17 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
ENDDO
- ! /* Delete last attribute */
+ ! Delete last attribute
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error, lapl_id=H5P_DEFAULT_F)
CALL check("H5Adelete_by_idx_f",error,total_error)
- !/* Check for deletion on empty attribute storage again */
+ ! Check for deletion on empty attribute storage again
CALL H5Adelete_by_idx_f(my_dataset, ".", idx_type, order, INT(0,HSIZE_T), error)
CALL VERIFY("H5Adelete_by_idx_f",error,minusone,total_error)
ENDDO
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dset1, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dset2, error)
@@ -1727,18 +1727,18 @@ SUBROUTINE test_attr_delete_by_idx(new_format, fcpl, fapl, total_error)
CALL h5dclose_f(dset3, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
ENDDO
ENDDO
ENDDO
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl,error)
CALL check("h5pclose_f", error, total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
@@ -1746,12 +1746,12 @@ END SUBROUTINE test_attr_delete_by_idx
SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_shared_delete(): Test basic H5A (attribute) code.
!** Tests deleting shared attributes in "compact" & "dense" storage
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -1796,77 +1796,77 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
INTEGER(HSIZE_T), DIMENSION(1) :: adims2 = (/1/) ! Attribute dimension
INTEGER :: arank = 1 ! Attribure rank
- ! /* Output message about test being performed */
+ ! Output message about test being performed
- ! /* Initialize "big" attribute DATA */
- ! /* Create dataspace for dataset */
+ ! Initialize "big" attribute DATA
+ ! Create dataspace for dataset
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- !/* Create "big" dataspace for "large" attributes */
+ ! Create "big" dataspace for "large" attributes
CALL h5screate_simple_f(arank, adims2, big_sid, error)
CALL check("h5screate_simple_f",error,total_error)
- ! /* Loop over type of shared components */
+ ! Loop over type of shared components
DO test_shared = 0, 2
- ! /* Make copy of file creation property list */
+ ! Make copy of file creation property list
CALL H5Pcopy_f(fcpl, my_fcpl, error)
CALL check("H5Pcopy",error,total_error)
- ! /* Set up datatype for attributes */
+ ! Set up datatype for attributes
CALL H5Tcopy_f(H5T_NATIVE_INTEGER, attr_tid, error)
CALL check("H5Tcopy",error,total_error)
- ! /* Special setup for each type of shared components */
+ ! Special setup for each type of shared components
IF( test_shared .EQ. 0) THEN
- ! /* Make attributes > 500 bytes shared */
+ ! Make attributes > 500 bytes shared
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,1,error)
CALL check("H5Pset_shared_mesg_nindexes_f",error, total_error)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
CALL check(" H5Pset_shared_mesg_index_f",error, total_error)
ELSE
- ! /* Set up copy of file creation property list */
+ ! Set up copy of file creation property list
CALL H5Pset_shared_mesg_nindexes_f(my_fcpl,3,error)
- ! /* Make attributes > 500 bytes shared */
+ ! Make attributes > 500 bytes shared
CALL H5Pset_shared_mesg_index_f(my_fcpl, 0, H5O_SHMESG_ATTR_FLAG_F, 500,error)
- ! /* Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-) */
+ ! Make datatypes & dataspaces > 1 byte shared (i.e. all of them :-)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 1, H5O_SHMESG_DTYPE_FLAG_F, 1,error)
CALL H5Pset_shared_mesg_index_f(my_fcpl, 2, H5O_SHMESG_SDSPACE_FLAG_F, 1,error)
ENDIF
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, my_fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Close FCPL copy */
+ ! Close FCPL copy
CALL h5pclose_f(my_fcpl, error)
CALL check("h5pclose_f", error, total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Re-open file */
+ ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error,fapl)
CALL check("h5open_f",error,total_error)
- ! /* Commit datatype to file */
+ ! Commit datatype to file
IF(test_shared.EQ.2) THEN
CALL H5Tcommit_f(fid, TYPE1_NAME, attr_tid, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("H5Tcommit",error,total_error)
ENDIF
- ! /* Set up to query the object creation properties */
+ ! Set up to query the object creation properties
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Create datasets */
+ ! Create datasets
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
@@ -1874,42 +1874,42 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
CALL h5dcreate_f(fid, DSET2_NAME, H5T_NATIVE_CHARACTER, sid, dataset2, error, dcpl_id=dcpl )
CALL check("h5dcreate_f",error,total_error)
- ! /* Retrieve limits for compact/dense attribute storage */
+ ! Retrieve limits for compact/dense attribute storage
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl,error)
CALL check("h5pclose_f", error, total_error)
- ! /* Add attributes to each dataset, until after converting to dense storage */
+ ! Add attributes to each dataset, until after converting to dense storage
DO u = 0, (max_compact * 2) - 1
- ! /* Create attribute name */
+ ! Create attribute name
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
- ! /* Alternate between creating "small" & "big" attributes */
+ ! Alternate between creating "small" & "big" attributes
IF(MOD(u+1,2).EQ.0)THEN
- ! /* Create "small" attribute on first dataset */
+ ! Create "small" attribute on first dataset
CALL h5acreate_f(dataset, attrname, attr_tid, sid, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u + 1
data_dims(1) = 1
CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
ELSE
- ! Create "big" attribute on first dataset */
+ ! Create "big" attribute on first dataset
CALL h5acreate_f(dataset, attrname, attr_tid, big_sid, attr, error)
CALL check("h5acreate_f",error,total_error)
- ! Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u + 1
data_dims(1) = 1
@@ -1918,31 +1918,31 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
ENDIF
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Alternate between creating "small" & "big" attributes */
+ ! Alternate between creating "small" & "big" attributes
IF(MOD(u+1,2).EQ.0)THEN
- ! /* Create "small" attribute on second dataset */
+ ! Create "small" attribute on second dataset
CALL h5acreate_f(dataset2, attrname, attr_tid, sid, attr, error)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
attr_integer_data(1) = u + 1
data_dims(1) = 1
CALL h5awrite_f(attr, attr_tid, attr_integer_data, data_dims, error)
CALL check("h5awrite_f",error,total_error)
ELSE
- ! /* Create "big" attribute on second dataset */
+ ! Create "big" attribute on second dataset
CALL h5acreate_f(dataset2, attrname, attr_tid, big_sid, attr, error, acpl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
-! /* Write data into the attribute */
+! Write data into the attribute
attr_integer_data(1) = u + 1
@@ -1951,21 +1951,21 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
CALL check("h5awrite_f",error,total_error)
ENDIF
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
- ! /* Delete attributes from second dataset */
+ ! Delete attributes from second dataset
DO u = 0, max_compact*2-1
- ! /* Create attribute name */
+ ! Create attribute name
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
- ! /* Delete second dataset's attribute */
+ ! Delete second dataset's attribute
CALL H5Adelete_by_name_f(fid, DSET2_NAME, attrname,error,lapl_id=H5P_DEFAULT_F)
CALL check("H5Adelete_by_name", error, total_error)
@@ -1973,31 +1973,31 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
CALL check("h5aopen_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
- ! /* Close attribute's datatype */
+ ! Close attribute's datatype
CALL h5tclose_f(attr_tid, error)
CALL check("h5tclose_f",error,total_error)
- ! /* Close Datasets */
+ ! Close Datasets
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
CALL h5dclose_f(dataset2, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Unlink datasets WITH attributes */
+ ! Unlink datasets WITH attributes
CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F)
CALL check("H5Ldelete_f", error, total_error)
CALL h5ldelete_f(fid, DSET2_NAME, error)
CALL check("H5Ldelete_f", error, total_error)
- ! /* Unlink committed datatype */
+ ! Unlink committed datatype
IF( test_shared == 2) THEN
CALL h5ldelete_f(fid, TYPE1_NAME, error)
@@ -2005,13 +2005,13 @@ SUBROUTINE test_attr_shared_delete(fcpl, fapl, total_error)
ENDIF
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
ENDDO
- ! /* Close dataspaces */
+ ! Close dataspaces
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
CALL h5sclose_f(big_sid, error)
@@ -2023,12 +2023,12 @@ END SUBROUTINE test_attr_shared_delete
SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_dense_open(): Test basic H5A (attribute) code.
!** Tests opening attributes in "dense" storage
!**
-!****************************************************************/
+!***************************************************************
USE HDF5
USE TH5_MISC
@@ -2064,73 +2064,73 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
data_dims = 0
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Re-open file */
+ ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error)
- ! /* Create dataspace for dataset */
+ ! Create dataspace for dataset
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Query the group creation properties */
+ ! Query the group creation properties
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Enable creation order tracking on attributes, so creation order tests work */
+ ! Enable creation order tracking on attributes, so creation order tests work
CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_TRACKED_F, error)
CALL check("H5Pset_attr_creation_order",error,total_error)
- ! /* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, &
lcpl_id=H5P_DEFAULT_F, dcpl_id=dcpl, dapl_id=H5P_DEFAULT_F)
CALL check("h5dcreate_f",error,total_error)
- ! /* Retrieve limits for compact/dense attribute storage */
+ ! Retrieve limits for compact/dense attribute storage
CALL H5Pget_attr_phase_change_f(dcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f",error,total_error)
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl, error)
CALL check("h5pclose_f",error,total_error)
- ! /* Add attributes, until just before converting to dense storage */
+ ! Add attributes, until just before converting to dense storage
DO u = 0, max_compact - 1
- ! /* Create attribute */
+ ! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Verify attributes written so far */
+ ! Verify attributes written so far
CALL test_attr_dense_verify(dataset, u, total_error)
ENDDO
!
-! /* Add one more attribute, to push into "dense" storage */
-! /* Create attribute */
+! Add one more attribute, to push into "dense" storage
+! Create attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
@@ -2138,47 +2138,47 @@ SUBROUTINE test_attr_dense_open( fcpl, fapl, total_error)
CALL h5acreate_f(dataset, attrname, H5T_NATIVE_INTEGER, sid, attr, error, aapl_id=H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write data into the attribute */
+ ! Write data into the attribute
data_dims(1) = 1
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, u, data_dims, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
- ! /* Verify all the attributes written */
+ ! Verify all the attributes written
! ret = test_attr_dense_verify(dataset, (u + 1));
! CHECK(ret, FAIL, "test_attr_dense_verify");
- ! /* CLOSE Dataset */
+ ! CLOSE Dataset
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Unlink dataset with attributes */
+ ! Unlink dataset with attributes
CALL h5ldelete_f(fid, DSET1_NAME, error, H5P_DEFAULT_F)
CALL check("H5Ldelete_f", error, total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Check size of file */
+ ! Check size of file
! filesize = h5_get_file_size(FILENAME);
! VERIFY(filesize, empty_filesize, "h5_get_file_size")
END SUBROUTINE test_attr_dense_open
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_dense_verify(): Test basic H5A (attribute) code.
!** Verify attributes on object
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
@@ -2206,21 +2206,21 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
data_dims = 0
- ! /* Retrieve the current # of reported errors */
+ ! Retrieve the current # of reported errors
! old_nerrs = GetTestNumErrs();
- ! /* Re-open all the attributes by name and verify the data */
+ ! Re-open all the attributes by name and verify the data
DO u = 0, max_attr -1
- ! /* Open attribute */
+ ! Open attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
CALL h5aopen_f(loc_id, attrname, attr, error)
CALL check("h5aopen_f",error,total_error)
- ! /* Read data from the attribute */
+ ! Read data from the attribute
! value = 103
data_dims(1) = 1
@@ -2229,22 +2229,22 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
CALL CHECK("H5Aread_F", error, total_error)
CALL VERIFY("H5Aread_F", value, u, total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
- ! /* Re-open all the attributes by index and verify the data */
+ ! Re-open all the attributes by index and verify the data
DO u=0, max_attr-1
- ! /* Open attribute */
+ ! Open attribute
CALL H5Aopen_by_idx_f(loc_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(u,HSIZE_T), &
attr, error, aapl_id=H5P_DEFAULT_F)
- ! /* Verify Name */
+ ! Verify Name
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
@@ -2255,26 +2255,26 @@ SUBROUTINE test_attr_dense_verify(loc_id, max_attr, total_error)
WRITE(*,*) 'ERROR: attribute name different: attr_name = ',check_name, ', should be ', attrname
total_error = total_error + 1
ENDIF
- ! /* Read data from the attribute */
+ ! Read data from the attribute
data_dims(1) = 1
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, value, data_dims, error)
CALL CHECK("H5Aread_f", error, total_error)
CALL VERIFY("H5Aread_f", value, u, total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
END SUBROUTINE test_attr_dense_verify
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_corder_create_empty(): Test basic H5A (attribute) code.
!** Tests basic code to create objects with attribute creation order info
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
@@ -2300,30 +2300,30 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
INTEGER :: crt_order_flags
INTEGER :: minusone = -1
- ! /* Output message about test being performed */
+ ! Output message about test being performed
! WRITE(*,*) " - Testing Basic Code for Attributes with Creation Order Info"
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Create dataset creation property list */
+ ! Create dataset creation property list
CALL H5Pcreate_f(H5P_DATASET_CREATE_F,dcpl,error)
CALL check("h5Pcreate_f",error,total_error)
- ! /* Get creation order indexing on object */
+ ! Get creation order indexing on object
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
- ! /* Setting invalid combination of a attribute order creation order indexing on should fail */
+ ! Setting invalid combination of a attribute order creation order indexing on should fail
CALL H5Pset_attr_creation_order_f(dcpl, H5P_CRT_ORDER_INDEXED_F, error)
CALL VERIFY("H5Pset_attr_creation_order_f",error , minusone, total_error)
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , 0, total_error)
- ! /* Set attribute creation order tracking & indexing for object */
+ ! Set attribute creation order tracking & indexing for object
CALL h5pset_attr_creation_order_f(dcpl, IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), error)
CALL check("H5Pset_attr_creation_order_f",error,total_error)
@@ -2332,72 +2332,72 @@ SUBROUTINE test_attr_corder_create_basic( fcpl, fapl, total_error )
CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error)
- ! /* Create dataspace for dataset */
+ ! Create dataspace for dataset
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(fid, DSET1_NAME, H5T_NATIVE_CHARACTER, sid, dataset, error, &
lcpl_id=H5P_DEFAULT_F, dapl_id=H5P_DEFAULT_F, dcpl_id=dcpl)
CALL check("h5dcreate_f",error,total_error)
- ! /* Close dataspace */
+ ! Close dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
- ! /* Close Dataset */
+ ! Close Dataset
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl, error)
CALL check("h5pclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Re-open file */
+ ! Re-open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error)
- ! /* Open dataset created */
+ ! Open dataset created
CALL h5dopen_f(fid, DSET1_NAME, dataset, error, H5P_DEFAULT_F )
CALL check("h5dopen_f",error,total_error)
- ! /* Retrieve dataset creation property list for group */
+ ! Retrieve dataset creation property list for group
CALL H5Dget_create_plist_f(dataset, dcpl, error)
CALL check("H5Dget_create_plist_f",error,total_error)
- ! /* Query the attribute creation properties */
+ ! Query the attribute creation properties
CALL H5Pget_attr_creation_order_f(dcpl, crt_order_flags, error)
CALL check("H5Pget_attr_creation_order_f",error,total_error)
CALL VERIFY("H5Pget_attr_creation_order_f",crt_order_flags , &
IOR(H5P_CRT_ORDER_TRACKED_F, H5P_CRT_ORDER_INDEXED_F), total_error )
- ! /* Close property list */
+ ! Close property list
CALL h5pclose_f(dcpl, error)
CALL check("h5pclose_f",error,total_error)
- ! /* Close Dataset */
+ ! Close Dataset
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
END SUBROUTINE test_attr_corder_create_basic
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_basic_write(): Test basic H5A (attribute) code.
!** Tests integer attributes on both datasets and groups
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_attr_basic_write(fapl, total_error)
@@ -2451,97 +2451,97 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
attr_data1a(3) = -99890
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid1, error, H5P_DEFAULT_F, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Create dataspace for dataset */
+ ! Create dataspace for dataset
CALL h5screate_simple_f(rank1, dims1, sid1, error, maxdims1)
CALL check("h5screate_simple_f",error,total_error)
- ! /* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(fid1, DSET1_NAME, H5T_NATIVE_CHARACTER, sid1, dataset, error, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F )
CALL check("h5dcreate_f",error,total_error)
- ! /* Create dataspace for attribute */
+ ! Create dataspace for attribute
CALL h5screate_simple_f(ATTR1_RANK, dimsa, sid2, error)
CALL check("h5screate_simple_f",error,total_error)
- ! /* Try to create an attribute on the file (should create an attribute on root group) */
+ ! Try to create an attribute on the file (should create an attribute on root group)
CALL h5acreate_f(fid1, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, aapl_id=H5P_DEFAULT_F, acpl_id=H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Open the root group */
+ ! Open the root group
CALL H5Gopen_f(fid1, "/", group, error, H5P_DEFAULT_F)
CALL check("H5Gopen_f",error,total_error)
- ! /* Open attribute again */
+ ! Open attribute again
CALL h5aopen_f(group, ATTR1_NAME, attr, error)
CALL check("h5aopen_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Close root group */
+ ! Close root group
CALL H5Gclose_f(group, error)
CALL check("h5gclose_f",error,total_error)
- ! /* Create an attribute for the dataset */
+ ! Create an attribute for the dataset
CALL h5acreate_f(dataset, ATTR1_NAME, H5T_NATIVE_INTEGER, sid2, attr, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write attribute information */
+ ! Write attribute information
CALL h5awrite_f(attr, H5T_NATIVE_INTEGER, attr_data1, dimsa, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Create an another attribute for the dataset */
+ ! Create an another attribute for the dataset
CALL h5acreate_f(dataset, ATTR1A_NAME, H5T_NATIVE_INTEGER, sid2, attr2, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5acreate_f",error,total_error)
- ! /* Write attribute information */
+ ! Write attribute information
CALL h5awrite_f(attr2, H5T_NATIVE_INTEGER, attr_data1a, dimsa, error)
CALL check("h5awrite_f",error,total_error)
- ! /* Check storage size for attribute */
+ ! Check storage size for attribute
CALL h5aget_storage_size_f(attr, attr_size, error)
CALL check("h5aget_storage_size_f",error,total_error)
!EP CALL VERIFY("h5aget_storage_size_f", INT(attr_size), 2*HSIZE_T, total_error)
- ! /* Read attribute information immediately, without closing attribute */
+ ! Read attribute information immediately, without closing attribute
CALL h5aread_f(attr, H5T_NATIVE_INTEGER, read_data1, dimsa, error)
CALL check("h5aread_f",error,total_error)
- ! /* Verify values read in */
+ ! Verify values read in
DO i = 1, ATTR1_DIM1
CALL VERIFY('h5aread_f',attr_data1(i),read_data1(i), total_error)
ENDDO
- ! /* CLOSE attribute */
+ ! CLOSE attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr2, error)
CALL check("h5aclose_f",error,total_error)
- ! /* change attribute name */
+ ! change attribute name
CALL H5Arename_f(dataset, ATTR1_NAME, ATTR_TMP_NAME, error)
CALL check("H5Arename_f", error, total_error)
- ! /* Open attribute again */
+ ! Open attribute again
CALL h5aopen_f(dataset, ATTR_TMP_NAME, attr, error)
CALL check("h5aopen_f",error,total_error)
- ! /* Verify new attribute name */
+ ! Verify new attribute name
! Set a deliberately small size
check_name = ' ' ! need to initialize or does not pass test
@@ -2572,7 +2572,7 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
CALL check('H5Aget_name_f',error,total_error)
CALL VerifyString('H5Aget_name_f',chr_exact_size,ATTR_TMP_NAME, total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr, error)
CALL check("h5aclose_f",error,total_error)
@@ -2580,22 +2580,22 @@ SUBROUTINE test_attr_basic_write(fapl, total_error)
CALL check("h5sclose_f",error,total_error)
CALL h5sclose_f(sid2, error)
CALL check("h5sclose_f",error,total_error)
- !/* Close Dataset */
+ ! Close Dataset
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid1, error)
CALL check("h5fclose_f",error,total_error)
END SUBROUTINE test_attr_basic_write
-!/****************************************************************
+!***************************************************************
!**
!** test_attr_many(): Test basic H5A (attribute) code.
!** Tests storing lots of attributes
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
@@ -2630,20 +2630,20 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
data_dims = 0
- !/* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, fcpl, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Create dataspace for attribute */
+ ! Create dataspace for attribute
CALL h5screate_f(H5S_SCALAR_F, sid, error)
CALL check("h5screate_f",error,total_error)
- ! /* Create group for attributes */
+ ! Create group for attributes
CALL H5Gcreate_f(fid, GROUP1_NAME, gid, error)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Create many attributes */
+ ! Create many attributes
IF(new_format)THEN
nattr = 250
@@ -2687,21 +2687,21 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error)
ENDDO
- ! /* Close group */
+ ! Close group
CALL H5Gclose_f(gid, error)
CALL check("h5gclose_f",error,total_error)
- ! /* Close file */
+ ! Close file
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- ! /* Close dataspaces */
+ ! Close dataspaces
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f",error,total_error)
END SUBROUTINE test_attr_many
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: attr_open_check
! *
! * Purpose: Check opening attribute on an object
@@ -2713,7 +2713,7 @@ END SUBROUTINE test_attr_many
! * March 21, 2008
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
@@ -2738,10 +2738,10 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
INTEGER(HSIZE_T) :: storage_size ! attributes storage requirements
CHARACTER(LEN=2) :: chr2
INTEGER(HID_T) attr_id
- ! /* Open each attribute on object by index and check that it's the correct one */
+ ! Open each attribute on object by index and check that it's the correct one
DO u = 0, max_attrs-1
- ! /* Open the attribute */
+ ! Open the attribute
WRITE(chr2,'(I2.2)') u
attrname = 'attr '//chr2
@@ -2751,12 +2751,12 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aopen_f",error,total_error)
- ! /* Get the attribute's information */
+ ! Get the attribute's information
CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f",error,total_error)
- ! /* Check that the object's attributes are correct */
+ ! Check that the object's attributes are correct
CALL VERIFY("h5aget_info_f.corder",corder,u,total_error)
CALL Verifylogical("h5aget_info_f.corder_valid",f_corder_valid,.TRUE.,total_error)
CALL VERIFY("h5aget_info_f.cset", cset, H5T_CSET_ASCII_F, total_error)
@@ -2766,18 +2766,18 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL VERIFY("h5aget_info_f.data_size", INT(data_size), INT(storage_size), total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr_id, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Open the attribute */
+ ! Open the attribute
CALL H5Aopen_by_name_f(obj_id, ".", attrname, attr_id, error, lapl_id=H5P_DEFAULT_F, aapl_id=H5P_DEFAULT_F)
CALL check("H5Aopen_by_name_f", error, total_error)
CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f",error,total_error)
- ! /* Check the attribute's information */
+ ! Check the attribute's information
CALL VERIFY("h5aget_info_f",corder,u,total_error)
CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
@@ -2785,21 +2785,21 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_storage_size_f",error,total_error)
CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr_id, error)
CALL check("h5aclose_f",error,total_error)
- ! /* Open the attribute */
+ ! Open the attribute
CALL H5Aopen_by_name_f(fid, dsetname, attrname, attr_id, error)
CALL check("H5Aopen_by_name_f", error, total_error)
- ! /* Get the attribute's information */
+ ! Get the attribute's information
CALL h5aget_info_f(attr_id, f_corder_valid, corder, cset, data_size, error)
CALL check("h5aget_info_f",error,total_error)
- ! /* Check the attribute's information */
+ ! Check the attribute's information
CALL VERIFY("h5aget_info_f",corder,u,total_error)
CALL Verifylogical("h5aget_info_f",f_corder_valid,.TRUE.,total_error)
CALL VERIFY("h5aget_info_f", cset, H5T_CSET_ASCII_F, total_error)
@@ -2807,7 +2807,7 @@ SUBROUTINE attr_open_check(fid, dsetname, obj_id, max_attrs, total_error )
CALL check("h5aget_storage_size_f",error,total_error)
CALL VERIFY("h5aget_info_f", INT(data_size), INT(storage_size), total_error)
- ! /* Close attribute */
+ ! Close attribute
CALL h5aclose_f(attr_id, error)
CALL check("h5aclose_f",error,total_error)
ENDDO
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index 82ba27c..a7d45f2 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -39,11 +39,11 @@ MODULE test_my_hdf5_error_handler
CONTAINS
-!/****************************************************************
+!***************************************************************
!**
!** my_hdf5_error_handler: Custom error callback routine.
!**
-!****************************************************************/
+!***************************************************************
INTEGER FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C)
@@ -173,10 +173,10 @@ SUBROUTINE test_error(total_error)
!!$#ifdef H5_USE_16_API
!!$ if (old_func != (H5E_auto_t)H5Eprint)
!!$ TEST_ERROR;
-!!$#else /* H5_USE_16_API */
+!!$#else H5_USE_16_API
!!$ if (old_func != (H5E_auto2_t)H5Eprint2)
!!$ TEST_ERROR;
-!!$#endif /* H5_USE_16_API */
+!!$#endif H5_USE_16_API
! set the customized error handling routine
diff --git a/fortran/test/tH5G_1_8.f90 b/fortran/test/tH5G_1_8.f90
index 5e6f50a..ab75163 100644
--- a/fortran/test/tH5G_1_8.f90
+++ b/fortran/test/tH5G_1_8.f90
@@ -41,7 +41,7 @@ SUBROUTINE group_test(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(HID_T) :: fapl, fapl2, my_fapl ! /* File access property lists */
+ INTEGER(HID_T) :: fapl, fapl2, my_fapl ! File access property lists
INTEGER :: error, ret_total_error
@@ -49,15 +49,15 @@ SUBROUTINE group_test(cleanup, total_error)
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
CALL check("H5Pcreate_f",error, total_error)
- ! /* Copy the file access property list */
+ ! Copy the file access property list
CALL H5Pcopy_f(fapl, fapl2, error)
CALL check("H5Pcopy_f",error, total_error)
- ! /* Set the "use the latest version of the format" bounds for creating objects in the file */
+ ! Set the "use the latest version of the format" bounds for creating objects in the file
CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
CALL check("H5Pset_libver_bounds_f",error, total_error)
- ! /* Check for FAPL to USE */
+ ! Check for FAPL to USE
my_fapl = fapl2
ret_total_error = 0
@@ -121,7 +121,7 @@ SUBROUTINE group_test(cleanup, total_error)
END SUBROUTINE group_test
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: group_info
! *
! * Purpose: Create a group with creation order indices and test querying
@@ -135,7 +135,7 @@ END SUBROUTINE group_test
! * February 18, 2008
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE group_info(cleanup, fapl, total_error)
@@ -146,21 +146,21 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
- INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */
+ INTEGER(HID_T) :: gcpl_id ! Group creation property list ID
- INTEGER :: max_compact ! /* Maximum # of links to store in group compactly */
- INTEGER :: min_dense ! /* Minimum # of links to store in group "densely" */
+ INTEGER :: max_compact ! Maximum # of links to store in group compactly
+ INTEGER :: min_dense ! Minimum # of links to store in group "densely"
- INTEGER :: idx_type ! /* Type of index to operate on */
- INTEGER :: order, iorder ! /* Order within in the index */
- LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! /* Use index on creation order values */
+ INTEGER :: idx_type ! Type of index to operate on
+ INTEGER :: order, iorder ! Order within in the index
+ LOGICAL, DIMENSION(1:2) :: use_index = (/.FALSE.,.TRUE./) ! Use index on creation order values
CHARACTER(LEN=6), PARAMETER :: prefix = 'links0'
- CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */
+ CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! File name
INTEGER :: Input1
- INTEGER(HID_T) :: group_id ! /* Group ID */
- INTEGER(HID_T) :: soft_group_id ! /* Group ID for soft links */
+ INTEGER(HID_T) :: group_id ! Group ID
+ INTEGER(HID_T) :: soft_group_id ! Group ID for soft links
- INTEGER :: i ! /* Local index variables */
+ INTEGER :: i ! Local index variables
INTEGER :: storage_type ! Type of storage for links in group:
! H5G_STORAGE_TYPE_COMPACT: Compact storage
! H5G_STORAGE_TYPE_DENSE: Indexed storage
@@ -168,34 +168,34 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: nlinks ! Number of links in group
INTEGER :: max_corder ! Current maximum creation order value for group
- INTEGER :: u,v ! /* Local index variables */
+ INTEGER :: u,v ! Local index variables
CHARACTER(LEN=2) :: chr2
- INTEGER(HID_T) :: group_id2, group_id3 ! /* Group IDs */
- CHARACTER(LEN=7) :: objname ! /* Object name */
- CHARACTER(LEN=7) :: objname2 ! /* Object name */
- CHARACTER(LEN=19) :: valname ! /* Link value */
+ INTEGER(HID_T) :: group_id2, group_id3 ! Group IDs
+ CHARACTER(LEN=7) :: objname ! Object name
+ CHARACTER(LEN=7) :: objname2 ! Object name
+ CHARACTER(LEN=19) :: valname ! Link value
CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group"
CHARACTER(LEN=17), PARAMETER :: CORDER_SOFT_GROUP_NAME = "corder_soft_group"
- INTEGER(HID_T) :: file_id ! /* File ID */
- INTEGER :: error ! /* Generic return value */
+ INTEGER(HID_T) :: file_id ! File ID
+ INTEGER :: error ! Generic return value
LOGICAL :: mounted
LOGICAL :: cleanup
- ! /* Create group creation property list */
+ ! Create group creation property list
CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error )
CALL check("H5Pcreate_f", error, total_error)
- ! /* Query the group creation properties */
+ ! Query the group creation properties
CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error)
CALL check("H5Pget_link_phase_change_f", error, total_error)
- ! /* Loop over operating on different indices on link fields */
+ ! 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 */
+ ! Loop over operating in different orders
DO iorder = H5_ITER_INC_F, H5_ITER_NATIVE_F
- ! /* Loop over using index for creation order value */
+ ! Loop over using index for creation order value
DO i = 1, 2
- ! /* Print appropriate test message */
+ ! Print appropriate test message
IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN
IF(iorder == H5_ITER_INC_F)THEN
order = H5_ITER_INC_F
@@ -244,11 +244,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
ENDIF
END IF
- ! /* Create file */
+ ! Create file
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl)
CALL check("H5Fcreate_f", error, total_error)
- ! /* Set creation order tracking & indexing on group */
+ ! Set creation order tracking & indexing on group
IF(use_index(i))THEN
Input1 = H5P_CRT_ORDER_INDEXED_F
ELSE
@@ -257,103 +257,103 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error)
CALL check("H5Pset_link_creation_order_f", error, total_error)
- ! /* Create group with creation order tracking on */
+ ! Create group with creation order tracking on
CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Create group with creation order tracking on for soft links */
+ ! Create group with creation order tracking on for soft links
CALL H5Gcreate_f(file_id, CORDER_SOFT_GROUP_NAME, soft_group_id, error, &
OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Check for out of bound query by index on empty group, should fail */
+ ! Check for out of bound query by index on empty group, should fail
CALL H5Gget_info_by_idx_f(group_id, ".", H5_INDEX_NAME_F, order, INT(0,HSIZE_T), &
storage_type, nlinks, max_corder, error)
CALL VERIFY("H5Gget_info_by_idx_f", error, -1, total_error)
- ! /* Create several links, up to limit of compact form */
+ ! Create several links, up to limit of compact form
DO u = 0, max_compact-1
- ! /* Make name for link */
+ ! Make name for link
WRITE(chr2,'(I2.2)') u
objname = 'fill '//chr2
- ! /* Create hard link, with group object */
+ ! Create hard link, with group object
CALL H5Gcreate_f(group_id, objname, group_id2, error, OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error, mounted)
CALL check("H5Gget_info_f", error, total_error)
- ! /* Check (new/empty) group's information */
+ ! Check (new/empty) group's information
CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_f", max_corder, 0, total_error)
CALL VERIFY("H5Gget_info_f", nlinks, 0, total_error)
CALL verifyLogical("H5Gget_info_f.mounted", mounted,.FALSE.,total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted)
CALL check("H5Gget_info_by_name_f", error, total_error)
- ! /* Check (new/empty) group's information */
+ ! Check (new/empty) group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
CALL verifyLogical("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name", error, total_error)
- ! /* Check (new/empty) group's information */
+ ! Check (new/empty) group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f", max_corder, 0, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, 0, total_error)
- ! /* Create objects in new group created */
+ ! Create objects in new group created
DO v = 0, u
- ! /* Make name for link */
+ ! Make name for link
WRITE(chr2,'(I2.2)') v
objname2 = 'fill '//chr2
- ! /* Create hard link, with group object */
+ ! Create hard link, with group object
CALL H5Gcreate_f(group_id2, objname2, group_id3, error )
CALL check("H5Gcreate_f", error, total_error)
- ! /* Close group created */
+ ! Close group created
CALL H5Gclose_f(group_id3, error)
CALL check("H5Gclose_f", error, total_error)
ENDDO
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_f(group_id2, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_f", error, total_error)
- ! /* Check (new) group's information */
+ ! Check (new) group's information
CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
- ! /* Check (new) group's information */
+ ! Check (new) group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f",max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
- ! /* Check (new) group's information */
+ ! Check (new) group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
- ! /* Retrieve group's information */
+ ! Retrieve group's information
IF(order.NE.H5_ITER_NATIVE_F)THEN
IF(order.EQ.H5_ITER_INC_F) THEN
CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), &
@@ -366,72 +366,72 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL verifyLogical("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error)
CALL check("H5Gget_info_by_idx_f", error, total_error)
ENDIF
- ! /* Check (new) group's information */
+ ! Check (new) group's information
CALL VERIFY("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_idx_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_by_idx_f", nlinks, u+1, total_error)
ENDIF
- ! /* Close group created */
+ ! Close group created
CALL H5Gclose_f(group_id2, error)
CALL check("H5Gclose_f", error, total_error)
- ! /* Retrieve main group's information */
+ ! Retrieve main group's information
CALL H5Gget_info_f(group_id, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_f", error, total_error)
- ! /* Check main group's information */
+ ! Check main group's information
CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
- ! /* Retrieve main group's information, by name */
+ ! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_by_name_f", error, total_error)
- ! /* Check main group's information */
+ ! Check main group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
- ! /* Retrieve main group's information, by name */
+ ! Retrieve main group's information, by name
CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F)
CALL check("H5Gget_info_by_name_f", error, total_error)
- ! /* Check main group's information */
+ ! Check main group's information
CALL VERIFY("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_by_name_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_by_name_f", nlinks, u+1, total_error)
- ! /* Create soft link in another group, to objects in main group */
+ ! Create soft link in another group, to objects in main group
valname = CORDER_GROUP_NAME//objname
CALL H5Lcreate_soft_f(valname, soft_group_id, objname, error, H5P_DEFAULT_F, H5P_DEFAULT_F)
- ! /* Retrieve soft link group's information, by name */
+ ! Retrieve soft link group's information, by name
CALL H5Gget_info_f(soft_group_id, storage_type, nlinks, max_corder, error)
CALL check("H5Gget_info_f", error, total_error)
- ! /* Check soft link group's information */
+ ! Check soft link group's information
CALL VERIFY("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error)
CALL VERIFY("H5Gget_info_f", max_corder, u+1, total_error)
CALL VERIFY("H5Gget_info_f", nlinks, u+1, total_error)
ENDDO
- ! /* Close the groups */
+ ! Close the groups
CALL H5Gclose_f(group_id, error)
CALL check("H5Gclose_f", error, total_error)
CALL H5Gclose_f(soft_group_id, error)
CALL check("H5Gclose_f", error, total_error)
- ! /* Close the file */
+ ! Close the file
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
ENDDO
ENDDO
ENDDO
- ! /* Free resources */
+ ! Free resources
CALL H5Pclose_f(gcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
@@ -441,7 +441,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
END SUBROUTINE group_info
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: timestamps
! *
! * Purpose: Verify that disabling tracking timestamps for an object
@@ -452,7 +452,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! * February 20, 2008
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE timestamps(cleanup, fapl, total_error)
@@ -463,15 +463,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
- INTEGER(HID_T) :: file_id !/* File ID */
- INTEGER(HID_T) :: group_id !/* Group ID */
- INTEGER(HID_T) :: group_id2 !/* Group ID */
- INTEGER(HID_T) :: gcpl_id !/* Group creation property list ID */
- INTEGER(HID_T) :: gcpl_id2 !/* Group creation property list ID */
+ INTEGER(HID_T) :: file_id ! File ID
+ INTEGER(HID_T) :: group_id ! Group ID
+ INTEGER(HID_T) :: group_id2 ! Group ID
+ INTEGER(HID_T) :: gcpl_id ! Group creation property list ID
+ INTEGER(HID_T) :: gcpl_id2 ! Group creation property list ID
CHARACTER(LEN=6), PARAMETER :: prefix = 'links9'
- CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! /* File name */
- ! /* Timestamp macros */
+ CHARACTER(LEN=9), PARAMETER :: filename = prefix//'.h5' ! File name
+ ! Timestamp macros
CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_1="timestamp1"
CHARACTER(LEN=10), PARAMETER :: TIMESTAMP_GROUP_2="timestamp2"
LOGICAL :: track_times
@@ -479,58 +479,58 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER :: error
- ! /* Print test message */
+ ! Print test message
! WRITE(*,*) "timestamps on objects"
- ! /* Create group creation property list */
+ ! Create group creation property list
CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error )
CALL check("H5Pcreate_f", error, total_error)
- ! /* Query the object timestamp setting */
+ ! Query the object timestamp setting
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- !/* Check default timestamp information */
+ ! Check default timestamp information
CALL VerifyLogical("H5Pget_obj_track_times",track_times,.TRUE.,total_error)
- ! /* Set a non-default object timestamp setting */
+ ! Set a non-default object timestamp setting
CALL H5Pset_obj_track_times_f(gcpl_id, .FALSE., error)
CALL check("H5Pset_obj_track_times_f", error, total_error)
- ! /* Query the object timestamp setting */
+ ! Query the object timestamp setting
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
- ! /* Check default timestamp information */
+ ! Check default timestamp information
CALL VerifyLogical("H5Pget_obj_track_times",track_times,.FALSE.,total_error)
- ! /* Create file */
+ ! Create file
!h5_fixname(FILENAME[0], fapl, filename, sizeof filename);
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl)
CALL check("h5fcreate_f",error,total_error)
- ! /* Create group with non-default object timestamp setting */
+ ! Create group with non-default object timestamp setting
CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_1, group_id, error, &
OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, gcpl_id, H5P_DEFAULT_F)
CALL check("h5fcreate_f",error,total_error)
- ! /* Close the group creation property list */
+ ! Close the group creation property list
CALL H5Pclose_f(gcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
- ! /* Create group with default object timestamp setting */
+ ! Create group with default object timestamp setting
CALL h5gcreate_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, &
OBJECT_NAMELEN_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL check("h5fcreate_f",error,total_error)
- ! /* Retrieve the new groups' creation properties */
+ ! Retrieve the new groups' creation properties
CALL H5Gget_create_plist_f(group_id, gcpl_id, error)
CALL check("H5Gget_create_plist", error, total_error)
CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error)
CALL check("H5Gget_create_plist", error, total_error)
- ! /* Query & verify the object timestamp settings */
+ ! Query & verify the object timestamp settings
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
CALL VerifyLogical("H5Pget_obj_track_times1",track_times,.FALSE.,total_error)
@@ -538,11 +538,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
-! /* Query the object information for each group */
+! Query the object information for each group
! if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
! if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR
-!!$ /* Sanity check object information for each group */
+!!$ Sanity check object information for each group
!!$ if(oinfo.atime != 0) TEST_ERROR
!!$ if(oinfo.mtime != 0) TEST_ERROR
!!$ if(oinfo.ctime != 0) TEST_ERROR
@@ -556,40 +556,40 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR
!!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR
- ! /* Close the property lists */
+ ! Close the property lists
CALL H5Pclose_f(gcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
CALL H5Pclose_f(gcpl_id2, error)
CALL check("H5Pclose_f", error, total_error)
- ! /* Close the groups */
+ ! Close the groups
CALL H5Gclose_f(group_id, error)
CALL check("H5Gclose_f", error, total_error)
CALL H5Gclose_f(group_id2, error)
CALL check("H5Gclose_f", error, total_error)
- !/* Close the file */
+ ! Close the file
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
- !/* Re-open the file */
+ ! Re-open the file
CALL h5fopen_f(FileName, H5F_ACC_RDONLY_F, file_id, error, H5P_DEFAULT_F)
CALL check("h5fopen_f",error,total_error)
- !/* Open groups */
+ ! Open groups
CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_1, group_id, error) ! with no optional param.
CALL check("H5Gopen_f", error, total_error)
CALL H5Gopen_f(file_id, TIMESTAMP_GROUP_2, group_id2, error, H5P_DEFAULT_F) ! with optional param.
CALL check("H5Gopen_f", error, total_error)
- ! /* Retrieve the new groups' creation properties */
+ ! Retrieve the new groups' creation properties
CALL H5Gget_create_plist_f(group_id, gcpl_id, error)
CALL check("H5Gget_create_plist", error, total_error)
CALL H5Gget_create_plist_f(group_id2, gcpl_id2, error)
CALL check("H5Gget_create_plist", error, total_error)
- ! /* Query & verify the object timestamp settings */
+ ! Query & verify the object timestamp settings
CALL H5Pget_obj_track_times_f(gcpl_id, track_times, error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
@@ -598,11 +598,11 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_obj_track_times_f", error, total_error)
CALL VerifyLogical("H5Pget_obj_track_times2",track_times,.TRUE.,total_error)
!!$
-!!$ /* Query the object information for each group */
+!!$ Query the object information for each group
!!$ if(H5Oget_info(group_id, &oinfo) < 0) TEST_ERROR
!!$ if(H5Oget_info(group_id2, &oinfo2) < 0) TEST_ERROR
!!$
-!!$ /* Sanity check object information for each group */
+!!$ Sanity check object information for each group
!!$ if(oinfo.atime != 0) TEST_ERROR
!!$ if(oinfo.mtime != 0) TEST_ERROR
!!$ if(oinfo.ctime != 0) TEST_ERROR
@@ -616,19 +616,19 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(oinfo.hdr.space.total >= oinfo2.hdr.space.total) TEST_ERROR
!!$ if(oinfo.hdr.space.meta >= oinfo2.hdr.space.meta) TEST_ERROR
- ! /* Close the property lists */
+ ! Close the property lists
CALL H5Pclose_f(gcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
CALL H5Pclose_f(gcpl_id2, error)
CALL check("H5Pclose_f", error, total_error)
- ! /* Close the groups */
+ ! Close the groups
CALL H5Gclose_f(group_id, error)
CALL check("H5Gclose_f", error, total_error)
CALL H5Gclose_f(group_id2, error)
CALL check("H5Gclose_f", error, total_error)
- !/* Close the file */
+ ! Close the file
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
@@ -637,7 +637,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
END SUBROUTINE timestamps
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: mklinks
! *
! * Purpose: Build a file with assorted links.
@@ -649,7 +649,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE mklinks(fapl, total_error)
@@ -680,29 +680,29 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! WRITE(*,*) "link creation (w/new group format)"
- ! /* Create a file */
+ ! Create a file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file, error, H5P_DEFAULT_F, fapl)
CALL check("mklinks.h5fcreate_f",error,total_error)
CALL h5screate_simple_f(arank, adims2, scalar, error)
CALL check("mklinks.h5screate_simple_f",error,total_error)
- !/* Create a group */
+ ! Create a group
CALL H5Gcreate_f(file, "grp1", grp, error)
CALL check("H5Gcreate_f", error, total_error)
CALL H5Gclose_f(grp, error)
CALL check("h5gclose_f",error,total_error)
- !/* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(file, "d1", H5T_NATIVE_INTEGER, scalar, d1, error)
CALL check("h5dcreate_f",error,total_error)
CALL h5dclose_f(d1, error)
CALL check("h5dclose_f",error,total_error)
- !/* Create a hard link */
+ ! Create a hard link
CALL H5Lcreate_hard_f(file, "d1", INT(H5L_SAME_LOC_F,HID_T), "grp1/hard", error)
CALL check("H5Lcreate_hard_f", error, total_error)
- !/* Create a symbolic link */
+ ! Create a symbolic link
CALL H5Lcreate_soft_f("/d1", file, "grp1/soft",error)
CALL check("H5Lcreate_soft_f", error, total_error)
@@ -718,14 +718,14 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! should be '/d1' + NULL character = 4
CALL VERIFY("H5Lget_info_by_idx_f", INT(val_size), 4, total_error)
- !/* Create a symbolic link to something that doesn't exist */
+ ! Create a symbolic link to something that doesn't exist
CALL H5Lcreate_soft_f("foobar", file, "grp1/dangle",error)
- !/* Create a recursive symbolic link */
+ ! Create a recursive symbolic link
CALL H5Lcreate_soft_f("/grp1/recursive", file, "/grp1/recursive",error)
- !/* Close */
+ ! Close
CALL h5sclose_f(scalar, error)
CALL check("h5sclose_f",error,total_error)
CALL h5fclose_f(file, error)
@@ -733,7 +733,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
END SUBROUTINE mklinks
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: test_move_preserves
! *
! * Purpose: Tests that moving and renaming links preserves their
@@ -745,7 +745,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE test_move_preserves(fapl_id, total_error)
@@ -758,20 +758,20 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
INTEGER(HID_T):: file_id
INTEGER(HID_T):: group_id
- INTEGER(HID_T):: fcpl_id ! /* Group creation property list ID */
+ INTEGER(HID_T):: fcpl_id ! Group creation property list ID
INTEGER(HID_T):: lcpl_id
!H5O_info_t oinfo;
!H5L_info_t linfo;
INTEGER :: old_cset
INTEGER :: old_corder
!H5T_cset_t old_cset;
- !int64_t old_corder; /* Creation order value of link */
+ !int64_t old_corder; Creation order value of link
!time_t old_modification_time;
!time_t curr_time;
- !unsigned crt_order_flags; /* Status of creation order info for GCPL */
+ !unsigned crt_order_flags; Status of creation order info for GCPL
!char filename[1024];
- INTEGER :: crt_order_flags ! /* Status of creation order info for GCPL */
+ INTEGER :: crt_order_flags ! Status of creation order info for GCPL
CHARACTER(LEN=12), PARAMETER :: filename = 'TestLinks.h5'
INTEGER :: cset ! Indicates the character set used for the link’s name.
@@ -789,9 +789,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! WRITE(*,*) "moving and copying links preserves their properties (w/new group format)"
- !/* Create a file creation property list with creation order stored for links
+ ! Create a file creation property list with creation order stored for links
! * in the root group
- ! */
+ !
CALL H5Pcreate_f(H5P_FILE_CREATE_F, fcpl_id, error)
CALL check("H5Pcreate_f",error, total_error)
@@ -807,26 +807,26 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
CALL check("H5Pget_link_creation_order_f",error, total_error)
CALL VERIFY("H5Pget_link_creation_order_f",crt_order_flags, H5P_CRT_ORDER_TRACKED_F, total_error)
- !/* Create file */
- !/* (with creation order tracking for the root group) */
+ ! Create file
+ ! (with creation order tracking for the root group)
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, file_id, error, fcpl_id, fapl_id)
CALL check("h5fcreate_f",error,total_error)
- !/* Create a link creation property list with the UTF-8 character encoding */
+ ! Create a link creation property list with the UTF-8 character encoding
CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl_id, error)
CALL check("H5Pcreate_f",error, total_error)
CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error)
CALL check("H5Pset_char_encoding_f",error, total_error)
- !/* Create a group with that lcpl */
+ ! Create a group with that lcpl
CALL H5Gcreate_f(file_id, "group", group_id, error,lcpl_id=lcpl_id, gcpl_id=H5P_DEFAULT_F, gapl_id=H5P_DEFAULT_F)
CALL check("H5Gcreate_f", error, total_error)
CALL H5Gclose_f(group_id, error)
CALL check("H5Gclose_f", error, total_error)
- ! /* Get the group's link's information */
+ ! Get the group's link's information
CALL H5Lget_info_f(file_id, "group", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error, H5P_DEFAULT_F)
@@ -842,18 +842,18 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! old_modification_time = oinfo.mtime;
-! /* If this test happens too quickly, the times will all be the same. Make sure the time changes. */
+! If this test happens too quickly, the times will all be the same. Make sure the time changes.
! curr_time = HDtime(NULL);
! while(HDtime(NULL) <= curr_time)
! ;
-! /* Close the file and reopen it */
+! Close the file and reopen it
CALL H5Fclose_f(file_id, error)
CALL check("H5Fclose_f", error, total_error)
!!$ if((file_id = H5Fopen(filename, H5F_ACC_RDWR, fapl_id)) < 0) TEST_ERROR
!!$
-!!$ /* Get the link's character set & modification time . They should be unchanged */
+!!$ Get the link's character set & modification time . They should be unchanged
!!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -861,7 +861,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder_valid != TRUE) TEST_ERROR
!!$ if(old_corder != linfo.corder) TEST_ERROR
!!$
-!!$ /* Create a new link to the group. It should have a different creation order value but the same modification time */
+!!$ Create a new link to the group. It should have a different creation order value but the same modification time
!!$ if(H5Lcreate_hard(file_id, "group", file_id, "group2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -871,10 +871,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder != 1) TEST_ERROR
!!$ if(linfo.cset != H5T_CSET_ASCII) TEST_ERROR
!!$
-!!$ /* Copy the first link to a UTF-8 name.
+!!$ Copy the first link to a UTF-8 name.
!!$ * Its creation order value should be different, but modification time
!!$ * should not change.
-!!$ */
+!!$
!!$ if(H5Lcopy(file_id, "group", file_id, "group_copied", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group_copied", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -882,10 +882,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder_valid != TRUE) TEST_ERROR
!!$ if(linfo.corder != 2) TEST_ERROR
!!$
-!!$ /* Check that its character encoding is UTF-8 */
+!!$ Check that its character encoding is UTF-8
!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR
!!$
-!!$ /* Move the link with the default property list. */
+!!$ Move the link with the default property list.
!!$ if(H5Lmove(file_id, "group_copied", file_id, "group_copied2", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group_copied2", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -893,10 +893,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder_valid != TRUE) TEST_ERROR
!!$ if(linfo.corder != 3) TEST_ERROR
!!$
-!!$ /* Check that its character encoding is not UTF-8 */
+!!$ Check that its character encoding is not UTF-8
!!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR
!!$
-!!$ /* Check that the original link is unchanged */
+!!$ Check that the original link is unchanged
!!$ if(H5Oget_info_by_name(file_id, "group", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
!!$ if(H5Lget_info(file_id, "group", &linfo, H5P_DEFAULT) < 0) TEST_ERROR
@@ -904,9 +904,9 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(old_corder != linfo.corder) TEST_ERROR
!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR
!!$
-!!$ /* Move the first link to a UTF-8 name.
+!!$ Move the first link to a UTF-8 name.
!!$ * Its creation order value will change, but modification time should not
-!!$ * change. */
+!!$ * change.
!!$ if(H5Lmove(file_id, "group", file_id, "group_moved", lcpl_id, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group_moved", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -914,10 +914,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder_valid != TRUE) TEST_ERROR
!!$ if(linfo.corder != 4) TEST_ERROR
!!$
-!!$ /* Check that its character encoding is UTF-8 */
+!!$ Check that its character encoding is UTF-8
!!$ if(linfo.cset != H5T_CSET_UTF8) TEST_ERROR
!!$
-!!$ /* Move the link again using the default property list. */
+!!$ Move the link again using the default property list.
!!$ if(H5Lmove(file_id, "group_moved", file_id, "group_moved_again", H5P_DEFAULT, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(H5Oget_info_by_name(file_id, "group_moved_again", &oinfo, H5P_DEFAULT) < 0) TEST_ERROR
!!$ if(old_modification_time != oinfo.mtime) TEST_ERROR
@@ -925,10 +925,10 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
!!$ if(linfo.corder_valid != TRUE) TEST_ERROR
!!$ if(linfo.corder != 5) TEST_ERROR
!!$
-!!$ /* Check that its character encoding is not UTF-8 */
+!!$ Check that its character encoding is not UTF-8
!!$ if(linfo.cset == H5T_CSET_UTF8) TEST_ERROR
- ! /* Close open IDs */
+ ! Close open IDs
CALL H5Pclose_f(fcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
CALL H5Pclose_f(lcpl_id, error)
@@ -938,7 +938,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
END SUBROUTINE test_move_preserves
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: lifecycle
! *
! * Purpose: Test that adding links to a group follow proper "lifecycle"
@@ -953,7 +953,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error)
! * Monday, October 17, 2005
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE lifecycle(cleanup, fapl2, total_error)
@@ -967,14 +967,14 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
INTEGER, PARAMETER :: NAME_BUF_SIZE =7
- INTEGER(HID_T) :: fid !/* File ID */
- INTEGER(HID_T) :: gid !/* Group ID */
- INTEGER(HID_T) :: gcpl !/* Group creation property list ID */
- INTEGER(size_t) :: lheap_size_hint !/* Local heap size hint */
- INTEGER :: max_compact !/* Maximum # of links to store in group compactly */
- INTEGER :: min_dense !/* Minimum # of links to store in group "densely" */
- INTEGER :: est_num_entries !/* Estimated # of entries in group */
- INTEGER :: est_name_len !/* Estimated length of entry name */
+ INTEGER(HID_T) :: fid ! File ID
+ INTEGER(HID_T) :: gid ! Group ID
+ INTEGER(HID_T) :: gcpl ! Group creation property list ID
+ INTEGER(size_t) :: lheap_size_hint ! Local heap size hint
+ INTEGER :: max_compact ! Maximum # of links to store in group compactly
+ INTEGER :: min_dense ! Minimum # of links to store in group "densely"
+ INTEGER :: est_num_entries ! Estimated # of entries in group
+ INTEGER :: est_name_len ! Estimated length of entry name
CHARACTER(LEN=NAME_BUF_SIZE) :: filename = 'fixx.h5'
INTEGER(SIZE_T) :: LIFECYCLE_LOCAL_HEAP_SIZE_HINT = 256
INTEGER :: LIFECYCLE_MAX_COMPACT = 4
@@ -991,29 +991,29 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
! WRITE(*,*) 'group lifecycle'
- ! /* Create file */
+ ! Create file
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl2)
CALL check("H5Fcreate_f",error,total_error)
- !/* Close file */
+ ! Close file
CALL H5Fclose_f(fid,error)
CALL check("H5Fclose_f",error,total_error)
- ! /* Get size of file as empty */
+ ! Get size of file as empty
! if((empty_size = h5_get_file_size(filename)) < 0) TEST_ERROR
- ! /* Re-open file */
+ ! Re-open file
CALL H5Fopen_f(filename, H5F_ACC_RDWR_F, fid, error,access_prp=fapl2)
CALL check("H5Fopen_f",error,total_error)
- ! /* Set up group creation property list */
+ ! Set up group creation property list
CALL H5Pcreate_f(H5P_GROUP_CREATE_F,gcpl,error)
CALL check("H5Pcreate_f",error,total_error)
- ! /* Query default group creation property settings */
+ ! Query default group creation property settings
CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error)
CALL check("H5Pget_local_heap_size_hint_f",error,total_error)
CALL verify("H5Pget_local_heap_size_hint_f", INT(lheap_size_hint),0,total_error)
@@ -1030,7 +1030,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL verify("H5Pget_est_link_info_f", est_name_len, H5G_CRT_GINFO_EST_NAME_LEN,total_error)
- !/* Set GCPL parameters */
+ ! Set GCPL parameters
CALL H5Pset_local_heap_size_hint_f(gcpl, LIFECYCLE_LOCAL_HEAP_SIZE_HINT, error)
CALL check("H5Pset_local_heap_size_hint_f", error, total_error)
@@ -1039,12 +1039,12 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Pset_est_link_info_f(gcpl, LIFECYCLE_EST_NUM_ENTRIES, LIFECYCLE_EST_NAME_LEN, error)
CALL check("H5Pset_est_link_info_f", error, total_error)
- ! /* Create group for testing lifecycle */
+ ! Create group for testing lifecycle
CALL H5Gcreate_f(fid, LIFECYCLE_TOP_GROUP, gid, error, gcpl_id=gcpl)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Query group creation property settings */
+ ! Query group creation property settings
CALL H5Pget_local_heap_size_hint_f(gcpl, lheap_size_hint, error)
CALL check("H5Pget_local_heap_size_hint_f",error,total_error)
@@ -1062,20 +1062,20 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
- !/* Close top group */
+ ! Close top group
CALL H5Gclose_f(gid, error)
CALL check("H5Gclose_f", error, total_error)
- !/* Unlink top group */
+ ! Unlink top group
CALL H5Ldelete_f(fid, LIFECYCLE_TOP_GROUP, error)
CALL check("H5Ldelete_f", error, total_error)
- ! /* Close GCPL */
+ ! Close GCPL
CALL H5Pclose_f(gcpl, error)
CALL check("H5Pclose_f", error, total_error)
- ! /* Close file */
+ ! Close file
CALL H5Fclose_f(fid,error)
CALL check("H5Fclose_f",error,total_error)
@@ -1084,7 +1084,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
END SUBROUTINE lifecycle
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: cklinks
! *
! * Purpose: Open the file created in the first step and check that the
@@ -1100,7 +1100,7 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
! * Modifications: Modified original C code
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE cklinks(fapl, total_error)
@@ -1124,25 +1124,25 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
LOGICAL :: Lexists
- ! /* Open the file */
+ ! Open the file
CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, error,access_prp=fapl)
CALL check("H5Fopen_f",error,total_error)
- ! /* Hard link */
+ ! Hard link
!!$ IF(H5Oget_info_by_name(file, "d1", &oinfo1, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
!!$ IF(H5Oget_info_by_name(file, "grp1/hard", &oinfo2, H5P_DEFAULT) < 0) FAIL_STACK_ERROR
!!$ IF(H5O_TYPE_DATASET != oinfo2.type) {
!!$ H5_FAILED();
!!$ printf(" %d: Unexpected object type should have been a dataset\n", __LINE__);
!!$ TEST_ERROR
-!!$ } /* end if */
+!!$ } end if
!!$ if(H5F_addr_ne(oinfo1.addr, oinfo2.addr)) {
!!$ H5_FAILED();
!!$ puts(" Hard link test failed. Link seems not to point to the ");
!!$ puts(" expected file location.");
!!$ TEST_ERROR
-!!$ } /* end if */
+!!$ } end if
CALL H5Lexists_f(file,"d1",Lexists, error)
@@ -1151,14 +1151,14 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error)
CALL H5Lexists_f(file,"grp1/hard",Lexists, error)
CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
- ! /* Cleanup */
+ ! Cleanup
CALL H5Fclose_f(file,error)
CALL check("H5Fclose_f",error,total_error)
END SUBROUTINE cklinks
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: delete_by_idx
! *
! * Purpose: Create a group with creation order indices and test deleting
@@ -1173,7 +1173,7 @@ END SUBROUTINE cklinks
! * March 3, 2008
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
USE HDF5 ! This module contains all necessary modules
@@ -1183,18 +1183,18 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
INTEGER, INTENT(INOUT) :: total_error
INTEGER(HID_T), INTENT(IN) :: fapl
- INTEGER(HID_T) :: file_id ! /* File ID */
- INTEGER(HID_T) :: group_id ! /* Group ID */
- INTEGER(HID_T) :: gcpl_id ! /* Group creation property list ID */
+ INTEGER(HID_T) :: file_id ! File ID
+ 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 */
+ 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" */
+ ! 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 */
- CHARACTER(LEN=8) :: filename = 'file0.h5' ! /* File name */
+ CHARACTER(LEN=7) :: objname ! Object name
+ CHARACTER(LEN=8) :: filename = 'file0.h5' ! File name
CHARACTER(LEN=12), PARAMETER :: CORDER_GROUP_NAME = "corder_group"
LOGICAL :: f_corder_valid ! Indicates whether the creation order data is valid for this attribute
@@ -1204,11 +1204,11 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
INTEGER :: link_type
INTEGER(HADDR_T) :: address
- INTEGER :: u ! /* Local index variable */
+ INTEGER :: u ! Local index variable
INTEGER :: Input1, i
INTEGER(HID_T) :: group_id2
INTEGER(HID_T) :: grp
- INTEGER :: iorder ! /* Order within in the index */
+ INTEGER :: iorder ! Order within in the index
CHARACTER(LEN=2) :: chr2
INTEGER :: error
INTEGER :: id_type
@@ -1226,13 +1226,13 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
fix_filename2(i:i) = " "
ENDDO
- ! /* Loop over operating on different indices on link fields */
+ ! 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 */
+ ! Loop over operating in different orders
DO iorder = H5_ITER_INC_F, H5_ITER_DEC_F
- ! /* Loop over using index for creation order value */
+ ! Loop over using index for creation order value
DO i = 1, 2
- ! /* Print appropriate test message */
+ ! Print appropriate test message
!!$ IF(idx_type == H5_INDEX_CRT_ORDER_F)THEN
!!$ IF(iorder == H5_ITER_INC_F)THEN
!!$ IF(use_index(i))THEN
@@ -1263,15 +1263,15 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!!$ ENDIF
!!$ ENDIF
- ! /* Create file */
+ ! Create file
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp=fapl)
CALL check("delete_by_idx.H5Fcreate_f", error, total_error)
- ! /* Create group creation property list */
+ ! Create group creation property list
CALL H5Pcreate_f(H5P_GROUP_CREATE_F, gcpl_id, error )
CALL check("delete_by_idx.H5Pcreate_f", error, total_error)
- ! /* Set creation order tracking & indexing on group */
+ ! Set creation order tracking & indexing on group
IF(use_index(i))THEN
Input1 = H5P_CRT_ORDER_INDEXED_F
ELSE
@@ -1281,54 +1281,54 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
CALL H5Pset_link_creation_order_f(gcpl_id, IOR(H5P_CRT_ORDER_TRACKED_F, Input1), error)
CALL check("delete_by_idx.H5Pset_link_creation_order_f", error, total_error)
- ! /* Create group with creation order tracking on */
+ ! Create group with creation order tracking on
CALL H5Gcreate_f(file_id, CORDER_GROUP_NAME, group_id, error, gcpl_id=gcpl_id)
CALL check("delete_by_idx.H5Gcreate_f", error, total_error)
- ! /* Query the group creation properties */
+ ! Query the group creation properties
CALL H5Pget_link_phase_change_f(gcpl_id, max_compact, min_dense, error)
CALL check("delete_by_idx.H5Pget_link_phase_change_f", error, total_error)
- ! /* Delete links from one end */
+ ! Delete links from one end
- ! /* Check for deletion on empty group */
+ ! Check for deletion on empty group
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error)
CALL VERIFY("delete_by_idx.H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
- ! /* Create several links, up to limit of compact form */
+ ! Create several links, up to limit of compact form
DO u = 0, max_compact-1
- ! /* Make name for link */
+ ! Make name for link
WRITE(chr2,'(I2.2)') u
objname = 'fill '//chr2
- ! /* Create hard link, with group object */
+ ! Create hard link, with group object
CALL H5Gcreate_f(group_id, objname, group_id2, error)
CALL check("delete_by_idx.H5Gcreate_f", error, total_error)
CALL H5Gclose_f(group_id2, error)
CALL check("delete_by_idx.H5Gclose_f", error, total_error)
- ! /* Verify link information for new link */
+ ! Verify link information for new link
CALL link_info_by_idx_check(group_id, objname, u, &
.TRUE., use_index(i), total_error)
ENDDO
- ! /* Verify state of group (compact) */
+ ! Verify state of group (compact)
! IF(H5G_has_links_test(group_id, NULL) != TRUE) TEST_ERROR
- ! /* Check for out of bound deletion */
+ ! Check for out of bound deletion
htmp =9
!EP CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(u,HSIZE_T), error)
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, htmp, error)
CALL VERIFY("H5Ldelete_by_idx_f", error, -1, total_error) ! test should fail (error = -1)
- ! /* Delete links from compact group */
+ ! Delete links from compact group
DO u = 0, (max_compact - 1) -1
- ! /* Delete first link in appropriate order */
+ ! Delete first link in appropriate order
CALL H5Ldelete_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), error)
CALL check("H5Ldelete_by_idx_f", error, total_error)
- ! /* Verify the link information for first link in appropriate order */
+ ! Verify the link information for first link in appropriate order
! HDmemset(&linfo, 0, sizeof(linfo));
CALL H5Lget_info_by_idx_f(group_id, ".", idx_type, iorder, INT(0,HSIZE_T), &
@@ -1358,7 +1358,7 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
- ! /* Verify the name for first link in appropriate order */
+ ! Verify the name for first link in appropriate order
! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
!!$ size_tmp = 20
!!$ CALL H5Lget_name_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), size_tmp, tmpname, error)
@@ -1374,15 +1374,15 @@ SUBROUTINE delete_by_idx(cleanup, fapl, total_error)
!!$ CALL verifyString("delete_by_idx.H5Lget_name_by_idx_f", objname, tmpname, total_error)
ENDDO
- ! /* Close the group */
+ ! Close the group
CALL H5Gclose_f(group_id, error)
CALL check("delete_by_idx.H5Gclose_f", error, total_error)
- !/* Close the group creation property list */
+ ! Close the group creation property list
CALL H5Pclose_f(gcpl_id, error)
CALL check("delete_by_idx.H5Gclose_f", error, total_error)
- !/* Close the file */
+ ! Close the file
CALL H5Fclose_f(file_id, error)
CALL check("delete_by_idx.H5Gclose_f", error, total_error)
@@ -1398,7 +1398,7 @@ END SUBROUTINE delete_by_idx
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: link_info_by_idx_check
! *
! * Purpose: Support routine for link_info_by_idx, to verify the link
@@ -1414,7 +1414,7 @@ END SUBROUTINE delete_by_idx
! * Tuesday, November 7, 2006
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
hard_link, use_index, total_error)
@@ -1436,35 +1436,35 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
INTEGER(HADDR_T) :: address
INTEGER(SIZE_T) :: val_size ! Indicates the size, in the number of characters, of the attribute
- CHARACTER(LEN=7) :: tmpname !/* Temporary link name */
- CHARACTER(LEN=3) :: tmpname_small !/* to small temporary link name */
- CHARACTER(LEN=10) :: tmpname_big !/* to big temporary link name */
+ CHARACTER(LEN=7) :: tmpname ! Temporary link name
+ CHARACTER(LEN=3) :: tmpname_small ! to small temporary link name
+ CHARACTER(LEN=10) :: tmpname_big ! to big temporary link name
- CHARACTER(LEN=7) :: valname !/* Link value name */
+ CHARACTER(LEN=7) :: valname ! Link value name
CHARACTER(LEN=2) :: chr2
INTEGER(SIZE_T) :: size_tmp
INTEGER :: error
- ! /* Make link value for increasing/native order queries */
+ ! Make link value for increasing/native order queries
WRITE(chr2,'(I2.2)') n
valname = 'valn.'//chr2
- ! /* Verify the link information for first link, in increasing creation order */
+ ! Verify the link information for first link, in increasing creation order
! HDmemset(&linfo, 0, sizeof(linfo));
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(0,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
CALL VERIFY("H5Lget_info_by_idx_f", corder, 0, total_error)
- ! /* Verify the link information for new link, in increasing creation order */
+ ! Verify the link information for new link, in increasing creation order
! HDmemset(&linfo, 0, sizeof(linfo));
CALL H5Lget_info_by_idx_f(group_id, ".", H5_INDEX_CRT_ORDER_F, H5_ITER_INC_F, INT(n,HSIZE_T), &
link_type, f_corder_valid, corder, cset, address, val_size, error)
CALL check("H5Lget_info_by_idx_f", error, total_error)
CALL VERIFY("H5Lget_info_by_idx_f", corder, n, total_error)
- ! /* Verify value for new soft link, in increasing creation order */
+ ! Verify value for new soft link, in increasing creation order
!!$ IF(hard_link)THEN
!!$ ! HDmemset(tmpval, 0, (size_t)NAME_BUF_SIZE);
!!$
@@ -1474,7 +1474,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
!!$! IF(HDstrcmp(valname, tmpval)) TEST_ERROR
!!$ ENDIF
- ! /* Verify the name for new link, in increasing creation order */
+ ! Verify the name for new link, in increasing creation order
! HDmemset(tmpname, 0, (size_t)NAME_BUF_SIZE);
! The actual size of tmpname should be 7
@@ -1503,7 +1503,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
END SUBROUTINE link_info_by_idx_check
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: test_lcpl
! *
! * Purpose: Tests Link Creation Property Lists
@@ -1518,7 +1518,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE test_lcpl(cleanup, fapl, total_error)
@@ -1565,35 +1565,35 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
! WRITE(*,*) "link creation property lists (w/new group format)"
- !/* Actually, intermediate group creation is tested elsewhere (tmisc).
- ! * Here we only need to test the character encoding property */
+ ! Actually, intermediate group creation is tested elsewhere (tmisc).
+ ! * Here we only need to test the character encoding property
- !/* Create file */
+ ! Create file
! h5_fixname(FILENAME[0], fapl, filename, sizeof filename);
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl)
CALL check("H5Fcreate_f", error, total_error)
- ! /* Create and link a group with the default LCPL */
+ ! Create and link a group with the default LCPL
CALL H5Gcreate_f(file_id, "/group", group_id, error)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Check that its character encoding is the default */
+ ! Check that its character encoding is the default
CALL H5Lget_info_f(file_id, "group", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error, H5P_DEFAULT_F)
-!/* File-wide default character encoding can not yet be set via the file
-! * creation property list and is always ASCII. */
+! File-wide default character encoding can not yet be set via the file
+! * creation property list and is always ASCII.
!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h --
CALL VERIFY("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
- ! /* Create and commit a datatype with the default LCPL */
+ ! Create and commit a datatype with the default LCPL
CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error)
CALL check("h5tcopy_f",error,total_error)
CALL h5tcommit_f(file_id, "/type", type_id, error)
@@ -1602,19 +1602,19 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL check("h5tclose_f", error, total_error)
- ! /* Check that its character encoding is the default */
+ ! Check that its character encoding is the default
CALL H5Lget_info_f(file_id, "type", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
CALL check("h5tclose_f", error, total_error)
-!/* File-wide default character encoding can not yet be set via the file
-! * creation property list and is always ASCII. */
+! File-wide default character encoding can not yet be set via the file
+! * creation property list and is always ASCII.
!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h --
CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
- !/* Create a dataspace */
+ ! Create a dataspace
CALL h5screate_simple_f(2, dims, space_id, error)
CALL check("h5screate_simple_f",error,total_error)
CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error)
@@ -1624,7 +1624,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL h5pcreate_f(H5P_DATASET_CREATE_F, crp_list, error)
CALL h5pset_chunk_f(crp_list, 2, dims, error)
- ! /* Create a dataset using the default LCPL */
+ ! Create a dataset using the default LCPL
CALL h5dcreate_f(file_id, "/dataset", H5T_NATIVE_INTEGER, space_id, dset_id, error, crp_list)
CALL check("h5dcreate_f", error, total_error)
@@ -1636,10 +1636,10 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL H5Dopen_f(file_id, "/dataset", dset_id, error)
CALL check("h5dopen_f", error, total_error)
- ! /* Extend the dataset */
+ ! Extend the dataset
CALL H5Dset_extent_f(dset_id, extend_dim, error)
CALL check("H5Dset_extent_f", error, total_error)
- ! /* Verify the dataspaces */
+ ! Verify the dataspaces
!
!Get dataset's dataspace handle.
!
@@ -1658,37 +1658,37 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL VERIFY("H5Sget_simple_extent_dims", tmp1, tmp2, total_error)
ENDDO
- ! /* close data set */
+ ! close data set
CALL h5dclose_f(dset_id, error)
CALL check("h5dclose_f", error, total_error)
- ! /* Check that its character encoding is the default */
+ ! Check that its character encoding is the default
CALL H5Lget_info_f(file_id, "dataset", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
CALL check("H5Lget_info_f", error, total_error)
-!/* File-wide default character encoding can not yet be set via the file
-! * creation property list and is always ASCII. */
+! File-wide default character encoding can not yet be set via the file
+! * creation property list and is always ASCII.
!#define H5F_DEFAULT_CSET H5T_CSET_ASCII -- FROM H5Fprivate.h --
CALL verify("h5tclose_f",cset, H5T_CSET_ASCII_F,total_error)
- !/* Create a link creation property list with the UTF-8 character encoding */
+ ! Create a link creation property list with the UTF-8 character encoding
CALL H5Pcreate_f(H5P_LINK_CREATE_F,lcpl_id,error)
CALL check("h5Pcreate_f",error,total_error)
CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error)
CALL check("H5Pset_char_encoding_f",error, total_error)
- ! /* Create and link a group with the new LCPL */
+ ! Create and link a group with the new LCPL
CALL H5Gcreate_f(file_id, "/group2", group_id, error,lcpl_id=lcpl_id)
CALL check("H5Gcreate_f", error, total_error)
CALL H5Gclose_f(group_id, error)
CALL check("H5Gclose_f", error, total_error)
- !/* Check that its character encoding is UTF-8 */
+ ! Check that its character encoding is UTF-8
CALL H5Lget_info_f(file_id, "group2", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
@@ -1696,7 +1696,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error)
- ! /* Create and commit a datatype with the new LCPL */
+ ! Create and commit a datatype with the new LCPL
CALL h5tcopy_f(H5T_NATIVE_INTEGER, type_id, error)
CALL check("h5tcopy_f",error,total_error)
@@ -1706,14 +1706,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL check("h5tclose_f", error, total_error)
- !/* Check that its character encoding is UTF-8 */
+ ! Check that its character encoding is UTF-8
CALL H5Lget_info_f(file_id, "type2", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
CALL check("H5Lget_info_f", error, total_error)
CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error)
- ! /* Create a dataset using the new LCPL */
+ ! Create a dataset using the new LCPL
CALL h5dcreate_f(file_id, "/dataset2", H5T_NATIVE_INTEGER, space_id, dset_id, error,lcpl_id=lcpl_id)
CALL check("h5dcreate_f", error, total_error)
@@ -1724,14 +1724,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL check("H5Pget_char_encoding_f", error, total_error)
CALL VERIFY("H5Pget_char_encoding_f", encoding, H5T_CSET_UTF8_F, total_error)
- ! /* Check that its character encoding is UTF-8 */
+ ! Check that its character encoding is UTF-8
CALL H5Lget_info_f(file_id, "dataset2", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
CALL check("H5Lget_info_f", error, total_error)
CALL verify("H5Lget_info_f2",cset, H5T_CSET_UTF8_F,total_error)
- ! /* Create a new link to the dataset with a different character encoding. */
+ ! Create a new link to the dataset with a different character encoding.
CALL H5Pclose_f(lcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
@@ -1746,14 +1746,14 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL check("H5Lexists",error, total_error)
CALL verifylogical("H5Lexists", Lexists,.TRUE.,total_error)
- ! /* Check that its character encoding is ASCII */
+ ! Check that its character encoding is ASCII
CALL H5Lget_info_f(file_id, "/dataset2_link", &
cset, corder, f_corder_valid, link_type, address, val_size, &
error)
CALL check("H5Lget_info_f", error, total_error)
CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
- ! /* Check that the first link's encoding hasn't changed */
+ ! Check that the first link's encoding hasn't changed
CALL H5Lget_info_f(file_id, "/dataset2", &
cset, corder, f_corder_valid, link_type, address, val_size, &
@@ -1762,8 +1762,8 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f3",cset, H5T_CSET_UTF8_F,total_error)
- !/* Make sure that LCPLs work properly for other API calls: */
- !/* H5Lcreate_soft */
+ ! Make sure that LCPLs work properly for other API calls:
+ ! H5Lcreate_soft
CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error)
CALL check("H5Pset_char_encoding_f",error, total_error)
@@ -1777,7 +1777,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error)
- ! /* H5Lmove */
+ ! H5Lmove
CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_ASCII_F, error)
CALL check("H5Pset_char_encoding_f",error, total_error)
@@ -1791,7 +1791,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f",cset, H5T_CSET_ASCII_F,total_error)
- ! /* H5Lcopy */
+ ! H5Lcopy
CALL H5Pset_char_encoding_f(lcpl_id, H5T_CSET_UTF8_F, error)
CALL check("H5Pset_char_encoding_f",error, total_error)
@@ -1805,7 +1805,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error)
- ! /* H5Lcreate_external */
+ ! H5Lcreate_external
CALL H5Lcreate_external_f("filename", "path", file_id, "extlink", error, lcpl_id)
CALL check("H5Lcreate_external_f", error, total_error)
@@ -1817,7 +1817,7 @@ SUBROUTINE link_info_by_idx_check(group_id, linkname, n, &
CALL verify("H5Lget_info_f",cset, H5T_CSET_UTF8_F,total_error)
- ! /* Close open IDs */
+ ! Close open IDs
CALL H5Pclose_f(lcpl_id, error)
CALL check("H5Pclose_f", error, total_error)
@@ -1849,22 +1849,22 @@ SUBROUTINE objcopy(fapl, total_error)
flag = H5O_COPY_SHALLOW_HIERARCHY_F
-!/* Copy the file access property list */
+! Copy the file access property list
CALL H5Pcopy_f(fapl, fapl2, error)
CALL check("H5Pcopy_f", error, total_error)
-!/* Set the "use the latest version of the format" bounds for creating objects in the file */
+! Set the "use the latest version of the format" bounds for creating objects in the file
CALL H5Pset_libver_bounds_f(fapl2, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
- ! /* create property to pass copy options */
+ ! create property to pass copy options
CALL h5pcreate_f(H5P_OBJECT_COPY_F, pid, error)
CALL check("h5pcreate_f",error, total_error)
- ! /* set options for object copy */
+ ! set options for object copy
CALL H5Pset_copy_object_f(pid, flag, error)
CALL check("H5Pset_copy_object_f",error, total_error)
- ! /* Verify object copy flags */
+ ! Verify object copy flags
CALL H5Pget_copy_object_f(pid, cpy_flags, error)
CALL check("H5Pget_copy_object_f",error, total_error)
CALL VERIFY("H5Pget_copy_object_f", cpy_flags, flag, total_error)
@@ -1878,7 +1878,7 @@ SUBROUTINE objcopy(fapl, total_error)
END SUBROUTINE objcopy
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: lapl_nlinks
! *
! * Purpose: Check that the maximum number of soft links can be adjusted
@@ -1894,7 +1894,7 @@ END SUBROUTINE objcopy
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE lapl_nlinks( fapl, total_error)
@@ -1907,30 +1907,30 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
INTEGER :: error
- INTEGER(HID_T) :: fid = (-1) !/* File ID */
- INTEGER(HID_T) :: gid = (-1), gid2 = (-1) !/* Group IDs */
- INTEGER(HID_T) :: plist = (-1) ! /* lapl ID */
- INTEGER(HID_T) :: tid = (-1) ! /* Other IDs */
- INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! /* Other property lists */
+ INTEGER(HID_T) :: fid = (-1) ! File ID
+ INTEGER(HID_T) :: gid = (-1), gid2 = (-1) ! Group IDs
+ INTEGER(HID_T) :: plist = (-1) ! lapl ID
+ INTEGER(HID_T) :: tid = (-1) ! Other IDs
+ INTEGER(HID_T) :: gapl = (-1), dapl = (-1), tapl = (-1) ! Other property lists
- CHARACTER(LEN=7) :: objname ! /* Object name */
- INTEGER(size_t) :: name_len ! /* Length of object name */
+ CHARACTER(LEN=7) :: objname ! Object name
+ INTEGER(size_t) :: name_len ! Length of object name
CHARACTER(LEN=12) :: filename = 'TestLinks.h5'
- INTEGER(size_t) :: nlinks ! /* nlinks for H5Pset_nlinks */
+ INTEGER(size_t) :: nlinks ! nlinks for H5Pset_nlinks
INTEGER(size_t) :: buf_size = 7
! WRITE(*,*) "adjusting nlinks with LAPL (w/new group format)"
- ! /* Create file */
+ ! Create file
CALL h5fcreate_f(FileName, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl)
CALL check(" lapl_nlinks.h5fcreate_f",error,total_error)
- ! /* Create group with short name in file (used as target for links) */
+ ! Create group with short name in file (used as target for links)
CALL H5Gcreate_f(fid, "final", gid, error)
CALL check(" lapl_nlinks.H5Gcreate_f", error, total_error)
- !/* Create chain of soft links to existing object (limited) */
+ ! Create chain of soft links to existing object (limited)
CALL H5Lcreate_soft_f("final", fid, "soft1", error)
CALL H5Lcreate_soft_f("soft1", fid, "soft2", error)
CALL H5Lcreate_soft_f("soft2", fid, "soft3", error)
@@ -1949,98 +1949,98 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL H5Lcreate_soft_f("soft15", fid, "soft16", error)
CALL H5Lcreate_soft_f("soft16", fid, "soft17", error)
- !/* Close objects */
+ ! Close objects
CALL H5Gclose_f(gid, error)
CALL check("h5gclose_f",error,total_error)
CALL h5fclose_f(fid, error)
CALL check("h5fclose_f",error,total_error)
- !/* Open file */
+ ! Open file
CALL h5fopen_f(FileName, H5F_ACC_RDWR_F, fid, error, fapl)
CALL check("h5open_f",error,total_error)
- !/* Create LAPL with higher-than-usual nlinks value */
- !/* Create a non-default lapl with udata set to point to the first group */
+ ! Create LAPL with higher-than-usual nlinks value
+ ! Create a non-default lapl with udata set to point to the first group
CALL H5Pcreate_f(H5P_LINK_ACCESS_F,plist,error)
CALL check("h5Pcreate_f",error,total_error)
nlinks = 20
CALL H5Pset_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f",error,total_error)
- !/* Ensure that nlinks was set successfully */
+ ! Ensure that nlinks was set successfully
nlinks = 0
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f",error,total_error)
CALL VERIFY("H5Pset_nlinks_f",INT(nlinks), 20, total_error)
- !/* Open object through what is normally too many soft links using
- ! * new property list */
+ ! Open object through what is normally too many soft links using
+ ! * new property list
CALL H5Oopen_f(fid,"soft17",gid,error,plist)
CALL check("H5Oopen_f",error,total_error)
- !/* Check name */
+ ! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft17", total_error)
- !/* Create group using soft link */
+ ! Create group using soft link
CALL H5Gcreate_f(gid, "new_soft", gid2, error)
CALL check("H5Gcreate_f", error, total_error)
- ! /* Close groups */
+ ! Close groups
CALL H5Gclose_f(gid2, error)
CALL check("H5Gclose_f", error, total_error)
CALL H5Gclose_f(gid, error)
CALL check("H5Gclose_f", error, total_error)
- !/* Set nlinks to a smaller number */
+ ! Set nlinks to a smaller number
nlinks = 4
CALL H5Pset_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f", error, total_error)
- !/* Ensure that nlinks was set successfully */
+ ! Ensure that nlinks was set successfully
nlinks = 0
CALL H5Pget_nlinks_f(plist, nlinks, error)
CALL check("H5Pget_nlinks_f",error,total_error)
CALL VERIFY("H5Pget_nlinks_f", INT(nlinks), 4, total_error)
- ! /* Try opening through what is now too many soft links */
+ ! Try opening through what is now too many soft links
CALL H5Oopen_f(fid,"soft5",gid,error,plist)
CALL VERIFY("H5Oopen_f", error, -1, total_error) ! should fail
- ! /* Open object through lesser soft link */
+ ! Open object through lesser soft link
CALL H5Oopen_f(fid,"soft4",gid,error,plist)
CALL check("H5Oopen_",error,total_error)
- ! /* Check name */
+ ! Check name
CALL h5iget_name_f(gid, objname, buf_size, name_len, error)
CALL check("h5iget_name_f",error,total_error)
CALL VerifyString("h5iget_name_f", TRIM(objname),"/soft4", total_error)
- ! /* Test other functions that should use a LAPL */
+ ! Test other functions that should use a LAPL
nlinks = 20
CALL H5Pset_nlinks_f(plist, nlinks, error)
CALL check("H5Pset_nlinks_f", error, total_error)
- !/* Try copying and moving when both src and dst contain many soft links
+ ! Try copying and moving when both src and dst contain many soft links
! * using a non-default LAPL
- ! */
+ !
CALL H5Lcopy_f(fid, "soft17", fid, "soft17/newer_soft", error, H5P_DEFAULT_F, plist)
CALL check("H5Lcopy_f",error,total_error)
CALL H5Lmove_f(fid, "soft17/newer_soft", fid, "soft17/newest_soft", error, lapl_id=plist)
CALL check("H5Lmove_f",error, total_error)
- ! /* H5Olink */
+ ! H5Olink
CALL H5Olink_f(gid, fid, "soft17/link_to_group", error, H5P_DEFAULT_F, plist)
CALL check("H5Olink_f", error, total_error)
- ! /* H5Lcreate_hard and H5Lcreate_soft */
+ ! H5Lcreate_hard and H5Lcreate_soft
CALL H5Lcreate_hard_f(fid, "soft17", fid, "soft17/link2_to_group", error, H5P_DEFAULT_F, plist)
CALL check("H5Lcreate_hard_f", error, total_error)
@@ -2048,27 +2048,27 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL H5Lcreate_soft_f("/soft4", fid, "soft17/soft_link",error, H5P_DEFAULT_F, plist)
CALL check("H5Lcreate_soft_f", error, total_error)
- ! /* H5Ldelete */
+ ! H5Ldelete
CALL h5ldelete_f(fid, "soft17/soft_link", error, plist)
CALL check("H5Ldelete_f", error, total_error)
-!!$ /* H5Lget_val and H5Lget_info */
+!!$ H5Lget_val and H5Lget_info
!!$ if(H5Lget_val(fid, "soft17", NULL, (size_t)0, plist) < 0) TEST_ERROR
!!$ if(H5Lget_info(fid, "soft17", NULL, plist) < 0) TEST_ERROR
!!$
- ! /* H5Lcreate_external and H5Lcreate_ud */
+ ! H5Lcreate_external and H5Lcreate_ud
CALL H5Lcreate_external_f("filename", "path", fid, "soft17/extlink", error, H5P_DEFAULT_F, plist)
CALL check("H5Lcreate_external_f", error, total_error)
!!$ if(H5Lregister(UD_rereg_class) < 0) TEST_ERROR
!!$ if(H5Lcreate_ud(fid, "soft17/udlink", UD_HARD_TYPE, NULL, (size_t)0, H5P_DEFAULT, plist) < 0) TEST_ERROR
!!$
- ! /* Close plist */
+ ! Close plist
CALL h5pclose_f(plist, error)
CALL check("h5pclose_f", error, total_error)
- ! /* Create a datatype and dataset as targets inside the group */
+ ! Create a datatype and dataset as targets inside the group
CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
CALL check("h5tcopy_f",error,total_error)
CALL h5tcommit_f(gid, "datatype", tid, error)
@@ -2083,12 +2083,12 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
!!$ if((did = H5Dcreate2(gid, "dataset", H5T_NATIVE_INT, sid, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT)) < 0) TEST_ERROR
!!$ if(H5Dclose(did) < 0) TEST_ERROR
!!$
- !/* Close group */
+ ! Close group
CALL h5gclose_f(gid, error)
CALL check("h5gclose_f",error,total_error)
!!$
-!!$ /* Try to open the objects using too many symlinks with default *APLs */
+!!$ Try to open the objects using too many symlinks with default *APLs
!!$ H5E_BEGIN_TRY {
!!$ if((gid = H5Gopen2(fid, "soft17", H5P_DEFAULT)) >= 0)
!!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.")
@@ -2098,7 +2098,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
!!$ FAIL_PUTS_ERROR(" Should have failed for too many nested links.")
!!$ } H5E_END_TRY
!!$
- ! /* Create property lists with nlinks set */
+ ! Create property lists with nlinks set
CALL H5Pcreate_f(H5P_GROUP_ACCESS_F,gapl,error)
CALL check("h5Pcreate_f",error,total_error)
@@ -2116,9 +2116,9 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
CALL H5Pset_nlinks_f(dapl, nlinks, error)
CALL check("H5Pset_nlinks_f", error, total_error)
- !/* We should now be able to use these property lists to open each kind
+ ! We should now be able to use these property lists to open each kind
! * of object.
- ! */
+ !
CALL H5Gopen_f(fid, "soft17", gid, error, gapl)
CALL check("H5Gopen_f",error,total_error)
@@ -2128,7 +2128,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
!!$ if((did = H5Dopen2(fid, "soft17/dataset", dapl)) < 0) TEST_ERROR
- ! /* Close objects */
+ ! Close objects
CALL h5gclose_f(gid, error)
CALL check("h5gclose_f",error,total_error)
@@ -2137,7 +2137,7 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
!!$ if(H5Dclose(did) < 0) TEST_ERROR
!!$
- ! /* Close plists */
+ ! Close plists
CALL h5pclose_f(gapl, error)
CALL check("h5pclose_f", error, total_error)
@@ -2146,11 +2146,11 @@ SUBROUTINE lapl_nlinks( fapl, total_error)
!!$ if(H5Pclose(dapl) < 0) TEST_ERROR
!!$
-!!$ /* Unregister UD hard link class */
+!!$ Unregister UD hard link class
!!$ if(H5Lunregister(UD_HARD_TYPE) < 0) TEST_ERROR
!!$
- ! /* Close file */
+ ! Close file
CALL H5Fclose_f(fid, error)
CALL check("H5Fclose_f", error, total_error)
diff --git a/fortran/test/tH5MISC_1_8.f90 b/fortran/test/tH5MISC_1_8.f90
index efc350e..9b33f8a 100644
--- a/fortran/test/tH5MISC_1_8.f90
+++ b/fortran/test/tH5MISC_1_8.f90
@@ -84,12 +84,12 @@ SUBROUTINE dtransform(cleanup, total_error)
END SUBROUTINE dtransform
-!/****************************************************************
+!***************************************************************
!**
!** test_genprop_basic_class(): Test basic generic property list code.
!** Tests creating new generic classes.
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_genprop_basic_class(cleanup, total_error)
@@ -100,18 +100,18 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(HID_T) :: cid1 !/* Generic Property class ID */
- INTEGER(HID_T) :: cid2 !/* Generic Property class ID */
+ INTEGER(HID_T) :: cid1 ! Generic Property class ID
+ INTEGER(HID_T) :: cid2 ! Generic Property class ID
CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
- CHARACTER(LEN=7) :: name ! /* Name of class */
- CHARACTER(LEN=10) :: name_big ! /* Name of class bigger buffer */
- CHARACTER(LEN=4) :: name_small ! /* Name of class smaller buffer*/
+ CHARACTER(LEN=7) :: name ! Name of class
+ CHARACTER(LEN=10) :: name_big ! Name of class bigger buffer
+ CHARACTER(LEN=4) :: name_small ! Name of class smaller buffer
INTEGER :: error
INTEGER :: size
LOGICAL :: flag
- !/* Output message about test being performed */
+ ! Output message about test being performed
!WRITE(*,*) "Testing Basic Generic Property List Class Creation Functionality"
@@ -121,11 +121,11 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
CALL H5Pget_class_name_f(cid1, name, size, error)
CALL VERIFY("H5Pget_class_name", error, -1, error)
- ! /* Create a new generic class, derived from the root of the class hierarchy */
+ ! Create a new generic class, derived from the root of the class hierarchy
CALL H5Pcreate_class_f(H5P_ROOT_F, CLASS1_NAME, cid1, error)
CALL check("H5Pcreate_class", error, total_error)
- ! /* Check class name */
+ ! Check class name
CALL H5Pget_class_name_f(cid1, name, size, error)
CALL check("H5Pget_class_name", error, total_error)
CALL VERIFY("H5Pget_class_name", size,7,error)
@@ -135,7 +135,7 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
total_error = total_error + 1
ENDIF
- ! /* Check class name smaller buffer*/
+ ! Check class name smaller buffer
CALL H5Pget_class_name_f(cid1, name_small, size, error)
CALL check("H5Pget_class_name", error, total_error)
CALL VERIFY("H5Pget_class_name", size,7,error)
@@ -145,7 +145,7 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
total_error = total_error + 1
ENDIF
- ! /* Check class name bigger buffer*/
+ ! Check class name bigger buffer
CALL H5Pget_class_name_f(cid1, name_big, size, error)
CALL check("H5Pget_class_name", error, total_error)
CALL VERIFY("H5Pget_class_name", size,7,error)
@@ -155,27 +155,27 @@ SUBROUTINE test_genprop_basic_class(cleanup, total_error)
total_error = total_error + 1
ENDIF
- ! /* Check class parent */
+ ! Check class parent
CALL H5Pget_class_parent_f(cid1, cid2, error)
CALL check("H5Pget_class_parent_f", error, total_error)
- ! /* Verify class parent correct */
+ ! Verify class parent correct
CALL H5Pequal_f(cid2, H5P_ROOT_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
- ! /* Make certain false postives aren't being returned */
+ ! Make certain false postives aren't being returned
CALL H5Pequal_f(cid2, H5P_FILE_CREATE_F, flag, error)
CALL check("H5Pequal_f", error, total_error)
CALL verifylogical("H5Pequal_f", flag, .FALSE., total_error)
- !/* Close parent class */
+ ! Close parent class
CALL H5Pclose_class_f(cid2, error)
CALL check("H5Pclose_class_f", error, total_error)
- !/* Close class */
+ ! Close class
CALL H5Pclose_class_f(cid1, error)
CALL check("H5Pclose_class_f", error, total_error)
@@ -183,11 +183,11 @@ END SUBROUTINE test_genprop_basic_class
SUBROUTINE test_h5s_encode(cleanup, total_error)
-!/****************************************************************
+!***************************************************************
!**
!** test_h5s_encode(): Test H5S (dataspace) encoding and decoding.
!**
-!****************************************************************/
+!***************************************************************
USE HDF5 ! This module contains all necessary modules
USE TH5_MISC
@@ -195,16 +195,16 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: sid1, sid3! /* Dataspace ID */
+ INTEGER(hid_t) :: sid1, sid3! Dataspace ID
INTEGER(hid_t) :: decoded_sid1, decoded_sid3
- INTEGER :: rank !/* LOGICAL rank of dataspace */
+ INTEGER :: rank ! LOGICAL rank of dataspace
INTEGER(size_t) :: sbuf_size=0, scalar_size=0
! Make sure the size is large
CHARACTER(LEN=288) :: sbuf
CHARACTER(LEN=288) :: scalar_buf
- INTEGER(hsize_t) :: n ! /* Number of dataspace elements */
+ INTEGER(hsize_t) :: n ! Number of dataspace elements
INTEGER(hsize_t), DIMENSION(1:3) :: start = (/0, 0, 0/)
INTEGER(hsize_t), DIMENSION(1:3) :: stride = (/2, 5, 3/)
@@ -221,10 +221,10 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
INTEGER :: SPACE1_RANK = 3
INTEGER :: error
- !/*-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
! * Test encoding and decoding of simple dataspace and hyperslab selection.
! *-------------------------------------------------------------------------
- ! */
+ !
CALL H5Screate_simple_f(SPACE1_RANK, dims1, sid1, error)
CALL check("H5Screate_simple", error, total_error)
@@ -234,14 +234,14 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Encode simple data space in a buffer */
+ ! Encode simple data space in a buffer
! First find the buffer size
CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
CALL check("H5Sencode", error, total_error)
- ! /* Try decoding bogus buffer */
+ ! Try decoding bogus buffer
CALL H5Sdecode_f(sbuf, decoded_sid1, error)
CALL VERIFY("H5Sdecode", error, -1, total_error)
@@ -249,12 +249,12 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
CALL H5Sencode_f(sid1, sbuf, sbuf_size, error)
CALL check("H5Sencode", error, total_error)
- ! /* Decode from the dataspace buffer and return an object handle */
+ ! Decode from the dataspace buffer and return an object handle
CALL H5Sdecode_f(sbuf, decoded_sid1, error)
CALL check("H5Sdecode", error, total_error)
- ! /* Verify the decoded dataspace */
+ ! Verify the decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid1, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), INT(SPACE1_DIM1 * SPACE1_DIM2 * SPACE1_DIM3), &
@@ -269,16 +269,16 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
CALL h5sclose_f(decoded_sid1, error)
CALL check("h5sclose_f", error, total_error)
- ! /*-------------------------------------------------------------------------
+ ! -------------------------------------------------------------------------
! * Test encoding and decoding of scalar dataspace.
! *-------------------------------------------------------------------------
- ! */
- ! /* Create scalar dataspace */
+ !
+ ! Create scalar dataspace
CALL H5Screate_f(H5S_SCALAR_F, sid3, error)
CALL check("H5Screate_f",error, total_error)
- ! /* Encode scalar data space in a buffer */
+ ! Encode scalar data space in a buffer
! First find the buffer size
CALL H5Sencode_f(sid3, scalar_buf, scalar_size, error)
@@ -290,19 +290,19 @@ SUBROUTINE test_h5s_encode(cleanup, total_error)
CALL check("H5Sencode_f", error, total_error)
- ! /* Decode from the dataspace buffer and return an object handle */
+ ! Decode from the dataspace buffer and return an object handle
CALL H5Sdecode_f(scalar_buf, decoded_sid3, error)
CALL check("H5Sdecode_f", error, total_error)
- ! /* Verify extent type */
+ ! Verify extent type
CALL H5Sget_simple_extent_type_f(decoded_sid3, space_type, error)
CALL check("H5Sget_simple_extent_type_f", error, total_error)
CALL VERIFY("H5Sget_simple_extent_type_f", space_type, H5S_SCALAR_F, total_error)
- ! /* Verify decoded dataspace */
+ ! Verify decoded dataspace
CALL h5sget_simple_extent_npoints_f(decoded_sid3, n, error)
CALL check("h5sget_simple_extent_npoints_f", error, total_error)
CALL VERIFY("h5sget_simple_extent_npoints_f", INT(n), 1, total_error)
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index 8672e3c..99d4c22 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -49,11 +49,11 @@ SUBROUTINE test_h5o(cleanup, total_error)
END SUBROUTINE test_h5o
-!/****************************************************************
+!***************************************************************
!**
!** test_h5o_link: Test creating link to object
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_h5o_link(total_error)
@@ -80,10 +80,10 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER, PARAMETER :: TRUE = 1
- LOGICAL :: committed ! /* Whether the named datatype is committed
+ LOGICAL :: committed ! Whether the named datatype is committed
INTEGER :: i, j
- INTEGER :: error ! /* Value returned from API calls
+ INTEGER :: error ! Value returned from API calls
CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT"
CHARACTER(LEN=16) :: NAME_DATATYPE_SIMPLE2="H5T_NATIVE_INT-2"
diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90
index b7003b3..8e014f4 100644
--- a/fortran/test/tH5O_F03.f90
+++ b/fortran/test/tH5O_F03.f90
@@ -116,11 +116,11 @@ END MODULE visit_cb
MODULE TH5O_F03
CONTAINS
-!/****************************************************************
+!***************************************************************
!**
!** test_h5o_refcount(): Test H5O refcounting functions.
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_h5o_refcount(total_error)
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index 945d0a5..34fd0ad 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -43,7 +43,7 @@ MODULE test_genprop_cls_cb1_mod
USE ISO_C_BINDING
IMPLICIT NONE
- TYPE, BIND(C) :: cop_cb_struct_ ! /* Struct for iterations */
+ TYPE, BIND(C) :: cop_cb_struct_ ! Struct for iterations
INTEGER :: count
INTEGER(HID_T) :: id
END TYPE cop_cb_struct_
@@ -73,7 +73,7 @@ MODULE TH5P_F03
CONTAINS
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: test_create
! *
! * Purpose: Tests H5Pset_fill_value_f and H5Pget_fill_value_f
@@ -88,7 +88,7 @@ CONTAINS
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE test_create(total_error)
@@ -116,9 +116,9 @@ SUBROUTINE test_create(total_error)
REAL :: rfill
REAL(KIND=dp) :: dpfill
- !/*
+ !
! * Create a file.
- ! */
+ !
CALL h5fcreate_f(filename,H5F_ACC_TRUNC_F,file,error)
CALL check("h5fcreate_f", error, total_error)
@@ -131,7 +131,7 @@ SUBROUTINE test_create(total_error)
CALL h5pset_chunk_f(dcpl, 5, ch_size, error)
CALL check("h5pset_chunk_f",error, total_error)
- ! /* Create a compound datatype */
+ ! Create a compound datatype
CALL h5tcreate_f(H5T_COMPOUND_F, H5_SIZEOF(fill_ctype), comp_type_id, error)
CALL check("h5tcreate_f", error, total_error)
h5off = H5OFFSETOF(C_LOC(fill_ctype), C_LOC(fill_ctype%a))
@@ -152,7 +152,7 @@ SUBROUTINE test_create(total_error)
CALL H5Pset_fill_time_f(dcpl, H5D_FILL_TIME_ALLOC_F, error)
CALL check("H5Pset_fill_time_f",error, total_error)
- ! /* Compound datatype test */
+ ! Compound datatype test
f_ptr = C_LOC(fill_ctype)
@@ -213,7 +213,7 @@ SUBROUTINE test_create(total_error)
CALL h5fclose_f(file,error)
CALL check("h5fclose_f", error, total_error)
- ! /* Open the file and get the dataset fill value from each dataset */
+ ! Open the file and get the dataset fill value from each dataset
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error)
CALL check("H5Pcreate_f",error, total_error)
@@ -223,7 +223,7 @@ SUBROUTINE test_create(total_error)
CALL h5fopen_f (FILENAME, H5F_ACC_RDONLY_F, file, error, fapl)
CALL check("h5fopen_f", error, total_error)
- !/* Compound datatype test */
+ ! Compound datatype test
CALL h5dopen_f(file, "dset9", dset9, error)
CALL check("h5dopen_f", error, total_error)
@@ -277,14 +277,13 @@ SUBROUTINE test_genprop_class_callback(total_error)
INTEGER, INTENT(INOUT) :: total_error
- INTEGER(hid_t) :: cid1 !/* Generic Property class ID */
- INTEGER(hid_t) :: lid1 !/* Generic Property list ID */
- INTEGER(hid_t) :: lid2 !/* 2nd Generic Property list ID */
- INTEGER(size_t) :: nprops !/* Number of properties in class */
+ INTEGER(hid_t) :: cid1, cid2 ! Generic Property class ID
+ INTEGER(hid_t) :: lid1, lid2 ! Generic Property list ID
+ INTEGER(size_t) :: nprops ! Number of properties in class
TYPE(cop_cb_struct_), TARGET :: crt_cb_struct, cls_cb_struct
-
- CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1"
+ INTEGER :: CLASS1_NAME_SIZE = 7 ! length of class string
+ CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1", CLASS1_NAME_BUF
TYPE(C_FUNPTR) :: f1, f5
TYPE(C_PTR) :: f2, f6
@@ -301,7 +300,8 @@ SUBROUTINE test_genprop_class_callback(total_error)
INTEGER :: PROP3_DEF_VALUE = 10
INTEGER :: PROP4_DEF_VALUE = 10
- INTEGER :: error ! /* Generic RETURN value */
+ INTEGER :: error ! Generic RETURN value
+ LOGICAL :: flag ! for tests
f1 = C_FUNLOC(test_genprop_cls_cb1_f)
f5 = C_FUNLOC(test_genprop_cls_cb1_f)
@@ -309,79 +309,101 @@ SUBROUTINE test_genprop_class_callback(total_error)
f2 = C_LOC(crt_cb_struct)
f6 = C_LOC(cls_cb_struct)
- !/* Create a new generic class, derived from the root of the class hierarchy */
- CALL h5pcreate_class_f(h5p_ROOT_F,CLASS1_NAME, cid1, error, f1, f2, c_null_funptr, c_null_ptr, f5, f6)
+ ! Create a new generic class, derived from the root of the class hierarchy
+ CALL h5pcreate_class_f(h5p_ROOT_F, CLASS1_NAME, cid1, error, f1, f2, c_null_funptr, c_null_ptr, f5, f6)
CALL check("h5pcreate_class_f", error, total_error)
- !/* Insert first property into class (with no callbacks) */
+ ! Insert first property into class (with no callbacks)
CALL h5pregister_f(cid1, PROP1_NAME, PROP1_SIZE, PROP1_DEF_VALUE, error)
CALL check("h5pregister_f", error, total_error)
- !/* Insert second property into class (with no callbacks) */
+ ! Insert second property into class (with no callbacks)
CALL h5pregister_f(cid1, PROP2_NAME, PROP2_SIZE, PROP2_DEF_VALUE, error)
CALL check("h5pregister_f", error, total_error)
- !/* Insert third property into class (with no callbacks) */
+ ! Insert third property into class (with no callbacks)
CALL h5pregister_f(cid1, PROP3_NAME, PROP3_SIZE, PROP3_DEF_VALUE, error)
CALL check("h5pregister_f", error, total_error)
- !/* Insert fourth property into class (with no callbacks) */
+ ! Insert fourth property into class (with no callbacks)
CALL h5pregister_f(cid1, PROP4_NAME, PROP4_SIZE, PROP4_DEF_VALUE, error)
CALL check("h5pregister_f", error, total_error)
- ! /* Check the number of properties in class */
+ ! Check the number of properties in class
CALL h5pget_nprops_f(cid1, nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
- ! /* Initialize class callback structs */
+ ! Initialize class callback structs
crt_cb_struct%count = 0
crt_cb_struct%id = -1
cls_cb_struct%count = 0
cls_cb_struct%id = -1
- !/* Create a property list from the class */
+ ! Create a property list from the class
CALL h5pcreate_f(cid1, lid1, error)
CALL check("h5pcreate_f", error, total_error)
- !/* Verify that the creation callback occurred */
+ ! Get the list's class
+ CALL H5Pget_class_f(lid1, cid2, error)
+ CALL check("H5Pget_class_f", error, total_error)
+
+ ! Check that the list's class is correct
+ CALL H5Pequal_f(cid2, cid1, flag, error)
+ CALL check("H5Pequal_f", error, total_error)
+ CALL verifylogical("H5Pequal_f", flag, .TRUE., total_error)
+
+ ! Check the class name
+ CALL H5Pget_class_name_f(cid2, CLASS1_NAME_BUF, CLASS1_NAME_SIZE, error)
+ CALL check("H5Pget_class_name_f", error, total_error)
+ CALL verifystring("H5Pget_class_name_f", CLASS1_NAME_BUF, CLASS1_NAME, error)
+ IF(error.NE.0)THEN
+ WRITE(*,*) 'Class names do not match! name=',CLASS1_NAME_BUF, 'CLASS1_NAME=',CLASS1_NAME
+ total_error = total_error + 1
+ ENDIF
+
+ ! Close class
+ CALL h5pclose_class_f(cid2, error)
+ CALL check("h5pclose_class_f", error, total_error)
+
+ ! Verify that the creation callback occurred
CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 1, total_error)
CALL VERIFY("h5pcreate_f", INT(crt_cb_struct%id), INT(lid1), total_error)
- ! /* Check the number of properties in list */
+ ! Check the number of properties in list
CALL h5pget_nprops_f(lid1,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
- ! /* Create another property list from the class */
+ ! Create another property list from the class
CALL h5pcreate_f(cid1, lid2, error)
CALL check("h5pcreate_f", error, total_error)
- ! /* Verify that the creation callback occurred */
+ ! Verify that the creation callback occurred
CALL VERIFY("h5pcreate_f", crt_cb_struct%count, 2, total_error)
CALL VERIFY("h5pcreate_f", INT(crt_cb_struct%id), INT(lid2), total_error)
- ! /* Check the number of properties in list */
+ ! Check the number of properties in list
CALL h5pget_nprops_f(lid2,nprops, error)
CALL check("h5pget_nprops_f", error, total_error)
CALL VERIFY("h5pget_nprops_f", INT(nprops), 4, total_error)
- ! /* Close first list */
+ ! Close first list
CALL h5pclose_f(lid1, error);
CALL check("h5pclose_f", error, total_error)
- !/* Verify that the close callback occurred */
+ ! Verify that the close callback occurred
CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 1, total_error)
CALL VERIFY("h5pcreate_f", INT(cls_cb_struct%id), INT(lid1), total_error)
- !/* Close second list */
+ ! Close second list
CALL h5pclose_f(lid2, error);
CALL check("h5pclose_f", error, total_error)
- !/* Verify that the close callback occurred */
+ ! Verify that the close callback occurred
CALL VERIFY("h5pcreate_f", cls_cb_struct%count, 2, total_error)
CALL VERIFY("h5pcreate_f", INT(cls_cb_struct%id), INT(lid2), total_error)
- !/* Close class */
+ ! Close class
CALL h5pclose_class_f(cid1, error)
CALL check("h5pclose_class_f", error, total_error)
diff --git a/fortran/test/tH5Sselect.f90 b/fortran/test/tH5Sselect.f90
index ba68d62..7d07308 100644
--- a/fortran/test/tH5Sselect.f90
+++ b/fortran/test/tH5Sselect.f90
@@ -1027,13 +1027,13 @@ CONTAINS
RETURN
END SUBROUTINE test_basic_select
-!/****************************************************************
+!***************************************************************
!**
!** test_select_point(): Test basic H5S (dataspace) selection code.
!** Tests element selections between dataspaces of various sizes
!** and dimensionalities.
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_select_point(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
@@ -1056,29 +1056,29 @@ SUBROUTINE test_select_point(cleanup, total_error)
INTEGER, PARAMETER :: SPACE2_RANK=2
INTEGER, PARAMETER :: SPACE3_RANK=2
- ! /* Element selection information */
+ ! Element selection information
INTEGER, PARAMETER :: POINT1_NPOINTS=10
- INTEGER(hid_t) ::fid1 ! /* HDF5 File IDs */
- INTEGER(hid_t) ::dataset ! /* Dataset ID */
- INTEGER(hid_t) ::sid1,sid2 ! /* Dataspace ID */
+ INTEGER(hid_t) ::fid1 ! HDF5 File IDs
+ INTEGER(hid_t) ::dataset ! Dataset ID
+ INTEGER(hid_t) ::sid1,sid2 ! Dataspace ID
INTEGER(hsize_t), DIMENSION(1:3) :: dims1 = (/SPACE1_DIM1, SPACE1_DIM2, SPACE1_DIM3/)
INTEGER(hsize_t), DIMENSION(1:2) :: dims2 = (/SPACE2_DIM1, SPACE2_DIM2/)
INTEGER(hsize_t), DIMENSION(1:2) :: dims3 = (/SPACE3_DIM1, SPACE3_DIM2/)
- INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 !/* Coordinates for point selection */
- INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 !/* Coordinates for point selection */
- INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 !/* Coordinates for point selection */
- INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 !/* Coordinates for point selection */
- INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 !/* Coordinates for point selection */
- INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 !/* Coordinates for point selection */
+ INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: coord1 ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(1:SPACE1_RANK,1:POINT1_NPOINTS) :: temp_coord1 ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: coord2 ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(1:SPACE2_RANK,1:POINT1_NPOINTS) :: temp_coord2 ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: coord3 ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(1:SPACE3_RANK,1:POINT1_NPOINTS) :: temp_coord3 ! Coordinates for point selection
INTEGER(hssize_t) :: npoints
-!!$ uint8_t *wbuf, /* buffer to write to disk */
-!!$ *rbuf, /* buffer read from disk */
-!!$ *tbuf; /* temporary buffer pointer */
- INTEGER :: i,j; !/* Counters */
-! struct pnt_iter pi; /* Custom Pointer iterator struct */
- INTEGER :: error !/* Generic return value */
+!!$ uint8_t *wbuf, buffer to write to disk
+!!$ *rbuf, buffer read from disk
+!!$ *tbuf; temporary buffer pointer
+ INTEGER :: i,j; ! Counters
+! struct pnt_iter pi; Custom Pointer iterator struct
+ INTEGER :: error ! Generic return value
CHARACTER(LEN=9) :: filename = 'h5s_hyper'
CHARACTER(LEN=80) :: fix_filename
CHARACTER(LEN=1), DIMENSION(1:SPACE2_DIM1,1:SPACE2_DIM2) :: wbuf
@@ -1091,11 +1091,11 @@ SUBROUTINE test_select_point(cleanup, total_error)
xfer_plist = H5P_DEFAULT_F
! MESSAGE(5, ("Testing Element Selection Functions\n"));
- !/* Allocate write & read buffers */
+ ! Allocate write & read buffers
!!$ wbuf = HDmalloc(sizeof(uint8_t) * SPACE2_DIM1 * SPACE2_DIM2);
!!$ rbuf = HDcalloc(sizeof(uint8_t), (size_t)(SPACE3_DIM1 * SPACE3_DIM2));
!!$
- !/* Initialize WRITE buffer */
+ ! Initialize WRITE buffer
DO i = 1, SPACE2_DIM1
DO j = 1, SPACE2_DIM2
@@ -1107,19 +1107,19 @@ SUBROUTINE test_select_point(cleanup, total_error)
!!$ for(j=0; j<SPACE2_DIM2; j++)
!!$ *tbuf++=(uint8_t)((i*SPACE2_DIM2)+j);
- !/* Create file */
+ ! Create file
CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid1, error)
CALL check("h5fcreate_f", error, total_error)
- !/* Create dataspace for dataset */
+ ! Create dataspace for dataset
CALL h5screate_simple_f(SPACE1_RANK, dims1, sid1, error)
CALL check("h5screate_simple_f", error, total_error)
- !/* Create dataspace for write buffer */
+ ! Create dataspace for write buffer
CALL h5screate_simple_f(SPACE2_RANK, dims2, sid2, error)
CALL check("h5screate_simple_f", error, total_error)
- !/* Select sequence of ten points for disk dataset */
+ ! Select sequence of ten points for disk dataset
coord1(1,1)=1; coord1(2,1)=11; coord1(3,1)= 6;
coord1(1,2)=2; coord1(2,2)= 3; coord1(3,2)= 8;
coord1(1,3)=3; coord1(2,3)= 5; coord1(3,3)=10;
@@ -1134,7 +1134,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sselect_elements_f(sid1, H5S_SELECT_SET_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error)
CALL check("h5sselect_elements_f", error, total_error)
- !/* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid1, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
@@ -1149,7 +1149,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_npoints_f", error, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error)
- !/* Append another sequence of ten points to disk dataset */
+ ! Append another sequence of ten points to disk dataset
coord1(1,1)=1; coord1(2,1)=3; coord1(3,1)= 1;
coord1(1,2)=2; coord1(2,2)=11; coord1(3,2)= 9;
@@ -1165,7 +1165,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sselect_elements_f(sid1, H5S_SELECT_APPEND_F, SPACE1_RANK, INT(POINT1_NPOINTS,size_t), coord1, error)
CALL check("h5sselect_elements_f", error, total_error)
- ! /* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid1, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord1,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
@@ -1180,7 +1180,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_npoints_f", error, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error)
- ! /* Select sequence of ten points for memory dataset */
+ ! Select sequence of ten points for memory dataset
coord2(1,1)=13; coord2(2,1)= 4;
coord2(1,2)=16; coord2(2,2)=14;
coord2(1,3)= 8; coord2(2,3)=26;
@@ -1196,7 +1196,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sselect_elements_f", error, total_error)
- !/* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
@@ -1207,9 +1207,9 @@ SUBROUTINE test_select_point(cleanup, total_error)
ENDDO
!!$
-!!$ /* Save points for later iteration */
-!!$ /* (these are in the second half of the buffer, because we are prepending */
-!!$ /* the next list of points to the beginning of the point selection list) */
+!!$ Save points for later iteration
+!!$ (these are in the second half of the buffer, because we are prepending
+!!$ the next list of points to the beginning of the point selection list)
!!$ HDmemcpy(((char *)pi.coord)+sizeof(coord2),coord2,sizeof(coord2));
!!$
@@ -1217,7 +1217,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_npoints_f", error, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error)
- !/* Append another sequence of ten points to memory dataset */
+ ! Append another sequence of ten points to memory dataset
coord2(1,1)=25; coord2(2,1)= 1;
coord2(1,2)= 3; coord2(2,2)=26;
coord2(1,3)=14; coord2(2,3)=18;
@@ -1233,7 +1233,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sselect_elements_f", error, total_error)
- !/* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord2,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
@@ -1246,26 +1246,26 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_npoints_f", error, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error)
-!!$ /* Save points for later iteration */
+!!$ Save points for later iteration
!!$ HDmemcpy(pi.coord,coord2,sizeof(coord2));
- ! /* Create a dataset */
+ ! Create a dataset
CALL h5dcreate_f(fid1, "Dataset1", H5T_NATIVE_CHARACTER, sid1, dataset, error)
CALL check("h5dcreate_f", error, total_error)
- ! /* Write selection to disk */
+ ! Write selection to disk
CALL h5dwrite_f(dataset, H5T_NATIVE_CHARACTER, wbuf, dims2, error, sid2, sid1, xfer_plist)
CALL check("h5dwrite_f", error, total_error)
- ! /* Close memory dataspace */
+ ! Close memory dataspace
CALL h5sclose_f(sid2, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Create dataspace for reading buffer */
+ ! Create dataspace for reading buffer
CALL h5screate_simple_f(SPACE3_RANK, dims3, sid2, error)
CALL check("h5screate_simple_f", error, total_error)
- ! /* Select sequence of points for read dataset */
+ ! Select sequence of points for read dataset
coord3(1,1)= 1; coord3(2,1)= 3;
coord3(1,2)= 5; coord3(2,2)= 9;
coord3(1,3)=14; coord3(2,3)=14;
@@ -1280,7 +1280,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sselect_elements_f(sid2, H5S_SELECT_SET_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error)
CALL check("h5sselect_elements_f", error, total_error)
- ! /* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid2, INT(0,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
@@ -1292,7 +1292,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL check("h5sget_select_npoints_f", error, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 10, total_error)
- !/* Append another sequence of ten points to disk dataset */
+ ! Append another sequence of ten points to disk dataset
coord3(1,1)=15; coord3(2,1)=26;
coord3(1,2)= 1; coord3(2,2)= 1;
coord3(1,3)=12; coord3(2,3)=12;
@@ -1307,7 +1307,7 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL h5sselect_elements_f(sid2, H5S_SELECT_APPEND_F, SPACE3_RANK, INT(POINT1_NPOINTS,size_t), coord3, error)
CALL check("h5sselect_elements_f", error, total_error)
- ! /* Verify correct elements selected */
+ ! Verify correct elements selected
CALL h5sget_select_elem_pointlist_f(sid2, INT(POINT1_NPOINTS,hsize_t), INT(POINT1_NPOINTS,hsize_t),temp_coord3,error)
CALL check("h5sget_select_elem_pointlist_f", error, total_error)
DO i= 1, POINT1_NPOINTS
@@ -1320,11 +1320,11 @@ SUBROUTINE test_select_point(cleanup, total_error)
CALL verify("h5sget_select_npoints_f", INT(npoints), 20, total_error)
! F2003 feature
-!!$ /* Read selection from disk */
+!!$ Read selection from disk
!!$ ret=H5Dread(dataset,H5T_NATIVE_UCHAR,sid2,sid1,xfer_plist,rbuf);
!!$ CHECK(ret, FAIL, "H5Dread");
!!$
-!!$ /* Check that the values match with a dataset iterator */
+!!$ Check that the values match with a dataset iterator
!!$ pi.buf=wbuf;
!!$ pi.offset=0;
!!$ ret = H5Diterate(rbuf,H5T_NATIVE_UCHAR,sid2,test_select_point_iter1,&pi);
@@ -1332,19 +1332,19 @@ SUBROUTINE test_select_point(cleanup, total_error)
!!$
! F2003 feature
- !/* Close memory dataspace */
+ ! Close memory dataspace
CALL h5sclose_f(sid2, error)
CALL check("h5sclose_f", error, total_error)
- !/* Close disk dataspace */
+ ! Close disk dataspace
CALL h5sclose_f(sid1, error)
CALL check("h5sclose_f", error, total_error)
- !/* Close Dataset */
+ ! Close Dataset
CALL h5dclose_f(dataset, error)
CALL check("h5dclose_f", error, total_error)
- !/* Close file */
+ ! Close file
CALL h5fclose_f(fid1, error)
CALL check("h5fclose_f", error, total_error)
@@ -1354,13 +1354,13 @@ SUBROUTINE test_select_point(cleanup, total_error)
END SUBROUTINE test_select_point
-!/****************************************************************
+!***************************************************************
!**
!** test_select_combine(): Test basic H5S (dataspace) selection code.
!** Tests combining "all" and "none" selections with hyperslab
!** operations.
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_select_combine(total_error)
USE HDF5 ! This module contains all necessary modules
@@ -1373,25 +1373,25 @@ SUBROUTINE test_select_combine(total_error)
INTEGER, PARAMETER :: SPACE7_DIM1 = 10
INTEGER, PARAMETER :: SPACE7_DIM2 = 10
- INTEGER(hid_t) :: base_id ! /* Base dataspace for test */
- INTEGER(hid_t) :: all_id ! /* Dataspace for "all" selection */
- INTEGER(hid_t) :: none_id ! /* Dataspace for "none" selection */
- INTEGER(hid_t) :: space1 ! /* Temporary dataspace #1 */
- INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: start ! /* Hyperslab start */
- INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: stride ! /* Hyperslab stride */
- INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: icount ! /* Hyperslab count */
- INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: iblock ! /* Hyperslab BLOCK */
- INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: dims = (/SPACE7_DIM1,SPACE7_DIM2/) !/* Dimensions of dataspace */
- INTEGER :: sel_type ! /* Selection type */
- INTEGER(hssize_t) :: nblocks !/* Number of hyperslab blocks */
- INTEGER(hsize_t), DIMENSION(1:128,1:2,1:SPACE7_RANK) :: blocks ! /* List of blocks */
+ INTEGER(hid_t) :: base_id ! Base dataspace for test
+ INTEGER(hid_t) :: all_id ! Dataspace for "all" selection
+ INTEGER(hid_t) :: none_id ! Dataspace for "none" selection
+ INTEGER(hid_t) :: space1 ! Temporary dataspace #1
+ INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: start ! Hyperslab start
+ INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: stride ! Hyperslab stride
+ INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: icount ! Hyperslab count
+ INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: iblock ! Hyperslab BLOCK
+ INTEGER(hsize_t), DIMENSION(1:SPACE7_RANK) :: dims = (/SPACE7_DIM1,SPACE7_DIM2/) ! Dimensions of dataspace
+ INTEGER :: sel_type ! Selection type
+ INTEGER(hssize_t) :: nblocks ! Number of hyperslab blocks
+ INTEGER(hsize_t), DIMENSION(1:128,1:2,1:SPACE7_RANK) :: blocks ! List of blocks
INTEGER :: error, area
- !/* Create dataspace for dataset on disk */
+ ! Create dataspace for dataset on disk
CALL h5screate_simple_f(SPACE7_RANK, dims, base_id, error)
CALL check("h5screate_simple_f", error, total_error)
- ! /* Copy base dataspace and set selection to "all" */
+ ! Copy base dataspace and set selection to "all"
CALL h5scopy_f(base_id, all_id, error)
CALL check("h5scopy_f", error, total_error)
@@ -1402,7 +1402,7 @@ SUBROUTINE test_select_combine(total_error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
- !/* Copy base dataspace and set selection to "none" */
+ ! Copy base dataspace and set selection to "none"
CALL h5scopy_f(base_id, none_id, error)
CALL check("h5scopy_f", error, total_error)
@@ -1413,11 +1413,11 @@ SUBROUTINE test_select_combine(total_error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_NONE_F), total_error)
- !/* Copy "all" selection & space */
+ ! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- !/* 'OR' "all" selection with another hyperslab */
+ ! 'OR' "all" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1426,20 +1426,20 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Verify that it's still "all" selection */
+ ! Verify that it's still "all" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT(H5S_SEL_ALL_F), total_error)
- !/* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- !/* Copy "all" selection & space */
+ ! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'AND' "all" selection with another hyperslab */
+ ! 'AND' "all" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1448,36 +1448,36 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Verify that the new selection is the same at the original block */
+ ! Verify that the new selection is the same at the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- !/* Verify that there is only one block */
+ ! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
- !/* Retrieve the block defined */
+ ! Retrieve the block defined
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- !/* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
- !/* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- !/* Copy "all" selection & space */
+ ! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'XOR' "all" selection with another hyperslab */
+ ! 'XOR' "all" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1487,23 +1487,23 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is an inversion of the original block */
+ ! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- ! /* Verify that there are two blocks */
+ ! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
- ! /* Retrieve the block defined */
+ ! Retrieve the block defined
- blocks = -1 ! /* Reset block list */
+ blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- ! /* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
@@ -1521,15 +1521,15 @@ SUBROUTINE test_select_combine(total_error)
area = area + (ABS(INT(blocks(5,1,1)-blocks(7,1,1)))+1)*(ABS(INT(blocks(6,1,1)-blocks(8,1,1)))+1)
CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
- !/* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "all" selection & space */
+ ! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'NOTB' "all" selection with another hyperslab */
+ ! 'NOTB' "all" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1539,22 +1539,22 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is an inversion of the original block */
+ ! Verify that the new selection is an inversion of the original block
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- ! /* Verify that there are two blocks */
+ ! Verify that there are two blocks
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 2, total_error)
- ! /* Retrieve the block defined */
- blocks = -1 ! /* Reset block list */
+ ! Retrieve the block defined
+ blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- ! /* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
! No guarantee is implied as the order in which blocks are listed.
! So this will ONLY work for square domains iblock(1:2) = (/5,5/)
@@ -1574,14 +1574,14 @@ SUBROUTINE test_select_combine(total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", area, 80, total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "all" selection & space */
+ ! Copy "all" selection & space
CALL H5Scopy_f(all_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'NOTA' "all" selection with another hyperslab */
+ ! 'NOTA' "all" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1591,20 +1591,20 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Verify that the new selection is the "none" selection */
+ ! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "none" selection & space */
+ ! Copy "none" selection & space
CALL H5Scopy_f(none_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'OR' "none" selection with another hyperslab */
+ ! 'OR' "none" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1614,37 +1614,37 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is the same as the original hyperslab */
+ ! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- ! /* Verify that there is only one block */
+ ! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
- ! /* Retrieve the block defined */
- blocks = -1 ! /* Reset block list */
+ ! Retrieve the block defined
+ blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- ! /* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "none" selection & space */
+ ! Copy "none" selection & space
CALL H5Scopy_f(none_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'AND' "none" selection with another hyperslab */
+ ! 'AND' "none" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1654,20 +1654,20 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is the "none" selection */
+ ! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "none" selection & space */
+ ! Copy "none" selection & space
CALL H5Scopy_f(none_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'XOR' "none" selection with another hyperslab */
+ ! 'XOR' "none" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1677,36 +1677,36 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is the same as the original hyperslab */
+ ! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- ! /* Verify that there is only one block */
+ ! Verify that there is only one block
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
- ! /* Retrieve the block defined */
- blocks = -1 ! /* Reset block list */
+ ! Retrieve the block defined
+ blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- ! /* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "none" selection & space */
+ ! Copy "none" selection & space
CALL H5Scopy_f(none_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'NOTB' "none" selection with another hyperslab */
+ ! 'NOTB' "none" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1716,20 +1716,20 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is the "none" selection */
+ ! Verify that the new selection is the "none" selection
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_NONE_F), total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Copy "none" selection & space */
+ ! Copy "none" selection & space
CALL H5Scopy_f(none_id, space1, error)
CALL check("h5scopy_f", error, total_error)
- ! /* 'NOTA' "none" selection with another hyperslab */
+ ! 'NOTA' "none" selection with another hyperslab
start(1:2) = 0
stride(1:2) = 1
icount(1:2) = 1
@@ -1738,35 +1738,35 @@ SUBROUTINE test_select_combine(total_error)
icount, error, stride, iblock)
CALL check("h5sselect_hyperslab_f", error, total_error)
- ! /* Verify that the new selection is the same as the original hyperslab */
+ ! Verify that the new selection is the same as the original hyperslab
CALL H5Sget_select_type_f(space1, sel_type, error)
CALL check("H5Sget_select_type_f", error, total_error)
CALL VERIFY("H5Sget_select_type_f", INT(sel_type), INT( H5S_SEL_HYPERSLABS_F), total_error)
- ! /* Verify that there is ONLY one BLOCK */
+ ! Verify that there is ONLY one BLOCK
CALL h5sget_select_hyper_nblocks_f(space1, nblocks, error)
CALL check("h5sget_select_hyper_nblocks_f", error, total_error)
CALL VERIFY("h5sget_select_hyper_nblocks_f", INT(nblocks), 1, total_error)
- ! /* Retrieve the block defined */
+ ! Retrieve the block defined
- blocks = -1 ! /* Reset block list */
+ blocks = -1 ! Reset block list
CALL h5sget_select_hyper_blocklist_f(space1, INT(0, hsize_t), INT(nblocks,hsize_t), blocks, error)
CALL check("h5sget_select_hyper_blocklist_f", error, total_error)
- ! /* Verify that the correct block is defined */
+ ! Verify that the correct block is defined
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(1,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(2,1,1)), 1, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(3,1,1)), 5, total_error)
CALL VERIFY("h5sget_select_hyper_blocklist_f", INT(blocks(4,1,1)), 4, total_error)
- ! /* Close temporary dataspace */
+ ! Close temporary dataspace
CALL h5sclose_f(space1, error)
CALL check("h5sclose_f", error, total_error)
- ! /* Close dataspaces */
+ ! Close dataspaces
CALL h5sclose_f(base_id, error)
CALL check("h5sclose_f", error, total_error)
@@ -1777,12 +1777,12 @@ SUBROUTINE test_select_combine(total_error)
END SUBROUTINE test_select_combine
-!/****************************************************************
+!***************************************************************
!**
!** test_select_bounds(): Tests selection bounds on dataspaces,
!** both with and without offsets.
!**
-!****************************************************************/
+!***************************************************************
SUBROUTINE test_select_bounds(total_error)
USE HDF5 ! This module contains all necessary modules
@@ -1796,24 +1796,24 @@ SUBROUTINE test_select_bounds(total_error)
INTEGER, PARAMETER :: SPACE11_DIM2=50
INTEGER, PARAMETER :: SPACE11_NPOINTS=4
- INTEGER(hid_t) :: sid ! /* Dataspace ID */
+ INTEGER(hid_t) :: sid ! Dataspace ID
INTEGER(hsize_t), DIMENSION(1:SPACE11_RANK) :: dims = (/SPACE11_DIM1, SPACE11_DIM2/) !Dataspace dimensions
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord !/* Coordinates for point selection
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: start ! /* The start of the hyperslab */
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: stride !/* The stride between block starts for the hyperslab */
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: count !/* The number of blocks for the hyperslab */
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: BLOCK !/* The size of each block for the hyperslab */
- INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset !/* Offset amount for selection */
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds !/* The low bounds for the selection */
- INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds !/* The high bounds for the selection */
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK, SPACE11_NPOINTS) :: coord ! Coordinates for point selection
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: start ! The start of the hyperslab
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: stride ! The stride between block starts for the hyperslab
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: count ! The number of blocks for the hyperslab
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: BLOCK ! The size of each block for the hyperslab
+ INTEGER(hssize_t), DIMENSION(SPACE11_RANK) :: offset ! Offset amount for selection
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: low_bounds ! The low bounds for the selection
+ INTEGER(hsize_t), DIMENSION(SPACE11_RANK) :: high_bounds ! The high bounds for the selection
INTEGER :: error
- !/* Create dataspace */
+ ! Create dataspace
CALL h5screate_simple_f(SPACE11_RANK, dims, sid, error)
CALL check("h5screate_simple_f", error, total_error)
- ! /* Get bounds for 'all' selection */
+ ! Get bounds for 'all' selection
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1822,12 +1822,12 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
- !/* Set offset for selection */
+ ! Set offset for selection
offset(1:2) = 1
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- !/* Get bounds for 'all' selection with offset (which should be ignored) */
+ ! Get bounds for 'all' selection with offset (which should be ignored)
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1836,20 +1836,20 @@ SUBROUTINE test_select_bounds(total_error)
CALL verify("h5sget_select_bounds_f", INT(high_bounds(1)), SPACE11_DIM1, total_error)
CALL verify("h5sget_select_bounds_f", INT(high_bounds(2)), SPACE11_DIM2, total_error)
- !/* Reset offset for selection */
+ ! Reset offset for selection
offset(1:2) = 0
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- !/* Set 'none' selection */
+ ! Set 'none' selection
CALL H5Sselect_none_f(sid, error)
CALL check("H5Sselect_none_f", error, total_error)
- !/* Get bounds for 'none' selection, should fail */
+ ! Get bounds for 'none' selection, should fail
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
- !/* Set point selection */
+ ! Set point selection
coord(1,1)= 3; coord(2,1)= 3;
coord(1,2)= 3; coord(2,2)= 46;
@@ -1859,7 +1859,7 @@ SUBROUTINE test_select_bounds(total_error)
CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, SPACE11_RANK, INT(SPACE11_NPOINTS,size_t), coord, error)
CALL check("h5sselect_elements_f", error, total_error)
- !/* Get bounds for point selection */
+ ! Get bounds for point selection
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1868,22 +1868,22 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-4), total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-4), total_error)
- ! /* Set bad offset for selection */
+ ! Set bad offset for selection
offset(1:2) = (/5,-5/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Get bounds for hyperslab selection with negative offset */
+ ! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
- ! /* Set valid offset for selection */
+ ! Set valid offset for selection
offset(1:2) = (/2,-2/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Get bounds for point selection with offset */
+ ! Get bounds for point selection with offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1892,12 +1892,12 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), INT(SPACE11_DIM1-2), total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), INT(SPACE11_DIM2-6), total_error)
- ! /* Reset offset for selection */
+ ! Reset offset for selection
offset(1:2) = 0
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Set "regular" hyperslab selection */
+ ! Set "regular" hyperslab selection
start(1:2) = 2
stride(1:2) = 10
count(1:2) = 4
@@ -1907,7 +1907,7 @@ SUBROUTINE test_select_bounds(total_error)
count, error, stride, block)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Get bounds for hyperslab selection */
+ ! Get bounds for hyperslab selection
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1916,21 +1916,21 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 37, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 37, total_error)
- !/* Set bad offset for selection */
+ ! Set bad offset for selection
offset(1:2) = (/5,-5/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Get bounds for hyperslab selection with negative offset */
+ ! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
- ! /* Set valid offset for selection */
+ ! Set valid offset for selection
offset(1:2) = (/5,-2/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- !/* Get bounds for hyperslab selection with offset */
+ ! Get bounds for hyperslab selection with offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1939,12 +1939,12 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 42, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 35, total_error)
- !/* Reset offset for selection */
+ ! Reset offset for selection
offset(1:2) = 0
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Make "irregular" hyperslab selection */
+ ! Make "irregular" hyperslab selection
start(1:2) = 20
stride(1:2) = 20
count(1:2) = 2
@@ -1954,7 +1954,7 @@ SUBROUTINE test_select_bounds(total_error)
count, error, stride, block)
CALL check("h5sselect_hyperslab_f", error, total_error)
- !/* Get bounds for hyperslab selection */
+ ! Get bounds for hyperslab selection
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1963,21 +1963,21 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 50, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 50, total_error)
- ! /* Set bad offset for selection */
+ ! Set bad offset for selection
offset(1:2) = (/5,-5/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- ! /* Get bounds for hyperslab selection with negative offset */
+ ! Get bounds for hyperslab selection with negative offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL VERIFY("h5sget_select_bounds_f", error, -1, total_error)
- !/* Set valid offset for selection */
+ ! Set valid offset for selection
offset(1:2) = (/5,-2/)
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- !/* Get bounds for hyperslab selection with offset */
+ ! Get bounds for hyperslab selection with offset
CALL h5sget_select_bounds_f(sid, low_bounds, high_bounds, error)
CALL check("h5sget_select_bounds_f", error, total_error)
@@ -1986,12 +1986,12 @@ SUBROUTINE test_select_bounds(total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(1)), 55, total_error)
CALL VERIFY("h5sget_select_bounds_f", INT(high_bounds(2)), 48, total_error)
- !/* Reset offset for selection */
+ ! Reset offset for selection
offset(1:2) = 0
CALL H5Soffset_simple_f(sid, offset, error)
CALL check("H5Soffset_simple_f", error, total_error)
- !/* Close the dataspace */
+ ! Close the dataspace
CALL h5sclose_f(sid, error)
CALL check("h5sclose_f", error, total_error)
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index 8ac91d2..f0efbd3 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -556,13 +556,13 @@ CONTAINS
! * Test encoding and decoding compound datatypes
! *-----------------------------------------------------------------------
!
- ! /* Encode compound type in a buffer */
+ ! Encode compound type in a buffer
! -- First find the buffer size
CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
CALL check("H5Tencode_f", error, total_error)
- ! /* Try decoding bogus buffer */
+ ! Try decoding bogus buffer
CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
CALL VERIFY("H5Tdecode_f", error, -1, total_error)
@@ -570,11 +570,11 @@ CONTAINS
CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
CALL check("H5Tencode_f", error, total_error)
- ! /* Decode from the compound buffer and return an object handle */
+ ! Decode from the compound buffer and return an object handle
CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
CALL check("H5Tdecode_f", error, total_error)
- ! /* Verify that the datatype was copied exactly */
+ ! Verify that the datatype was copied exactly
CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error)
CALL check("H5Tequal_f", error, total_error)
@@ -897,7 +897,7 @@ CONTAINS
CALL H5Tget_native_type_f(dtype, H5T_DIR_ASCEND_F, native_type, error)
CALL check("H5Tget_native_type_f",error, total_error)
- !/* Verify the datatype retrieved and converted */
+ ! Verify the datatype retrieved and converted
CALL H5Tget_order_f(native_type, order1, error)
CALL check("H5Tget_order_f",error, total_error)
CALL H5Tget_order_f(H5T_NATIVE_INTEGER, order2, error)
@@ -952,7 +952,7 @@ CONTAINS
RETURN
END SUBROUTINE enumtest
-!/*-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
! * Function: test_derived_flt
! *
! * Purpose: Tests user-define and query functions of floating-point types.
@@ -968,7 +968,7 @@ CONTAINS
! * Modifications:
! *
! *-------------------------------------------------------------------------
-! */
+!
SUBROUTINE test_derived_flt(cleanup, total_error)
@@ -990,7 +990,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
INTEGER :: error
- !/* Create File */
+ ! Create File
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
IF (error .NE. 0) THEN
WRITE(*,*) "Cannot modify filename"
@@ -1009,7 +1009,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL h5tcopy_f(H5T_IEEE_F32LE, tid2, error)
CALL check("h5tcopy_f",error,total_error)
- !/*------------------------------------------------------------------------
+ !------------------------------------------------------------------------
! * 1st floating-point type
! * size=7 byte, precision=42 bits, offset=3 bits, mantissa size=31 bits,
! * mantissa position=3, exponent size=10 bits, exponent position=34,
@@ -1026,7 +1026,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
! * bigger than original size but can be decreased. There should be no
! * holes among the significant bits. Exponent bias usually is set
! * 2^(n-1)-1, where n is the exponent size.
- ! *-----------------------------------------------------------------------*/
+ ! *-----------------------------------------------------------------------
CALL H5Tset_fields_f(tid1, INT(44,size_t), INT(34,size_t), INT(10,size_t), &
INT(3,size_t), INT(31,size_t), error)
@@ -1079,7 +1079,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL check("H5Tget_ebias_f", error, total_error)
CALL VERIFY("H5Tget_ebias_f", INT(ebias1), 511, total_error)
- !/*--------------------------------------------------------------------------
+ !--------------------------------------------------------------------------
! * 2nd floating-point type
! * size=3 byte, precision=24 bits, offset=0 bits, mantissa size=16 bits,
! * mantissa position=0, exponent size=7 bits, exponent position=16, exponent
@@ -1087,7 +1087,7 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
! *
! * 2 1 0
! * SEEEEEEE MMMMMMMM MMMMMMMM
- ! *--------------------------------------------------------------------------*/
+ ! *--------------------------------------------------------------------------
CALL H5Tset_fields_f(tid2, INT(23,size_t), INT(16,size_t), INT(7,size_t), &
INT(0,size_t), INT(16,size_t), error)
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index e019d0f..32531b0 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -34,12 +34,12 @@
! *** H 5 T T E S T S
! *****************************************
-!/****************************************************************
+!***************************************************************
!**
!** test_array_compound_atomic(): Test basic array datatype code.
!** Tests 1-D array of compound datatypes (with no array fields)
!**
-!****************************************************************/
+!***************************************************************
!
MODULE TH5T_F03
generated by cgit v0.12 at 2024-11-02 04:09:31 (GMT)