mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-04-12 17:31:09 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r26479] Fix for: HDFFV-9162

Browse Source 
h5pget_class_f should return hid_t for classtype

Also removed all left over C comment artifacts /* and */ in the Fortran comments.

Tested: h5committest
This commit is contained in:
Scot Breitenfeld 2015-03-19 12:11:47 -05:00
parent c2c3294c21
commit 8f8cbb6225
14 changed files with 963 additions and 961 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
fortran/src/H5Pf.c
View File

@ -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;

31
fortran/src/H5Pff.f90
View File

@ -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

2
fortran/src/H5f90proto.h
View File

@ -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 );

6
fortran/test/fortranlib_test_1_8.f90
View File

@ -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(*,*) ' ============================================ '

688
fortran/test/tH5A_1_8.f90
View File

File diff suppressed because it is too large Load Diff

8
fortran/test/tH5E_F03.f90
View File

@ -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

620
fortran/test/tH5G_1_8.f90
View File

File diff suppressed because it is too large Load Diff

70
fortran/test/tH5MISC_1_8.f90
View File

@ -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)

8
fortran/test/tH5O.f90
View File

@ -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"

4
fortran/test/tH5O_F03.f90
View File

@ -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)

92
fortran/test/tH5P_F03.f90
View File

@ -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)

340
fortran/test/tH5Sselect.f90
View File

@ -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)

24
fortran/test/tH5T.f90
View File

@ -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)

4
fortran/test/tH5T_F03.f90
View File

@ -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