diff options
Diffstat (limited to 'fortran/test/tH5A_1_8.f90')
| -rw-r--r-- | fortran/test/tH5A_1_8.f90 | 688 |
1 files changed, 344 insertions, 344 deletions
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 |