diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-30 16:42:10 (GMT) |
---|---|---|
committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2008-09-30 16:42:10 (GMT) |
commit | fe1ca64d1672af7859c38c143b77533a14c518ec (patch) | |
tree | bbee085742020b59a4b6136f277c6dd4a0bc8de0 /fortran/src/H5Sff.f90 | |
parent | f361635ae5f344bc80aade6432e80bcf1647522b (diff) | |
download | hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.zip hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.tar.gz hdf5-fe1ca64d1672af7859c38c143b77533a14c518ec.tar.bz2 |
[svn-r15727]
Maintenance: Merged new Fortran Features and tests from trunk into hdf5_1_8 branch
(used svn merge -r 14941:14525 http://svn.hdfgroup.uiuc.edu/hdf5/trunk/fortran
command).
Diffstat (limited to 'fortran/src/H5Sff.f90')
-rw-r--r-- | fortran/src/H5Sff.f90 | 276 |
1 files changed, 98 insertions, 178 deletions
diff --git a/fortran/src/H5Sff.f90 b/fortran/src/H5Sff.f90 index e8c5b21..f7feca2 100644 --- a/fortran/src/H5Sff.f90 +++ b/fortran/src/H5Sff.f90 @@ -47,9 +47,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5screate_simple_f(rank, dims, space_id, hdferr, maxdims) -! -!This definition is needed for Windows DLLs + SUBROUTINE h5screate_simple_f(rank, dims, space_id, hdferr, maxdims) IMPLICIT NONE INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions @@ -119,9 +117,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5sclose_f(space_id, hdferr) -! -!This definition is needed for Windows DLLs - IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -168,10 +163,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5screate_f(classtype, space_id, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5screate_f(classtype, space_id, hdferr) IMPLICIT NONE INTEGER, INTENT(IN) :: classtype ! The type of the dataspace ! to be created. @@ -225,10 +217,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5scopy_f(space_id, new_space_id, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5scopy_f(space_id, new_space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HID_T), INTENT(OUT) :: new_space_id @@ -278,10 +267,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_select_hyper_nblocks_f(space_id, num_blocks, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_select_hyper_nblocks_f(space_id, num_blocks, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSSIZE_T), INTENT(OUT) :: num_blocks @@ -336,10 +322,7 @@ !---------------------------------------------------------------------- SUBROUTINE h5sget_select_hyper_blocklist_f(space_id, startblock, & - num_blocks, buf, hdferr) -! -!This definition is needed for Windows DLLs - + num_blocks, buf, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSIZE_T), INTENT(IN) :: startblock @@ -403,38 +386,32 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_select_bounds_f(space_id, start, end, hdferr) -! -!This definition is needed for Windows DLLs - - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier - INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: start - !Starting coordinates of the bounding box. - INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: end - !Ending coordinates of the bounding box, - !i.e., the coordinates of the diagonally - !opposite corner - INTEGER, INTENT(OUT) :: hdferr ! Error code - -! INTEGER, EXTERNAL :: h5sget_select_bounds_c -! MS FORTRAN needs explicit interface for C functions called here. -! - INTERFACE - INTEGER FUNCTION h5sget_select_bounds_c(space_id, start, end) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) -!DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SGET_SELECT_BOUNDS_C'::h5sget_select_bounds_c - !DEC$ ENDIF - INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: start - INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: end - END FUNCTION h5sget_select_bounds_c - END INTERFACE + SUBROUTINE h5sget_select_bounds_f(space_id, start, END, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: start + ! Starting coordinates of the bounding box. + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: END + !Ending coordinates of the bounding box, + !i.e., the coordinates of the diagonally + !opposite corner + INTEGER, INTENT(OUT) :: hdferr ! Error code - hdferr = h5sget_select_bounds_c(space_id, start, end) + INTERFACE + INTEGER FUNCTION h5sget_select_bounds_c(space_id, start, END) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SGET_SELECT_BOUNDS_C'::h5sget_select_bounds_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: start + INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: END + END FUNCTION h5sget_select_bounds_c + END INTERFACE + + hdferr = h5sget_select_bounds_c(space_id, start, END) - END SUBROUTINE h5sget_select_bounds_f + END SUBROUTINE h5sget_select_bounds_f !---------------------------------------------------------------------- ! Name: h5sget_select_elem_npoints_f @@ -461,10 +438,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_select_elem_npoints_f(space_id, num_points, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_select_elem_npoints_f(space_id, num_points, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSSIZE_T), INTENT(OUT) :: num_points @@ -519,9 +493,7 @@ !---------------------------------------------------------------------- SUBROUTINE h5sget_select_elem_pointlist_f(space_id, startpoint, & - num_points, buf, hdferr) -! -!This definition is needed for Windows DLLs + num_points, buf, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSIZE_T), INTENT(IN) :: startpoint @@ -532,9 +504,6 @@ !List of element points selected INTEGER, INTENT(OUT) :: hdferr ! Error code -! INTEGER, EXTERNAL :: h5sget_select_elem_pointlist_c -! MS FORTRAN needs explicit interface for C functions called here. -! INTERFACE INTEGER FUNCTION h5sget_select_elem_pointlist_c(space_id, startpoint, & num_points, buf ) @@ -551,6 +520,7 @@ hdferr = h5sget_select_elem_pointlist_c(space_id, startpoint, & num_points, buf ) + END SUBROUTINE h5sget_select_elem_pointlist_f !---------------------------------------------------------------------- @@ -584,57 +554,61 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sselect_elements_f(space_id, operator, rank, & - num_elements, coord, hdferr) -! -!This definition is needed for Windows DLLs - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier - INTEGER, INTENT(IN) :: operator ! Flag, valid values are: - ! H5S_SELECT_SET_F (0) - ! H5S_SELECT_OR_F (1) - INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions - INTEGER(SIZE_T), INTENT(IN) :: num_elements ! Number of elements to be + SUBROUTINE h5sselect_elements_f(space_id, OPERATOR, rank, & + num_elements, coord, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier + INTEGER, INTENT(IN) :: OPERATOR ! Flag, valid values are: + ! H5S_SELECT_SET_F (0) + ! H5S_SELECT_OR_F (1) + INTEGER, INTENT(IN) :: rank ! Number of dataspace dimensions + INTEGER(SIZE_T), INTENT(IN) :: num_elements ! Number of elements to be ! selected - INTEGER(HSIZE_T), & - DIMENSION(rank,num_elements), INTENT(IN) :: coord + INTEGER(HSIZE_T), DIMENSION(rank,num_elements), INTENT(IN) :: coord ! Array with the coordinates ! of the selected elements ! coord(rank, num_elements) - INTEGER, INTENT(OUT) :: hdferr ! Error code - INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:,:) :: c_coord - INTEGER :: error, i,j + INTEGER, INTENT(OUT) :: hdferr ! Error code + INTEGER(HSIZE_T), ALLOCATABLE, DIMENSION(:,:) :: c_coord + INTEGER :: error, i,j -! INTEGER, EXTERNAL :: h5sselect_elements_c -! MS FORTRAN needs explicit interface for C functions called here. + INTERFACE + INTEGER FUNCTION h5sselect_elements_c(space_id, OPERATOR,& + num_elements,c_c_coord) + USE H5GLOBAL + !DEC$ IF DEFINED(HDF5F90_WINDOWS) + !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SSELECT_ELEMENTS_C'::h5sselect_elements_c + !DEC$ ENDIF + INTEGER(HID_T), INTENT(IN) :: space_id + INTEGER, INTENT(IN) :: OPERATOR + INTEGER(SIZE_T), INTENT(IN) :: num_elements + INTEGER(HSIZE_T),DIMENSION(*) :: c_c_coord + END FUNCTION h5sselect_elements_c + END INTERFACE + + ALLOCATE(c_coord(rank,num_elements), STAT = error) + IF (error.NE. 0) THEN + hdferr = -1 + RETURN + ENDIF + DO i = 1, rank + c_coord(i,:) = coord(rank-i+1, :) - 1 + ENDDO + hdferr = h5sselect_elements_c(space_id, OPERATOR, num_elements, c_coord) + +! ALLOCATE(c_coord(num_elements,rank), stat = error) +! IF (error.NE. 0) THEN +! hdferr = -1 +! RETURN +! ENDIF ! - INTERFACE - INTEGER FUNCTION h5sselect_elements_c(space_id, operator,& - num_elements,c_c_coord) - USE H5GLOBAL - !DEC$ IF DEFINED(HDF5F90_WINDOWS) - !DEC$ ATTRIBUTES C,reference,decorate,alias:'H5SSELECT_ELEMENTS_C'::h5sselect_elements_c - !DEC$ ENDIF - INTEGER(HID_T), INTENT(IN) :: space_id - INTEGER, INTENT(IN) :: operator - INTEGER(SIZE_T), INTENT(IN) :: num_elements - INTEGER(HSIZE_T),DIMENSION(*) :: c_c_coord - END FUNCTION h5sselect_elements_c - END INTERFACE +! c_coord = TRANSPOSE(coord) +! hdferr = h5sselect_elements_c(space_id, OPERATOR, INT(rank,size_t), c_coord) - allocate(c_coord(rank, num_elements), stat = error) - if (error.NE. 0) then - hdferr = -1 - return - endif - do i = 1, rank - c_coord(i,:) = coord(rank-i+1, :) - 1 - enddo - hdferr = h5sselect_elements_c(space_id, operator, num_elements, & - c_coord) - deallocate(c_coord) + + DEALLOCATE(c_coord) - END SUBROUTINE h5sselect_elements_f + END SUBROUTINE h5sselect_elements_f !---------------------------------------------------------------------- ! Name: h5sselect_all_f @@ -661,9 +635,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sselect_all_f(space_id, hdferr) -! -!This definition is needed for Windows DLLs + SUBROUTINE h5sselect_all_f(space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -710,10 +682,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sselect_none_f(space_id, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sselect_none_f(space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -760,10 +729,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sselect_valid_f(space_id, status, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sselect_valid_f(space_id, status, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier LOGICAL, INTENT(OUT) :: status ! TRUE if the selection is @@ -817,10 +783,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_simple_extent_npoints_f(space_id, npoints, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_simple_extent_npoints_f(space_id, npoints, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSIZE_T), INTENT(OUT) :: npoints ! Number of elements in @@ -870,10 +833,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_select_npoints_f(space_id, npoints, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_select_npoints_f(space_id, npoints, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSSIZE_T), INTENT(OUT) :: npoints ! Number of elements in the @@ -923,10 +883,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_simple_extent_ndims_f(space_id, rank, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_simple_extent_ndims_f(space_id, rank, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: rank ! Number of dimensions @@ -977,10 +934,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_simple_extent_dims_f(space_id, dims, maxdims, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSIZE_T), DIMENSION(*), INTENT(OUT) :: dims @@ -1040,10 +994,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_simple_extent_type_f(space_id, classtype, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sget_simple_extent_type_f(space_id, classtype, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: classtype ! Class type , possible values @@ -1102,9 +1053,6 @@ SUBROUTINE h5sset_extent_simple_f(space_id, rank, current_size, & maximum_size, hdferr) -! -!This definition is needed for Windows DLLs - IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(IN) :: rank ! Dataspace rank @@ -1165,10 +1113,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sis_simple_f(space_id, status, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sis_simple_f(space_id, status, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier LOGICAL, INTENT(OUT) :: status ! Flag, idicates if dataspace @@ -1222,10 +1167,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5soffset_simple_f(space_id, offset, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5soffset_simple_f(space_id, offset, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER(HSSIZE_T), DIMENSION(*), INTENT(IN) :: offset @@ -1278,10 +1220,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sextent_copy_f(dest_space_id, source_space_id, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sextent_copy_f(dest_space_id, source_space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: dest_space_id ! Identifier of destination ! dataspace @@ -1330,10 +1269,7 @@ ! ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sset_extent_none_f(space_id, hdferr) -! -!This definition is needed for Windows DLLs - + SUBROUTINE h5sset_extent_none_f(space_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(OUT) :: hdferr ! Error code @@ -1388,9 +1324,7 @@ !---------------------------------------------------------------------- SUBROUTINE h5sselect_hyperslab_f(space_id, operator, start, count, & - hdferr, stride, block) -! -!This definition is needed for Windows DLLs + hdferr, stride, block) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier INTEGER, INTENT(IN) :: operator ! Flag, valid values are: @@ -1523,9 +1457,7 @@ !---------------------------------------------------------------------- ! SUBROUTINE h5scombine_hyperslab_f(space_id, operator, start, count, & -! hyper_id, hdferr, stride, block) -! -!This definition is needed for Windows DLLs +! hyper_id, hdferr, stride, block) ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(IN) :: space_id ! Dataspace identifier ! INTEGER, INTENT(IN) :: operator ! Flag, valid values are: @@ -1661,9 +1593,7 @@ !---------------------------------------------------------------------- ! SUBROUTINE h5scombine_select_f(space1_id, operator, space2_id, & -! ds_id, hdferr) -! -!This definition is needed for Windows DLLs +! ds_id, hdferr) ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(IN) :: space1_id ! First dataspace identifier ! INTEGER(HID_T), INTENT(IN) :: space2_id ! Second dataspace identifier @@ -1736,9 +1666,7 @@ !---------------------------------------------------------------------- ! SUBROUTINE h5sselect_select_f(space1_id, operator, space2_id, & -! hdferr) -! -!This definition is needed for Windows DLLs +! hdferr) ! IMPLICIT NONE ! INTEGER(HID_T), INTENT(INOUT) :: space1_id ! Dataspace identifier to ! modify @@ -1801,9 +1729,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sget_select_type_f(space_id, type, hdferr) -! -!This definition is needed for Windows DLLs + SUBROUTINE h5sget_select_type_f(space_id, type, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(INOUT) :: space_id ! Dataspace identifier to INTEGER, INTENT(OUT) :: type ! Selection type @@ -1853,9 +1779,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sdecode_f(buf, obj_id, hdferr) -! -!This definition is needed for Windows DLLs + SUBROUTINE h5sdecode_f(buf, obj_id, hdferr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: buf ! Buffer for the data space object to be decoded. INTEGER(HID_T), INTENT(OUT) :: obj_id ! Object ID @@ -1901,9 +1825,7 @@ ! Comment: !---------------------------------------------------------------------- - SUBROUTINE h5sencode_f(obj_id, buf, nalloc, hdferr) -! -!This definition is needed for Windows DLLs + SUBROUTINE h5sencode_f(obj_id, buf, nalloc, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: obj_id ! Identifier of the object to be encoded. CHARACTER(LEN=*), INTENT(OUT) :: buf ! Buffer for the object to be encoded into. @@ -1953,8 +1875,6 @@ !---------------------------------------------------------------------- SUBROUTINE h5sextent_equal_f(space1_id, space2_id, equal, hdferr) -! -!This definition is needed for Windows DLLs IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: space1_id ! First dataspace identifier. INTEGER(HID_T), INTENT(IN) :: space2_id ! Second dataspace identifier. |