summaryrefslogtreecommitdiffstats
path: root/fortran/src/H5Sff.F90
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2016-02-08 14:01:29 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2016-02-08 14:01:29 (GMT)
commitc418bc964d20d4603eaa830051bfab8ebed0f55c (patch)
tree95c56a32f100fa7e8b4d3cce210a655f9b25b795 /fortran/src/H5Sff.F90
parent48bebcc39ef565796356c159d16f09bfb0efba4d (diff)
downloadhdf5-c418bc964d20d4603eaa830051bfab8ebed0f55c.zip
hdf5-c418bc964d20d4603eaa830051bfab8ebed0f55c.tar.gz
hdf5-c418bc964d20d4603eaa830051bfab8ebed0f55c.tar.bz2
[svn-r29062] HDFFV-9564: Implement VDS Fortran wrappers.
Tested: h5committest.new
Diffstat (limited to 'fortran/src/H5Sff.F90')
-rw-r--r--fortran/src/H5Sff.F90118
1 files changed, 116 insertions, 2 deletions
diff --git a/fortran/src/H5Sff.F90 b/fortran/src/H5Sff.F90
index fd4226c..e9b9b73 100644
--- a/fortran/src/H5Sff.F90
+++ b/fortran/src/H5Sff.F90
@@ -4,7 +4,7 @@
! MODULE H5S
!
! FILE
-! fortran/src/H5Sff.f90
+! fortran/src/H5Sff.F90
!
! PURPOSE
! This file contains Fortran interfaces for H5S functions.
@@ -41,7 +41,7 @@
!*****
MODULE H5S
- USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR
+ USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR, C_INT
USE H5GLOBAL
CONTAINS
@@ -1751,4 +1751,118 @@ CONTAINS
END SUBROUTINE h5sextent_equal_f
+!
+!****s* H5S/h5sget_regular_hyperslab_f
+!
+! NAME
+! h5sget_regular_hyperslab_f
+!
+! PURPOSE
+! Retrieves a regular hyperslab selection.
+!
+! INPUTS
+! space_id - The identifier of the dataspace.
+! OUTPUTS
+! start - Offset of the start of the regular hyperslab.
+! stride - Stride of the regular hyperslab.
+! count - Number of blocks in the regular hyperslab.
+! block - Size of a block in the regular hyperslab.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! January, 28 2016
+! SOURCE
+ SUBROUTINE h5sget_regular_hyperslab_f(space_id, start, stride, count, block, hdferr)
+
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: space_id
+ INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: start
+ INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: stride
+ INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: count
+ INTEGER(HSIZE_T), INTENT(OUT), DIMENSION(*), TARGET :: block
+ INTEGER, INTENT(OUT) :: hdferr
+!*****
+ TYPE(C_PTR) :: start_c, stride_c, count_c, block_c
+ INTEGER(C_INT) :: n
+
+ INTERFACE
+ INTEGER FUNCTION h5sget_regular_hyperslab(space_id, start, stride, count, block) BIND(C,NAME='H5Sget_regular_hyperslab')
+ IMPORT :: HID_T, C_PTR
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN), VALUE :: space_id
+ TYPE(C_PTR), VALUE :: start, stride, count, block
+ END FUNCTION h5sget_regular_hyperslab
+ END INTERFACE
+
+ hdferr = 0
+
+ start_c = C_LOC(start(1))
+ stride_c = C_LOC(stride(1))
+ count_c = C_LOC(count(1))
+ block_c = C_LOC(block(1))
+
+ IF(INT(h5sget_regular_hyperslab(space_id, start_c, stride_c, count_c, block_c)).LT.0) hdferr = -1
+
+ ! Reverse the C arrays description values of the hyperslab because
+ ! the hyperslab was for a C stored hyperslab
+
+ CALL H5Sget_simple_extent_ndims_f(space_id,n,hdferr)
+ IF(hdferr.LT.0.OR.n.EQ.0)THEN
+ hdferr=-1
+ ELSE
+ start(1:n) = start(n:1:-1)
+ stride(1:n) = stride(n:1:-1)
+ count(1:n) = count(n:1:-1)
+ block(1:n) = block(n:1:-1)
+ ENDIF
+
+ END SUBROUTINE h5sget_regular_hyperslab_f
+
+!****s* H5S/h5sis_regular_hyperslab_f
+!
+! NAME
+! h5sis_regular_hyperslab_f
+!
+! PURPOSE
+! Retrieves a regular hyperslab selection.
+!
+! INPUTS
+! space_id - The identifier of the dataspace.
+! OUTPUTS
+! IsRegular - TRUE or FALSE for hyperslab selection if successful.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! January, 28 2016
+! SOURCE
+ SUBROUTINE h5sis_regular_hyperslab_f(space_id, IsRegular, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: space_id
+ LOGICAL :: IsRegular
+ INTEGER, INTENT(OUT) :: hdferr
+!*****
+ INTEGER(C_INT) :: status
+
+ INTERFACE
+ INTEGER(C_INT) FUNCTION H5Sis_regular_hyperslab(space_id) BIND(C,NAME='H5Sis_regular_hyperslab')
+ IMPORT :: HID_T, C_INT
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN), VALUE :: space_id
+ END FUNCTION H5Sis_regular_hyperslab
+ END INTERFACE
+
+ status = H5Sis_regular_hyperslab(space_id)
+
+ hdferr = 0
+ IsRegular = .FALSE.
+ IF(status.GT.0)THEN
+ IsRegular = .TRUE.
+ ELSE IF(status.LT.0)THEN
+ hdferr = -1
+ ENDIF
+
+ END SUBROUTINE H5Sis_regular_hyperslab_f
+
END MODULE H5S